Changeset 56f1845 in git for Singular/LIB/finvar.lib


Ignore:
Timestamp:
Dec 9, 1997, 6:58:56 PM (26 years ago)
Author:
Hans Schönemann <hannes@…>
Branches:
(u'spielwiese', 'fe61d9c35bf7c61f2b6cbf1b56e25e2f08d536cc')
Children:
bf6475e92bae9d382651d65c76ec46c106610c05
Parents:
d1065e5774bc24efc74a370dd4b64a9742945a54
Message:
* agnes: new version of finvar.lib - complete rewrite


git-svn-id: file:///usr/local/Singular/svn/trunk@966 2c84dea3-7e68-4137-9b89-c4e89433aadc
File:
1 edited

Legend:

Unmodified
Added
Removed

  • Singular/LIB/finvar.lib

    rd1065e r56f1845  
    1 // $Header: /exports/cvsroot-2/cvsroot/Singular/LIB/finvar.lib,v 1.4 1997-08-12 14:01:05 Singular Exp $
     1// $Header: /usr/local/Singular/cvsroot/Singular/LIB/finvar.lib,v 1.1.4.1 1997/0
     27/03 15:32:03 Singular Exp $
    23////////////////////////////////////////////////////////////////////////////////
    3 // send bugs and comments to agnes@math.uni-sb.de
    4 LIBRARY:  finvar.lib             LIBRARY TO CALCULATE INVARIANT RINGS & MORE
    5                                    by Agnes Eileen Heydtmann, send bugs and
    6                                    comments to agnes@math.uni-sb.de
    74
    8   rey_mol(G1,G2,...[,int]);      Reynolds operator and Molien series of the
    9                                  finite matrix group generated by G1,G2,...
    10   part_mol(M,n[,p]);             n terms of partial expansion of Molien series M
    11   eval_rey(RO,p);                evaluate poly p under Reynolds operator RO
    12   inv_basis(deg,G1,G2,...);      basis of space of homogeneous invariants of
    13                                  degree deg under the finite matrix group
    14                                  generated by G1,G2,...
    15   inv_basis_rey(RO,deg[,dim]);   basis of space of homogeneous invariants of
    16                                  degree deg and optionally dimension dim with
    17                                  help of Reynolds operator
    18   inv_ring_s(G1,G2,...[,intvec]); generators of the invariant ring (primary
    19                                  invariants according to Sturmfels)
    20   inv_ring_k(G1,G2,...[,intvec]); generators of the invariant ring (combination
    21                                  of algorithms by Kemper and Sturmfels for
    22                                  primary invariants)
    23   algebra_con(p,F);              check whether poly p is contained in invariant
    24                                  ring generated by entries in F
    25   module_con(f,P,S);             representing f in the Hironaka decomposition of
    26                                  the invariant ring into primary invariants P
    27                                  and secondary ones S
    28   orbit_var(F,s);                orbit variety of a finite matrix group whose
    29                                  invariant ring is generated by entries in F
    30   rel_orbit_var(I,F,s);          relative orbit variety with respect to
    31                                  invariant ideal I under finite matrix group,
    32                                  its invariant ring is generated by entries in F
    33   im_of_var(I,F);                image of variety defined by ideal I under
    34                                  finite matrix group whose invariant ring is
    35                                  generated by entries in F
     5LIBRARY:  finvar.lib         LIBRARY TO CALCULATE INVARIANT RINGS & MORE
     6                             (c) Agnes Eileen Heydtmann,
     7                             send bugs and comments to agnes@math.uni-sb.de
     8
     9 cyclotomic                                cyclotomic polynomial
     10 group_reynolds                            finite group and Reynolds operator
     11 molien                                    Molien series
     12 reynolds_molien                           Reynolds operator and Molien series
     13 partial_molien                            partial expansion of Molien series
     14 evaluate_reynolds                         image under the Reynolds operator
     15 invariant_basis                           basis of homogeneous invariants
     16 invariant_basis_reynolds                  basis of homogeneous invariants
     17 primary_char0                             primary invariants
     18 primary_charp                             primary invariants
     19 primary_char0_no_molien                   primary invariants
     20 primary_charp_no_molien                   primary invariants
     21 primary_charp_without                     primary invariants
     22 primary_invariants                        primary invariants
     23 primary_char0_random                      primary invariants
     24 primary_charp_random                      primary invariants
     25 primary_char0_no_molien_random            primary invariants
     26 primary_charp_no_molien_random            primary invariants
     27 primary_charp_without_random              primary invariants
     28 primary_invariants_random                 primary invariants
     29 power_products                            exponents for power products
     30 secondary_char0                           secondary invariants
     31 secondary_charp                           secondary invariants
     32 secondary_no_molien                       secondary invariants
     33 secondary_with_irreducible_ones_no_molien secondary invariants
     34 secondary_not_cohen_macaulay              secondary invariants
     35 invariant_ring                            primary and secondary invariants
     36 invariant_ring_random                     primary and secondary invariants
     37 algebra_containment                       answers query of algebra containment
     38 module_containment                        answers query of module containment
     39 orbit_variety                             ideal of the orbit variety
     40 relative_orbit_variety                    ideal of a relative orbit variety
     41 image_of_variety                          ideal of the image of a variety
    3642
    3743////////////////////////////////////////////////////////////////////////////////
    … …  
    3945LIB "elim.lib";
    4046LIB "general.lib";
    41 LIB "poly.lib";
    4247////////////////////////////////////////////////////////////////////////////////
    4348
    4449////////////////////////////////////////////////////////////////////////////////
    45 // sign of integer a, returning 1 or -1 respectively
    46 ////////////////////////////////////////////////////////////////////////////////
    47 proc sign(int i)
    48   USAGE:   sign(<int>);
    49   RETURN:  the sign of an integer (return type <int>)
    50   EXAMPLE: example sign; shows an example.
    51 { if (i>=0)
    52   { return(1);
    53   }
    54   else
    55   { return(-1);
    56   }
    57 }
    58 example
    59 { "  EXAMPLE:";
    60   echo=2;
    61            int i=-3;
    62            int j=3;
    63            sign(i);
    64            sign(j);
    65 }
    66 
    67 ////////////////////////////////////////////////////////////////////////////////
    68 // absolute value of integer a
    69 ////////////////////////////////////////////////////////////////////////////////
    70 proc abs (int i)
    71   USAGE:   abs(<int>);
    72   RETURN:  the absolute value of an integer (return type <int>)
    73   EXAMPLE: example abs; shows an example.
    74 { return(i*sign(i));
    75 }
    76 example
    77 { "  EXAMPLE:";
    78   echo=2;
    79            int i=-3;
    80            int j=3;
    81            abs(i);
    82            abs(j);
    83 }
    84 
    85 ////////////////////////////////////////////////////////////////////////////////
    86 // Checks whether the last argument, being a matrix, is among the previous
    87 // arguments, also being matrices
     50// Checks whether the last parameter, being a matrix, is among the previous
     51// parameters, also being matrices
    8852////////////////////////////////////////////////////////////////////////////////
    8953proc unique (list #)
    … …  
    9660}
    9761
    98 ////////////////////////////////////////////////////////////////////////////////
    99 // Computes the cyclotomic polynomial recursively, by dividing x^m-1 by the
    100 // cyclotomic polynomial of proper divisors of m
    101 ////////////////////////////////////////////////////////////////////////////////
    102 proc cycle (int m)
    103   USAGE:   cycle(<int>);
    104   RETURNS: the cyclotomic polynomial (type <poly>) as one in the first ring
    105            variable
    106   EXAMPLE: example cycle; shows an example
    107 { poly v1=var(1);
    108   if (m==1)
     62proc cyclotomic (int i)
     63USAGE:   cyclotomic(i);
     64         i: an <int> > 0
     65RETURNS: the i-th cyclotomic polynomial (type <poly>) as one in the first ring
     66         variable
     67EXAMPLE: example cyclotomic; shows an example
     68THEORY:  x^i-1 is divided by the j-th cyclotomic polynomial where j takes on the
     69         value of proper divisors of i
     70{ if (i<=0)
     71  { "ERROR:   the input should be > 0.";
     72    return();
     73  }
     74  poly v1=var(1);
     75  if (i==1)
    10976  { return(v1-1);                      // 1-st cyclotomic polynomial
    11077  }
    111   poly min=v1^m-1;
    112   matrix s[1][2]=min,v1-1;             // dividing by the 1-st cyclotomic
    113   s=matrix(syz(ideal(s)));             // polynomial
    114   min=s[2,1];
    115   int i=2;
     78  poly min=v1^i-1;
     79  matrix s[1][2];
     80  min=min/(v1-1);                      // dividing by the 1-st cyclotomic
     81                                       // polynomial
     82  int j=2;
    11683  int n;
    11784  poly c;
    11885  int flag=1;
    119   while(2*i<=m)                        // there are no proper divisors of m
    120   { if ((m%i)==0)                      // greater than m/2
     86  while(2*j<=i)                        // there are no proper divisors of i
     87  { if ((i%j)==0)                      // greater than i/2
    12188    { if (flag==1)
    122       { n=i;                           // n stores the first proper divisor of
    123       }                                // m>1
     89      { n=j;                           // n stores the first proper divisor of
     90      }                                // i > 1
    12491      flag=0;
    125       c=cycle(i);                      // recursive computation
     92      c=cyclotomic(j);                 // recursive computation
    12693      s=min,c;
    12794      s=matrix(syz(ideal(s)));         // dividing
    12895      min=s[2,1];
    12996    }
    130     if (n*i==m)                        // the earliest possible point to break
     97    if (n*j==i)                        // the earliest possible point to break
    13198    { break;
    13299    }
    133     i=i+1;
    134   }
    135   min=min/leadcoef(min);               // making sure that leading coefficient
    136   return(min);                         // is 1
     100    j=j+1;
     101  }
     102  min=min/leadcoef(min);               // making sure that the leading
     103  return(min);                         // coefficient is 1
    137104}
    138105example
    139106{ echo=2;
    140107          ring R=0,(x,y,z),dp;
    141           print(cycle(25));
     108          print(cyclotomic(25));
    142109}
    143110
    144 ////////////////////////////////////////////////////////////////////////////////
    145 // Returns i such that root^i==n, i.e. it heavily relies on the right input.
    146 ////////////////////////////////////////////////////////////////////////////////
    147 proc power(number n, number root)
    148 { int i=0;
    149    while((n/root^i)<>1)
    150    { i=i+1;
    151    }
    152    return(i);
    153 }
    154 
    155 ////////////////////////////////////////////////////////////////////////////////
    156 // Generates the Molien series when the characteristic of the base field is p>0
    157 // and p does not divide the group order. Input is the entire group and a name
    158 // for a new ring.
    159 ////////////////////////////////////////////////////////////////////////////////
    160 proc p_molien(list #)
    161 { def br=basering;                     // keeping track of the base ring since
    162   int n=nvars(br);                     // we have to go into an extension of the
    163   int g=size(#)-2;                     // basefield -
    164   matrix G(1..g)=#[1..g];              // rewriting the group elements
    165   string newring=#[g+1];
    166   int flag=#[g+2];
    167   if (g<>1)
    168   { ring Q=0,x,dp;                     // we want to extend our ring as well as
    169                                        // the ring of rational numbers Q to
    170                                        // contain g-th primitive roots of unity
    171                                        // in order to factor characteristic
    172                                        // polynomials of group elements into
    173                                        // linear factors and lift eigenvalues to
    174                                        // characteristic 0 -
    175     poly minq=cycle(g);                // minq now contains the size-of-group-th
    176                                        // cyclotomic polynomial of Q, it is
    177                                        // irreducible there
    178     ring `newring`=(0,e),x,dp;
    179     map f=Q,ideal(e);
    180     minpoly=number(f(minq));           // e is now a g-th primitive root of
    181                                        // unity -
    182     kill Q, f;                         // no longer needed -
    183     poly p=1;                          // used to build the denominator of the
    184                                        // new term in the Molien series
    185     matrix s[1][2];                    // used for canceling -
    186     matrix M[1][2]=0,1;                // will contain Molien series -
    187     ring v1br=char(br),x,dp;           // we calculate the g-th cyclotomic
    188     poly minp=cycle(g);                // polynomial of the base field and pick
    189     minp=factorize(minp)[1][2];        // an irreducible factor of it -
    190     if (deg(minp)==1)                  // in this case the base field contains
    191     { ring bre=char(br),x,dp;          // g-th roots of unity already
    192       map f1=v1br,ideal(0);
    193       number e=-number((f1(minp)));    // e is a g-th primitive root of unity
    194     }
    195     else
    196     { ring bre=(char(br),e),x,dp;
    197       map f1=v1br,ideal(e);
    198       minpoly=number(f1(minp));        // e is a g-th primitive root of unity
    199     }
    200     map f2=br,ideal(0);                // we need f2 to map our group elements
    201                                        // to this new extension field bre
    202     matrix I=unitmat(n);
    203     poly p;                            // used for the characteristic polynomial
    204                                        // to factor -
    205     list L;                            // will contain the linear factors of the
    206     ideal F;                           // characteristic polynomial of the group
    207     intvec C;                          // elements and their powers
    208     int i, j, k;
    209     for (i=1;i<=g;i=i+1)
    210     { p=det(x*I-f2(G(i)));             // characteristic polynomial of G(i)
    211       L=factorize(p);
    212       F=L[1];
    213       C=L[2];
    214       for (j=2;j<=ncols(F);j=j+1)
    215       { F[j]=-1*(F[j]-x);              // F[j] is now an eigenvalue of G(i),
    216                                        // it is a power of a primitive g-th root
    217                                        // of unity -
    218         k=power(number(F[j]),e);       // F[j]==e^k
    219         setring `newring`;
    220         p=p*(1-x*(e^k))^C[j];          // building the denominator of the new
    221         setring bre;                   // term
    222       }
    223       setring `newring`;
    224       M[1,1]=M[1,1]*p+M[1,2];          // expanding M[1,1]/M[1,2] + 1/p
    225       M[1,2]=M[1,2]*p;
    226       p=1;
    227       s=matrix(syz(ideal(M)));         // canceling common terms of denominator
    228       M[1,1]=-s[2,1];                  // and enumerator
    229       M[1,2]=s[1,1];
    230       setring bre;
    231       if (flag)
    232       { "  Term "+string(i)+" has been computed.";
    233       }
    234     }
    235     if (flag)
    236     { "";
    237     }
    238     setring `newring`;
    239     map slead=`newring`,ideal(0);
    240     s=slead(M);                        // forcing the constant term of numerator
    241     M[1,1]=1/s[1,1]*M[1,1];            // and denominator to be 1
    242     M[1,2]=1/s[1,2]*M[1,2];
    243     kill slead;
    244     kill s;
    245     kill p;
    246   }
    247   else                                 // if the group only contains an identity
    248   { ring `newring`=0,x,dp;             // element, it is very easy to calculate
    249     matrix M[1][2]=1,(1-x)^n;          // the Molien series
    250   }
    251   // keepring `newring`;
    252   export `newring`;                    // TTO we keep the ring where we computed
    253                                        // the Molien series
    254   export M;                            // TTO so that we can keep the Molien
    255                                        // series
    256   setring br;
    257 }
    258 
    259 ////////////////////////////////////////////////////////////////////////////////
    260 // This procedure calculates all members of a finite matrix group in terms of
    261 // the given generators. In one run trough the main loop, all left products of
    262 // the generators with the new elements from the last run through the loop (or
    263 // the generators themselves in the first run) will be formed. After that the
    264 // newly generated elements will be added to the group and the loop starts over
    265 // again unless no elements were added.
    266 // Additionally, every time a new matrix is added to the group, its
    267 // corresponding ring mapping in the Reynolds operator and if the
    268 // characteristic is 0, its corresponding summand of the Molien series is
    269 // calculated.
    270 // When the characteristic of the basefield is p>0 such that it does not
    271 // divide the group order, the Molien series is calculated at the end of the
    272 // procedure.
    273 // No matter when the Molien series is calculated, the procedure expands after
    274 // every step to obtain a rational function.
    275 // The first result of the procedure is the Reynolds operator, presented in
    276 // form of a matrix; each row can be transformed into an ideal and from
    277 // there can be used as a ring homomorphism via the command 'map'.
    278 // If the characteristic is 0, the second result is a matrix, containing
    279 // enumerator and denominator (with no common divisor) of the final
    280 // rational function representing the Molien series.
    281 // When the characteristic of the basefield is p>0 such that it does not
    282 // divide the group order, the Molien series is returned in a ring of
    283 // characteristic 0. It names was specified in the list of parameters.
    284 ////////////////////////////////////////////////////////////////////////////////
    285 proc rey_mol (list #)
    286   USAGE:   rey_mol(<generators of a finite matrix group>[,<string>,<int>]);
    287            if the characteristic of the coefficient field is prime, <string>
    288            has to contain the name for a new polynomials ring with coefficient
    289            field of characteristic 0 that stores the Molien series - if <int> is
    290            not not equal to 0, some information will be printed during the run
    291   RETURNS: if the characteristic is 0: Reynolds operator (type <matrix>), Molien
    292            series (type <matrix> with two components, first being the numerator,
    293            second the denominator)
    294            if the characteristic is p>0 not dividing the group order: Reynolds
    295            operator (type <matrix>) - the Molien series will directly be stored
    296            under the name M (type <matrix>) in the ring `<string>`
    297            if the characteristic is p>0 dividing the group order: Reynolds
    298            operator (type <matrix>)
    299   EXAMPLE: example rey_mol; shows an example
    300 { def br=basering;                     // the Molien series depends on the
    301   int ch=char(br);                     // characteristic of the coefficient
    302   int flag;                            // field -
    303   if (ch<>0)                           // making sure the input is 'correct'...
    304   { if (typeof(#[size(#)])=="string")
    305     { flag=size(#)-1;
    306       string newring=#[size(#)];
    307       int v=0;                         // no information is default
    308     }
    309     else
    310     { if (typeof(#[size(#)-1])=="string")
    311       { flag=size(#)-2;
    312         string newring=#[size(#)-1];
    313         if (typeof(#[size(#)])<>"int")
    314         { "  ERROR:   if the second last parameter is <string>, the last must be";
    315           "           of type <int>";
    316           return();
    317         }
    318         int v=#[size(#)];
    319       }
    320       else
    321       { "  ERROR:   in characteristic p a <string> must be given for the name";
    322         "           of a new ring";
    323         return();
    324       }
    325     }
    326     if (newring=="")
    327     { "  ERROR:   <string> may not be empty";
     111proc group_reynolds (list #)
     112USAGE:   group_reynolds(G1,G2,...[,v]);
     113         G1,G2,...: nxn <matrices> generating a finite matrix group, v: an
     114         optional <int>
     115ASSUME:  n is the number of variables of the basering, g the number of group
     116         elements
     117RETURN:  a <list>, the first list element will be a gxn <matrix> representing
     118         the Reynolds operator if we are in the non-modular case; if the
     119         characteristic is >0, minpoly==0 and the finite group non-cyclic the
     120         second list element is an <int> giving the lowest common multiple of
     121         the matrix group elements (used in molien); in general all other list
     122         elements are nxn <matrices> listing all elements of the finite group
     123DISPLAY: information if v does not equal 0
     124EXAMPLE: example group_reynolds; shows an example
     125THEORY:  The entire matrix group is generated by getting all left products of
     126         the generators with the new elements from the last run through the loop
     127         (or the generators themselves during the first run). All the ones that
     128         have been generated before are thrown out and the program terminates
     129         when there are no new elements found in one run. Additionally each time
     130         a new group element is found the corresponding ring mapping of which
     131         the Reynolds operator is made up is generated. They are stored in the
     132         rows of the first return value.
     133{ int ch=char(basering);               // the existance of the Reynolds operator
     134                                       // is dependent on the characteristic of
     135                                       // the base field
     136  int gen_num;                         // number of generators
     137 //------------------------ making sure the input is okay ---------------------
     138  if (typeof(#[size(#)])=="int")
     139  { if (size(#)==1)
     140    { "ERROR:   there are no matrices given among the parameters";
    328141      return();
    329142    }
    330   }
    331   else
    332   { if (typeof(#[size(#)])=="int")
    333     { flag=size(#)-1;
    334       int v=#[size(#)];
    335     }
    336     else
    337     { flag=size(#);
    338       int v=0;                         // no information is default
    339     }
     143    int v=#[size(#)];
     144    gen_num=size(#)-1;
     145  }
     146  else                                 // last parameter is not <int>
     147  { int v=0;                           // no information is default
     148    gen_num=size(#);
    340149  }
    341150  if (typeof(#[1])<>"matrix")
    342   { "  ERROR:   the parameters must be a list of matrices and optionally";
    343     "           a <string> and an <int>";
     151  { "ERROR:   the parameters must be a list of matrices and maybe an <int>";
    344152    return();
    345153  }
    346154  int n=nrows(#[1]);
    347   if (n<>nvars(br))
    348   { "  ERROR:   the number of variables of the basering needs to be the same";
    349     "           as the dimension of the matrices";
     155  if (n<>nvars(basering))
     156  { "ERROR:   the number of variables of the basering needs to be the same";
     157    "         as the dimension of the matrices";
    350158    return();
    351159  }
    352160  if (n<>ncols(#[1]))
    353   { "  ERROR:   matrices need to be square and of the same dimensions";
     161  { "ERROR:   matrices need to be square and of the same dimensions";
    354162    return();
    355163  }
    356164  matrix vars=matrix(maxideal(1));     // creating an nx1-matrix containing the
    357165  vars=transpose(vars);                // variables of the ring -
    358   matrix A(1)=#[1]*vars;               // calculating the first ring mapping -
    359                                        // A(1) will contain the Reynolds
     166  matrix REY=#[1]*vars;                // calculating the first ring mapping -
     167                                       // REY will contain the Reynolds
    360168                                       // operator -
    361   if (ch==0)                           // when ch==0 we can calculate the Molien
    362   { matrix I=diag(1,n);                // series in any case -
    363     poly v1=vars[1,1];                 // the Molien series will be in terms of
    364                                        // the first variable of the current
    365                                        // ring -
    366     matrix A(2)[1][2];                 // A(2) will contain the Molien series -
    367     A(2)[1,1]=1;                       // A(2)[1,1] will be the numerator
    368     A(2)[1,2]=det(I-v1*(#[1]));        // A(2)[1,2] will be the denominator -
    369     matrix s;                          // will help us canceling in the
    370                                        // fraction
    371   }
    372169  matrix G(1)=#[1];                    // G(k) are elements of the group -
    373   poly p;                              // will contain the denominator of the
    374                                        // new term of the Molien series
     170  if (ch<>0 && minpoly==0 && gen_num<>1) // finding out of which order the group
     171  { matrix I=diag(1,n);                // element is
     172    matrix TEST=G(1);
     173    int o1=1;
     174    int o2;
     175    while (TEST<>I)
     176    { TEST=TEST*G(1);
     177      o1=o1+1;
     178    }
     179  }
    375180  int i=1;
    376   for (int j=2;j<=flag;j=j+1)          // this loop adds the arguments to the
     181 // -------------- doubles among the generators should be avoided -------------
     182  for (int j=2;j<=gen_num;j=j+1)       // this loop adds the parameters to the
    377183  {                                    // group, leaving out doubles and
    378                                        // checking whether the arguments are
     184                                       // checking whether the parameters are
    379185                                       // compatible with the task of the
    380186                                       // procedure
    381187    if (not(typeof(#[j])=="matrix"))
    382     { "  ERROR:   the parameters must be a list of matrices and optionally";
    383       "           a <string> and an <int>";
     188    { "ERROR:   the parameters must be a list of matrices and maybe an <int>";
    384189      return();
    385190    }
    386191    if ((n!=nrows(#[j])) or (n!=ncols(#[j])))
    387     { "  ERROR:   matrices need to be square and of the same dimensions";
     192    { "ERROR:   matrices need to be square and of the same dimensions";
    388193       return();
    389194    }
    … …  
    391196    { i=i+1;
    392197      matrix G(i)=#[j];
    393       A(1)=concat(A(1),#[j]*vars);     // adding ring homomorphisms to A(1)
    394       if (ch==0)
    395       { p=det(I-v1*#[j]);              // denominator of new term -
    396         A(2)[1,1]=A(2)[1,1]*p+A(2)[1,2]; // expanding A(2)[1,1]/A(2)[1,2] + 1/p
    397         A(2)[1,2]=A(2)[1,2]*p;
    398         s=matrix(syz(ideal(A(2))));    // canceling common factors
    399         A(2)[1,1]=-s[2,1];
    400         A(2)[1,2]=s[1,1];
    401       }
     198      if (ch<>0 && minpoly==0)         // finding out of which order the group
     199      { TEST=G(i);                     // element is
     200        o2=1;
     201        while (TEST<>I)
     202        { TEST=TEST*G(i);
     203          o2=o2+1;
     204        }
     205        o1=o1*o2/gcd(o1,o2);           // lowest common multiple of the element
     206      }                                // orders -
     207      REY=concat(REY,#[j]*vars);       // adding ring homomorphisms to REY
    402208    }
    403209  }
    … …  
    406212                                       // of elements in the group so far -
    407213  j=i;                                 // j is the number of new elements that
    408                                        // we use as factors -
     214                                       // we use as factors
    409215  int k, m, l;
    410216  if (v)
    411   { if (ch==0)
    412     { "";
    413       "  Generating the entire matrix group, Reynolds operator and Molien series...";
    414       "";
    415     }
    416     else
    417     { "";
    418       "  Generating the entire matrix group and Reynolds operator...";
    419       "  If the characteristic of the basefield divides the order of the";
    420       "  group the result will be useless.";
    421       "";
    422     }
    423   }
     217  { "";
     218    "  Generating the entire matrix group and the Reynolds operator...";
     219    "";
     220  }
     221 // -------------- main loop that finds all the group elements ----------------
    424222  while (1)
    425   { l=0;   // l is the number of products we get in one going
     223  { l=0;                               // l is the number of products we get in
     224                                       // one going
    426225    for (m=g-j+1;m<=g;m=m+1)
    427226    { for (k=1;k<=i;k=k+1)
    … …  
    436235        g=g+1;
    437236        matrix G(g)=P(k);              // a new group element -
    438         A(1)=concat(A(1),P(k)*vars);   // adding new mapping to A(1)
    439         if (ch==0)
    440         { p=det(I-v1*P(k));            // denominator of new term -
    441           A(2)[1,1]=A(2)[1,1]*p+A(2)[1,2];
    442           A(2)[1,2]=A(2)[1,2]*p;       // expanding A(2)[1,1]/A(2)[1,2] + 1/p -
    443           s=matrix(syz(ideal(A(2))));  // canceling common factors
    444           A(2)[1,1]=-s[2,1];
    445           A(2)[1,2]=s[1,1];
    446         }
     237        if (ch<>0 && minpoly==0 && i<>1) // finding out of which order the group
     238        { TEST=G(g);                   // element is
     239          o2=1;
     240          while (TEST<>I)
     241          { TEST=TEST*G(g);
     242            o2=o2+1;
     243          }
     244          o1=o1*o2/gcd(o1,o2);         // lowest common multiple of the element
     245        }                              // orders -
     246        REY=concat(REY,P(k)*vars);     // adding new mapping to REY
    447247        if (v)
    448248        { "  Group element "+string(g)+" has been found.";
    … …  
    452252    }
    453253    if (j==0)                          // when we didn't add any new elements
    454     { break; }                         // in one run through the while loop
    455   }                                    // we are done -
     254    { break;                           // in one run through the while loop
     255    }                                  // we are done
     256  }
    456257  if (v)
    457258  { if (g<=i)
    … …  
    460261    "";
    461262  }
    462   A(1)=transpose(A(1));                // when we evaluate the Reynolds operator
     263  REY=transpose(REY);                  // when we evaluate the Reynolds operator
    463264                                       // later on, we actually want 1xn
    464265                                       // matrices
    465   if (ch<>0 && minpoly==0)
    466   { if ((g%ch)<>0)
    467     { if (v)
    468       { "  Generating Molien series...";
    469         "";
    470       }
    471       p_molien(G(1..g),newring,v);     // the procedure that defines a ring of
    472                                        // characteristic 0 and calculates the
    473                                        // Molien series in it
    474       if (v)
    475       { "  Now we are done calculating Molien series and Reynolds operator.";
    476         "";
    477       }
    478       return(A(1));
    479     }
    480   }
    481   if (ch<>0 && minpoly<>0)
    482   { if ((g%ch)<>0)
     266  if (ch<>0)
     267  { if ((g%ch)==0)
    483268    { if (voice==2)
    484       { "  WARNING: It is impossible for this program to calculate the Molien series";
    485         "           for finite groups over extension fields of prime characteristic.";
     269      { "WARNING: The characteristic of the coefficient field divides the group order.";
     270        "         Proceed without the Reynolds operator!";
     271      }
     272      else
     273      { if (v)
     274        { "  The characteristic of the base field divides the group order.";
     275          "  We have to continue without Reynolds operator...";
     276          "";
     277        }
     278      }
     279      kill REY;
     280      matrix REY[1][1]=0;
     281      return(REY,G(1..g));
     282    }
     283    if (minpoly==0)
     284    { if (i>1)
     285      { return(REY,o1,G(1..g));
     286      }
     287      return(REY,G(1..g));
     288    }
     289  }
     290  if (v)
     291  { "  Done generating the group and the Reynolds operator.";
     292    "";
     293  }
     294  return(REY,G(1..g));
     295}
     296example
     297{ "EXAMPLE: Sturmfels: Algorithms in Invariant Theory 2.3.7:";
     298  echo=2;
     299         ring R=0,(x,y,z),dp;
     300         matrix A[3][3]=0,1,0,-1,0,0,0,0,-1;
     301         list L=group_reynolds(A);
     302         print(L[1]);
     303         print(L[2..size(L)]);
     304}
     305
     306////////////////////////////////////////////////////////////////////////////////
     307// Returns i such that root^i==n, i.e. it heavily relies on the right input.
     308////////////////////////////////////////////////////////////////////////////////
     309proc exponent(number n, number root)
     310{ int i=0;
     311   while((n/root^i)<>1)
     312   { i=i+1;
     313   }
     314   return(i);
     315}
     316
     317proc molien (list #)
     318USAGE:   molien(G1,G2,...[,ringname,lcm,flags]);
     319         G1,G2,...: nxn <matrices> generating a finite matrix group, ringname:
     320         a <string> giving a name for a new ring of characteristic 0 for the
     321         Molien series in case of prime characteristic, lcm: an <int> giving the
     322         lowest common multiple of the elements' orders in case of prime
     323         characteristic, minpoly==0 and a non-cyclic group, flags: an optional
     324         <intvec> with three components: if the first element is not equal to 0
     325         characteristic 0 is simulated, i.e. the Molien series is computed as
     326         if the base field were characteristic 0 (the user must choose a field
     327         of large prime characteristic, e.g. 32003), the second component should
     328         give the size of intervals between canceling common factors in the
     329         expansion of the Molien series, 0 (the default) means only once after
     330         generating all terms, in prime characteristic also a negative number
     331         can be given to indicate that common factors should always be canceled
     332         when the expansion is simple (the root of the extension field does not
     333         occur among the coefficients)
     334ASSUME:  n is the number of variables of the basering, G1,G2... are the group
     335         elements generated by group_reynolds(), lcm is the second return value
     336         of group_reynolds()
     337RETURN:  in case of characteristic 0 a 1x2 <matrix> giving enumerator and
     338         denominator of Molien series; in case of prime characteristic a ring
     339         with the name `ringname` of characteristic 0 is created where the same
     340         Molien series (named M) is stored
     341DISPLAY: information if the third component of flags does not equal 0
     342EXAMPLE: example molien; shows an example
     343THEORY:  In characteristic 0 the terms 1/det(1-xE) for all group elements of the
     344         Molien series are computed in a straight forward way. In prime
     345         characteristic a Brauer lift is involved. The returned matrix gives
     346         enumerator and denominator of the expanded version where common factors
     347         have been canceled.
     348{ def br=basering;                     // the Molien series depends on the
     349  int ch=char(br);                     // characteristic of the coefficient
     350                                       // field -
     351  int g;                               // size of the group
     352 //---------------------- making sure the input is okay -----------------------
     353  if (typeof(#[size(#)])=="intvec")
     354  { if (size(#[size(#)])==3)
     355    { int mol_flag=#[size(#)][1];
     356      if (#[size(#)][2]<0 && (ch==0 or (ch<>0 && mol_flag<>0)))
     357      { "ERROR:   the second component of <intvec> should be >=0"
     358        return();
     359      }
     360      int interval=#[size(#)][2];
     361      int v=#[size(#)][3];
     362    }
     363    else
     364    { "ERROR:   <intvec> should have three components";
     365      return();
     366    }
     367    if (ch<>0)
     368    { if (typeof(#[size(#)-1])=="int")
     369      { int r=#[size(#)-1];
     370        if (typeof(#[size(#)-2])<>"string")
     371        { "ERROR:   in characteristic p>0 a <string> must be given for the name of a new";
     372          "         ring where the Molien series can be stored";
     373          return();
     374        }
     375        else
     376        { if (#[size(#)-2]=="")
     377          { "ERROR:   <string> may not be empty";
     378            return();
     379          }
     380          string newring=#[size(#)-2];
     381          g=size(#)-3;
     382        }
     383      }
     384      else
     385      { if (typeof(#[size(#)-1])<>"string")
     386        { "ERROR:   in characteristic p>0 a <string> must be given for the name of a new";
     387          "         ring where the Molien series can be stored";
     388          return();
     389        }
     390        else
     391        { if (#[size(#)-1]=="")
     392          { "ERROR:   <string> may not be empty";
     393            return();
     394          }
     395          string newring=#[size(#)-1];
     396          g=size(#)-2;
     397          int r=g;
     398        }
     399      }
     400    }
     401    else                               // then <string> ist not needed
     402    { g=size(#)-1;
     403    }
     404  }
     405  else                                 // last parameter is not <intvec>
     406  { int v=0;                           // no information is default
     407    int mol_flag=0;                    // computing of Molien series is default
     408    int interval=0;
     409    if (ch<>0)
     410    { if (typeof(#[size(#)])=="int")
     411      { int r=#[size(#)];
     412        if (typeof(#[size(#)-1])<>"string")
     413        { "ERROR:   in characteristic p>0 a <string> must be given for the name of a new";
     414          "         ring where the Molien series can be stored";
     415            return();
     416        }
     417        else
     418        { if (#[size(#)-1]=="")
     419          { "ERROR:   <string> may not be empty";
     420            return();
     421          }
     422          string newring=#[size(#)-1];
     423          g=size(#)-2;
     424        }
     425      }
     426      else
     427      { if (typeof(#[size(#)])<>"string")
     428        { "ERROR:   in characteristic p>0 a <string> must be given for the name of a new";
     429          "         ring where the Molien series can be stored";
     430          return();
     431        }
     432        else
     433        { if (#[size(#)]=="")
     434          { "ERROR:   <string> may not be empty";
     435            return();
     436          }
     437          string newring=#[size(#)];
     438          g=size(#)-1;
     439          int r=g;
     440        }
     441      }
     442    }
     443    else
     444    { g=size(#);
     445    }
     446  }
     447  if (ch<>0)
     448  { if ((g/r)*r<>g)
     449   { "ERROR:   <int> should divide the group order."
     450      return();
     451    }
     452  }
     453  if (ch<>0)
     454  { if ((g%ch)==0)
     455    { if (voice==2)
     456      { "WARNING: The characteristic of the coefficient field divides the group";
     457        "         order. Proceed without the Molien series!";
     458      }
     459      else
     460      { if (v)
     461        { "  The characteristic of the base field divides the group order.";
     462          "  We have to continue without Molien series...";
     463          "";
     464        }
     465      }
     466    }
     467    if (minpoly<>0 && mol_flag==0)
     468    { if (voice==2)
     469      { "WARNING: It is impossible for this program to calculate the Molien series";
     470        "         for finite groups over extension fields of prime characteristic.";
    486471      }
    487472      else
    … …  
    489474        { "  Since it is impossible for this program to calculate the Molien series for";
    490475          "  invariant rings over extension fields of prime characteristic, we have to";
    491           "  continue without it. The Reynolds operator is available, however.";
     476          "  continue without it.";
    492477          "";
    493478        }
    494479      }
    495       return(A(1));
    496     }
    497   }
    498   if (ch<>0)
    499   { if ((g%ch)==0)
     480      return();
     481    }
     482  }
     483 //----------------------------------------------------------------------------
     484  if (not(typeof(#[1])=="matrix"))
     485  { "ERROR:   the parameters must be a list of matrices and maybe an <intvec>";
     486    return();
     487  }
     488  int n=nrows(#[1]);
     489  if (n<>nvars(br))
     490  { "ERROR:   the number of variables of the basering needs to be the same";
     491    "         as the dimension of the square matrices";
     492    return();
     493  }
     494  if (v && voice<>2)
     495  { "";
     496    "  Generating the Molien series...";
     497    "";
     498  }
     499  if (v && voice==2)
     500  { "";
     501  }
     502 //------------- calculating Molien series in characteristic 0 ----------------
     503  if (ch==0)                           // when ch==0 we can calculate the Molien
     504  { matrix I=diag(1,n);                // series in any case -
     505    poly v1=maxideal(1)[1];            // the Molien series will be in terms of
     506                                       // the first variable of the current
     507                                       // ring -
     508    matrix M[1][2];                    // M will contain the Molien series -
     509    M[1,1]=0;                          // M[1,1] will be the numerator -
     510    M[1,2]=1;                          // M[1,2] will be the denominator -
     511    matrix s;                          // will help us canceling in the
     512                                       // fraction
     513    poly p;                            // will contain the denominator of the
     514                                       // new term of the Molien series
     515 //------------ computing 1/det(1+xE) for all E in the group ------------------
     516    for (int j=1;j<=g;j=j+1)
     517    { if (not(typeof(#[j])=="matrix"))
     518      { "ERROR:   the parameters must be a list of matrices and maybe an <intvec>";
     519        return();
     520      }
     521      if ((n<>nrows(#[j])) or (n<>ncols(#[j])))
     522      { "ERROR:   matrices need to be square and of the same dimensions";
     523         return();
     524      }
     525      p=det(I-v1*#[j]);                // denominator of new term -
     526      M[1,1]=M[1,1]*p+M[1,2];          // expanding M[1,1]/M[1,2] + 1/p
     527      M[1,2]=M[1,2]*p;
     528      if (interval<>0)                 // canceling common terms of denominator
     529      { if ((j/interval)*interval==j or j==g) // and enumerator -
     530        { s=matrix(syz(ideal(M)));     // once gcd() is faster than syz() these
     531          M[1,1]=-s[2,1];              // three lines should be replaced by the
     532          M[1,2]=s[1,1];               // following three
     533          // p=gcd(M[1,1],M[1,2]);
     534          // M[1,1]=M[1,1]/p;
     535          // M[1,2]=M[1,2]/p;
     536        }
     537      }
     538      if (v)
     539      { "  Term "+string(j)+" of the Molien series has been computed.";
     540      }
     541    }
     542    if (interval==0)                   // canceling common terms of denominator
     543    {                                  // and enumerator -
     544      s=matrix(syz(ideal(M)));         // once gcd() is faster than syz() these
     545      M[1,1]=-s[2,1];                  // three lines should be replaced by the
     546      M[1,2]=s[1,1];                   // following three
     547      // p=gcd(M[1,1],M[1,2]);
     548      // M[1,1]=M[1,1]/p;
     549      // M[1,2]=M[1,2]/p;
     550    }
     551    map slead=br,ideal(0);
     552    s=slead(M);
     553    M[1,1]=1/s[1,1]*M[1,1];            // numerator and denominator have to have
     554    M[1,2]=1/s[1,2]*M[1,2];            // a constant term of 1
     555    if (v)
     556    { "";
     557      "  We are done calculating the Molien series.";
     558      "";
     559    }
     560    return(M);
     561  }
     562 //---- calculating Molien series in prime characteristic with Brauer lift ----
     563  if (ch<>0 && mol_flag==0)
     564  { if (g<>1)
     565    { matrix G(1..g)=#[1..g];
     566      if (interval<0)
     567      { string Mstring;
     568      }
     569 //------ preparing everything for Brauer lifts into characteristic 0 ---------
     570      ring Q=0,x,dp;                   // we want to extend our ring as well as
     571                                       // the ring of rational numbers Q to
     572                                       // contain r-th primitive roots of unity
     573                                       // in order to factor characteristic
     574                                       // polynomials of group elements into
     575                                       // linear factors and lift eigenvalues to
     576                                       // characteristic 0 -
     577      poly minq=cyclotomic(r);         // minq now contains the size-of-group-th
     578                                       // cyclotomic polynomial of Q, it is
     579                                       // irreducible there
     580      ring `newring`=(0,e),x,dp;
     581      map f=Q,ideal(e);
     582      minpoly=number(f(minq));         // e is now a r-th primitive root of
     583                                       // unity -
     584      kill Q, f;                       // no longer needed -
     585      poly p=1;                        // used to build the denominator of the
     586                                       // new term in the Molien series
     587      matrix s[1][2];                  // used for canceling -
     588      matrix M[1][2]=0,1;              // will contain Molien series -
     589      ring v1br=char(br),x,dp;         // we calculate the r-th cyclotomic
     590      poly minp=cyclotomic(r);         // polynomial of the base field and pick
     591      minp=factorize(minp)[1][2];      // an irreducible factor of it -
     592      if (deg(minp)==1)                // in this case the base field contains
     593      { ring bre=char(br),x,dp;        // r-th roots of unity already
     594        map f1=v1br,ideal(0);
     595        number e=-number((f1(minp)));  // e is a r-th primitive root of unity
     596      }
     597      else
     598      { ring bre=(char(br),e),x,dp;
     599        map f1=v1br,ideal(e);
     600        minpoly=number(f1(minp));      // e is a r-th primitive root of unity
     601      }
     602      map f2=br,ideal(0);              // we need f2 to map our group elements
     603                                       // to this new extension field bre
     604      matrix xI=diag(x,n);
     605      poly p;                          // used for the characteristic polynomial
     606                                       // to factor -
     607      list L;                          // will contain the linear factors of the
     608      ideal F;                         // characteristic polynomial of the group
     609      intvec C;                        // elements and their powers
     610      int i, j, k;
     611 // -------------- finding all the terms of the Molien series -----------------
     612      for (i=1;i<=g;i=i+1)
     613      { setring br;
     614        if (not(typeof(#[i])=="matrix"))
     615        { "ERROR:   the parameters must be a list of matrices and maybe an <intvec>";
     616          return();
     617        }
     618        if ((n<>nrows(#[i])) or (n<>ncols(#[i])))
     619        { "ERROR:   matrices need to be square and of the same dimensions";
     620           return();
     621        }
     622        setring bre;
     623        p=det(xI-f2(G(i)));            // characteristic polynomial of G(i)
     624        L=factorize(p);
     625        F=L[1];
     626        C=L[2];
     627        for (j=2;j<=ncols(F);j=j+1)
     628        { F[j]=-1*(F[j]-x);            // F[j] is now an eigenvalue of G(i),
     629                                       // it is a power of a primitive r-th root
     630                                       // of unity -
     631          k=exponent(number(F[j]),e);  // F[j]==e^k
     632          setring `newring`;
     633          p=p*(1-x*(e^k))^C[j];        // building the denominator of the new
     634          setring bre;                 // term
     635        }
     636//         -----------
     637//         k=0;
     638//         while(k<r)
     639//         { map f3=basering,ideal(e^k);
     640//           while (f3(p)==0)
     641//           { p=p/(x-e^k);
     642//             setring `newring`;
     643//             p=p*(1-x*(e^k));        // building the denominator of the new
     644//             setring bre;
     645//           }
     646//           kill f3;
     647//           if (p==1)
     648//           { break;
     649//           }
     650//           k=k+1;
     651//         }
     652        setring `newring`;
     653        M[1,1]=M[1,1]*p+M[1,2];        // expanding M[1,1]/M[1,2] + 1/p
     654        M[1,2]=M[1,2]*p;
     655        if (interval<0)
     656        { if (i<>g)
     657          { Mstring=string(M);
     658            for (j=1;j<=size(Mstring);j=j+1)
     659            { if (Mstring[j]=="e")
     660              { interval=0;
     661                break;
     662              }
     663            }
     664          }
     665          if (interval<>0)
     666          { s=matrix(syz(ideal(M)));   // once gcd() is faster than syz()
     667            M[1,1]=-s[2,1];            // these three lines should be
     668            M[1,2]=s[1,1];             // replaced by the following three
     669            // p=gcd(M[1,1],M[1,2]);
     670            // M[1,1]=M[1,1]/p;
     671            // M[1,2]=M[1,2]/p;
     672          }
     673          else
     674          { interval=-1;
     675          }
     676        }
     677        else
     678        { if (interval<>0)             // canceling common terms of denominator
     679          { if ((i/interval)*interval==i or i==g) // and enumerator
     680            { s=matrix(syz(ideal(M))); // once gcd() is faster than syz()
     681              M[1,1]=-s[2,1];          // these three lines should be
     682              M[1,2]=s[1,1];           // replaced by the following three
     683              // p=gcd(M[1,1],M[1,2]);
     684              // M[1,1]=M[1,1]/p;
     685              // M[1,2]=M[1,2]/p;
     686            }
     687          }
     688        }
     689        p=1;
     690        setring bre;
     691        if (v)
     692        { "  Term "+string(i)+" of the Molien series has been computed.";
     693        }
     694      }
     695      if (v)
     696      { "";
     697      }
     698      setring `newring`;
     699      if (interval==0)                 // canceling common terms of denominator
     700      {                                // and enumerator -
     701        s=matrix(syz(ideal(M)));       // once gcd() is faster than syz() these
     702        M[1,1]=-s[2,1];                // three lines should be replaced by the
     703        M[1,2]=s[1,1];                 // following three
     704        // p=gcd(M[1,1],M[1,2]);
     705        // M[1,1]=M[1,1]/p;
     706        // M[1,2]=M[1,2]/p;
     707      }
     708      map slead=`newring`,ideal(0);
     709      s=slead(M);                      // forcing the constant term of numerator
     710      M[1,1]=1/s[1,1]*M[1,1];          // and denominator to be 1
     711      M[1,2]=1/s[1,2]*M[1,2];
     712      kill slead;
     713      kill s;
     714      kill p;
     715    }
     716    else                               // if the group only contains an identity
     717    { ring `newring`=0,x,dp;           // element, it is very easy to calculate
     718      matrix M[1][2]=1,(1-x)^n;        // the Molien series
     719    }
     720    export `newring`;                  // we keep the ring where we computed the
     721    export M;                          // Molien series in such that we can
     722    setring br;                        // keep it
     723    if (v)
     724    { "  We are done calculating the Molien series.";
     725      "";
     726    }
     727  }
     728  else                                 // i.e. char<>0 and mol_flag<>0, the user
     729  {                                    // has specified that we are dealing with
     730                                       // a ring of large characteristic which
     731                                       // can be treated like a ring of
     732                                       // characteristic 0; we'll avoid the
     733                                       // Brauer lifts
     734 //----------------------- simulating characteristic 0 ------------------------
     735    string chst=charstr(br);
     736    for (int i=1;i<=size(chst);i=i+1)
     737    { if (chst[i]==",")
     738      { break;
     739      }
     740    }
     741 //----------------- generating ring of characteristic 0 ----------------------
     742    if (minpoly==0)
     743    { if (i>size(chst))
     744      { execute "ring "+newring+"=0,("+varstr(br)+"),("+ordstr(br)+")";
     745      }
     746      else
     747      { chst=chst[i..size(chst)];
     748        execute "ring "+newring+"=(0"+chst+"),("+varstr(br)+"),("+ordstr(br)+")";
     749      }
     750    }
     751    else
     752    { string minp=string(minpoly);
     753      minp=minp[2..size(minp)-1];
     754      chst=chst[i..size(chst)];
     755      execute "ring "+newring+"=(0"+chst+"),("+varstr(br)+"),("+ordstr(br)+")";
     756      execute "minpoly="+minp;
     757    }
     758    matrix I=diag(1,n);
     759    poly v1=maxideal(1)[1];            // the Molien series will be in terms of
     760                                       // the first variable of the current
     761                                       // ring -
     762    matrix M[1][2];                    // M will contain the Molien series -
     763    M[1,1]=0;                          // M[1,1] will be the numerator -
     764    M[1,2]=1;                          // M[1,2] will be the denominator -
     765    matrix s;                          // will help us canceling in the
     766                                       // fraction
     767    poly p;                            // will contain the denominator of the
     768                                       // new term of the Molien series
     769    int j;
     770    string links, rechts;
     771 //----------------- finding all terms of the Molien series -------------------
     772    for (i=1;i<=g;i=i+1)
     773    { setring br;
     774      if (not(typeof(#[i])=="matrix"))
     775      { "ERROR:   the parameters must be a list of matrices and maybe an <intvec>";
     776        return();
     777      }
     778      if ((n<>nrows(#[i])) or (n<>ncols(#[i])))
     779      { "ERROR:   matrices need to be square and of the same dimensions";
     780         return();
     781      }
     782      string stM(i)=string(#[i]);
     783      for (j=1;j<=size(stM(i));j=j+1)
     784      { if (stM(i)[j]=="
     785")
     786        { links=stM(i)[1..j-1];
     787          rechts=stM(i)[j+1..size(stM(i))];
     788          stM(i)=links+rechts;
     789        }
     790      }
     791      setring `newring`;
     792      execute "matrix G(i)["+string(n)+"]["+string(n)+"]="+stM(i);
     793      p=det(I-v1*G(i));                // denominator of new term -
     794      M[1,1]=M[1,1]*p+M[1,2];          // expanding M[1,1]/M[1,2] + 1/p
     795      M[1,2]=M[1,2]*p;
     796      if (interval<>0)                 // canceling common terms of denominator
     797      { if ((i/interval)*interval==i or i==g) // and enumerator
     798        {
     799          s=matrix(syz(ideal(M)));     // once gcd() is faster than syz() these
     800          M[1,1]=-s[2,1];              // three lines should be replaced by the
     801          M[1,2]=s[1,1];               // following three
     802          // p=gcd(M[1,1],M[1,2]);
     803          // M[1,1]=M[1,1]/p;
     804          // M[1,2]=M[1,2]/p;
     805        }
     806      }
     807      if (v)
     808      { "  Term "+string(i)+" of the Molien series has been computed.";
     809      }
     810    }
     811    if (interval==0)                   // canceling common terms of denominator
     812    {                                  // and enumerator -
     813      s=matrix(syz(ideal(M)));         // once gcd() is faster than syz() these
     814      M[1,1]=-s[2,1];                  // three lines should be replaced by the
     815      M[1,2]=s[1,1];                   // following three
     816      // p=gcd(M[1,1],M[1,2]);
     817      // M[1,1]=M[1,1]/p;
     818      // M[1,2]=M[1,2]/p;
     819    }
     820    map slead=`newring`,ideal(0);
     821    s=slead(M);
     822    M[1,1]=1/s[1,1]*M[1,1];            // numerator and denominator have to have
     823    M[1,2]=1/s[1,2]*M[1,2];            // a constant term of 1
     824    if (v)
     825    { "";
     826      "  We are done calculating the Molien series.";
     827      "";
     828    }
     829    kill G(1..g), s, slead, p, v1, I;
     830    export `newring`;                  // we keep the ring where we computed the
     831    export M;                          // the Molien series such that we can
     832    setring br;                        // keep it
     833  }
     834}
     835example
     836{ "EXAMPLE: Sturmfels: Algorithms in Invariant Theory 2.3.7:";
     837  "         note the case of prime characteristic";
     838  echo=2;
     839         ring R=0,(x,y,z),dp;
     840         matrix A[3][3]=0,1,0,-1,0,0,0,0,-1;
     841         list L=group_reynolds(A);
     842         matrix M=molien(L[2..size(L)]);
     843         print(M);
     844         ring S=3,(x,y,z),dp;
     845         string newring="alksdfjlaskdjf";
     846         matrix A[3][3]=0,1,0,-1,0,0,0,0,-1;
     847         list L=group_reynolds(A);
     848         molien(L[2..size(L)],newring);
     849         setring alksdfjlaskdjf;
     850         print(M);
     851         setring S;
     852         kill alksdfjlaskdjf;
     853}
     854
     855proc reynolds_molien (list #)
     856USAGE:   reynolds_molien(G1,G2,...[,ringname,flags]);
     857         G1,G2,...: nxn <matrices> generating a finite matrix group, ringname:
     858         a <string> giving a name for a new ring of characteristic 0 for the
     859         Molien series in case of prime characteristic, flags: an optional
     860         <intvec> with three components: if the first element is not equal to 0
     861         characteristic 0 is simulated, i.e. the Molien series is computed as
     862         if the base field were characteristic 0 (the user must choose a field
     863         of large prime characteristic, e.g. 32003) the second component should
     864         give the size of intervals between canceling common factors in the
     865         expansion of the Molien series, 0 (the default) means only once after
     866         generating all terms, in prime characteristic also a negative number
     867         can be given to indicate that common factors should always be canceled
     868         when the expansion is simple (the root of the extension field does not
     869         occur among the coefficients)
     870ASSUME:  n is the number of variables of the basering, G1,G2... are the group
     871         elements generated by group_reynolds(), g is the size of the group
     872RETURN:  a gxn <matrix> representing the Reynolds operator is the first return
     873         value and in case of characteristic 0 a 1x2 <matrix> giving enumerator
     874         and denominator of Molien series is the second one; in case of prime
     875         characteristic a ring with the name `ringname` of characteristic 0 is
     876         created where the same Molien series (named M) is stored
     877DISPLAY: information if the third component of flags does not equal 0
     878EXAMPLE: example reynolds_molien; shows an example
     879THEORY:  The entire matrix group is generated by getting all left products of
     880         the generators with the new elements from the last run through the loop
     881         (or the generators themselves during the first run). All the ones that
     882         have been generated before are thrown out and the program terminates
     883         when there are no new elements found in one run. Additionally each time
     884         a new group element is found the corresponding ring mapping of which
     885         the Reynolds operator is made up is generated. They are stored in the
     886         rows of the first return value. In characteristic 0 the terms
     887         1/det(1-xE) is computed whenever a new element E is found. In prime
     888         characteristic a Brauer lift is involved and the terms are only
     889         computed after the entire matrix group is generated (to avoid the
     890         modular case). The returned matrix gives enumerator and denominator of
     891         the expanded version where common factors have been canceled.
     892{ def br=basering;                     // the Molien series depends on the
     893  int ch=char(br);                     // characteristic of the coefficient
     894                                       // field
     895  int gen_num;
     896 //------------------- making sure the input is okay --------------------------
     897  if (typeof(#[size(#)])=="intvec")
     898  { if (size(#[size(#)])==3)
     899    { int mol_flag=#[size(#)][1];
     900      if (#[size(#)][2]<0 && (ch==0 or (ch<>0 && mol_flag<>0)))
     901      { "ERROR:   the second component of the <intvec> should be >=0";
     902        return();
     903      }
     904      int interval=#[size(#)][2];
     905      int v=#[size(#)][3];
     906    }
     907    else
     908    { "ERROR:   <intvec> should have three components";
     909      return();
     910    }
     911    if (ch<>0)
     912    { if (typeof(#[size(#)-1])<>"string")
     913      { "ERROR:   in characteristic p a <string> must be given for the name";
     914        "         of a new ring where the Molien series can be stored";
     915        return();
     916      }
     917      else
     918      { if (#[size(#)-1]=="")
     919        { "ERROR:   <string> may not be empty";
     920          return();
     921        }
     922        string newring=#[size(#)-1];
     923        gen_num=size(#)-2;
     924      }
     925    }
     926    else                               // then <string> ist not needed
     927    { gen_num=size(#)-1;
     928    }
     929  }
     930  else                                 // last parameter is not <intvec>
     931  { int v=0;                           // no information is default
     932    int interval;
     933    int mol_flag=0;                    // computing of Molien series is default
     934    if (ch<>0)
     935    { if (typeof(#[size(#)])<>"string")
     936      { "ERROR:   in characteristic p a <string> must be given for the name";
     937        "         of a new ring where the Molien series can be stored";
     938        return();
     939      }
     940      else
     941      { if (#[size(#)]=="")
     942        { "ERROR:   <string> may not be empty";
     943          return();
     944        }
     945        string newring=#[size(#)];
     946        gen_num=size(#)-1;
     947      }
     948    }
     949    else
     950    { gen_num=size(#);
     951    }
     952  }
     953 // ----------------- computing the terms with Brauer lift --------------------
     954  if (ch<>0 && mol_flag==0)
     955  { list L=group_reynolds(#[1..gen_num],v);
     956    if (L[1]==0)
    500957    { if (voice==2)
    501       { A(1)=0;
    502         "  WARNING: The characteristic of the coefficient field divides the group";
    503         "           order. Proceed without the Molien series or Reynolds operator!";
     958      { "WARNING: The characteristic of the coefficient field divides the group order.";
     959        "         Proceed without the Reynolds operator or the Molien series!";
     960        return();
     961      }
     962      if (v)
     963      { "  The characteristic of the base field divides the group order.";
     964        "  We have to continue without Reynolds operator or the Molien series...";
     965        return();
     966      }
     967    }
     968    if (minpoly<>0)
     969    { if (voice==2)
     970      { "WARNING: It is impossible for this program to calculate the Molien series";
     971        "         for finite groups over extension fields of prime characteristic.";
     972        return(L[1]);
    504973      }
    505974      else
    506975      { if (v)
    507         { "  The characteristic of the base field divides the group order.";
    508           "  We have to continue without Molien series and without Reynolds";
    509           "  operator..";
    510           "";
    511         }
    512       }
    513       return(A(1));
    514     }
    515   }
     976        { "  Since it is impossible for this program to calculate the Molien series for";
     977          "  invariant rings over extension fields of prime characteristic, we have to";
     978          "  continue without it.";
     979          return(L[1]);
     980        }
     981      }
     982    }
     983    if (typeof(L[2])=="int")
     984    { molien(L[3..size(L)],newring,L[2],intvec(mol_flag,interval,v));
     985    }
     986    else
     987    { molien(L[2..size(L)],newring,intvec(mol_flag,interval,v));
     988    }
     989    return(L[1]);
     990  }
     991 //----------- computing Molien series in the straight forward way ------------
    516992  if (ch==0)
    517   { map slead=br,ideal(0);
     993  { if (typeof(#[1])<>"matrix")
     994    { "ERROR:   the parameters must be a list of matrices and maybe an <intvec>";
     995      return();
     996    }
     997    int n=nrows(#[1]);
     998    if (n<>nvars(br))
     999    { "ERROR:   the number of variables of the basering needs to be the same";
     1000      "         as the dimension of the matrices";
     1001      return();
     1002    }
     1003    if (n<>ncols(#[1]))
     1004    { "ERROR:   matrices need to be square and of the same dimensions";
     1005      return();
     1006    }
     1007    matrix vars=matrix(maxideal(1));   // creating an nx1-matrix containing the
     1008    vars=transpose(vars);              // variables of the ring -
     1009    matrix A(1)=#[1]*vars;             // calculating the first ring mapping -
     1010                                       // A(1) will contain the Reynolds
     1011                                       // operator -
     1012    poly v1=vars[1,1];                 // the Molien series will be in terms of
     1013                                       // the first variable of the current
     1014                                       // ring
     1015    matrix I=diag(1,n);
     1016    matrix A(2)[1][2];                 // A(2) will contain the Molien series -
     1017    A(2)[1,1]=1;                       // A(2)[1,1] will be the numerator
     1018    matrix G(1)=#[1];                  // G(k) are elements of the group -
     1019    A(2)[1,2]=det(I-v1*(G(1)));        // A(2)[1,2] will be the denominator -
     1020    matrix s;                          // will help us canceling in the
     1021                                       // fraction
     1022    poly p;                            // will contain the denominator of the
     1023                                       // new term of the Molien series
     1024    int i=1;
     1025    for (int j=2;j<=gen_num;j=j+1)     // this loop adds the parameters to the
     1026    {                                  // group, leaving out doubles and
     1027                                       // checking whether the parameters are
     1028                                       // compatible with the task of the
     1029                                       // procedure
     1030      if (not(typeof(#[j])=="matrix"))
     1031      { "ERROR:   the parameters must be a list of matrices and maybe an <intvec>";
     1032        return();
     1033      }
     1034      if ((n!=nrows(#[j])) or (n!=ncols(#[j])))
     1035      { "ERROR:   matrices need to be square and of the same dimensions";
     1036         return();
     1037      }
     1038      if (unique(G(1..i),#[j]))
     1039      { i=i+1;
     1040        matrix G(i)=#[j];
     1041        A(1)=concat(A(1),#[j]*vars);   // adding ring homomorphisms to A(1) -
     1042        p=det(I-v1*#[j]);              // denominator of new term -
     1043        A(2)[1,1]=A(2)[1,1]*p+A(2)[1,2]; // expanding A(2)[1,1]/A(2)[1,2] +1/p
     1044        A(2)[1,2]=A(2)[1,2]*p;
     1045        if (interval<>0)               // canceling common terms of denominator
     1046        { if ((i/interval)*interval==i) // and enumerator
     1047          {
     1048            s=matrix(syz(ideal(A(2)))); // once gcd() is faster than syz() these
     1049            A(2)[1,1]=-s[2,1];         // three lines should be replaced by the
     1050            A(2)[1,2]=s[1,1];          // following three
     1051            // p=gcd(A(2)[1,1],A(2)[1,2]);
     1052            // A(2)[1,1]=A(2)[1,1]/p;
     1053            // A(2)[1,2]=A(2)[1,2]/p;
     1054          }
     1055        }
     1056      }
     1057    }
     1058    int g=i;                           // G(1)..G(i) are generators without
     1059                                       // doubles - g generally is the number
     1060                                       // of elements in the group so far -
     1061    j=i;                               // j is the number of new elements that
     1062                                       // we use as factors
     1063    int k, m, l;
     1064    if (v)
     1065    { "";
     1066      "  Generating the entire matrix group. Whenever a new group element is found,";
     1067      "  the coressponding ring homomorphism of the Reynolds operator and the";
     1068      "  corresponding term of the Molien series is generated.";
     1069      "";
     1070    }
     1071 //----------- computing 1/det(I-xE) whenever a new element E is found --------
     1072    while (1)
     1073    { l=0;                             // l is the number of products we get in
     1074                                       // one going
     1075      for (m=g-j+1;m<=g;m=m+1)
     1076      { for (k=1;k<=i;k=k+1)
     1077        { l=l+1;
     1078          matrix P(l)=G(k)*G(m);       // possible new element
     1079        }
     1080      }
     1081      j=0;
     1082      for (k=1;k<=l;k=k+1)
     1083      { if (unique(G(1..g),P(k)))
     1084        { j=j+1;                       // a new factor for next run
     1085          g=g+1;
     1086          matrix G(g)=P(k);            // a new group element -
     1087          A(1)=concat(A(1),P(k)*vars); // adding new mapping to A(1)
     1088          p=det(I-v1*P(k));            // denominator of new term
     1089          A(2)[1,1]=A(2)[1,1]*p+A(2)[1,2];
     1090          A(2)[1,2]=A(2)[1,2]*p;       // expanding A(2)[1,1]/A(2)[1,2] + 1/p -
     1091          if (interval<>0)             // canceling common terms of denominator
     1092          { if ((g/interval)*interval==g) // and enumerator
     1093            {
     1094              s=matrix(syz(ideal(A(2)))); // once gcd() is faster than syz()
     1095              A(2)[1,1]=-s[2,1];       // these three lines should be replaced
     1096              A(2)[1,2]=s[1,1];        // by the following three
     1097              // p=gcd(A(2)[1,1],A(2)[1,2]);
     1098              // A(2)[1,1]=A(2)[1,1]/p;
     1099              // A(2)[1,2]=A(2)[1,2]/p;
     1100            }
     1101          }
     1102          if (v)
     1103          { "  Group element "+string(g)+" has been found.";
     1104          }
     1105        }
     1106        kill P(k);
     1107      }
     1108      if (j==0)                        // when we didn't add any new elements
     1109      { break;                         // in one run through the while loop
     1110      }                                // we are done
     1111    }
     1112    if (v)
     1113    { if (g<=i)
     1114      { "  There are only "+string(g)+" group elements.";
     1115      }
     1116      "";
     1117    }
     1118    A(1)=transpose(A(1));              // when we evaluate the Reynolds operator
     1119                                       // later on, we actually want 1xn
     1120                                       // matrices
     1121    if (interval==0)                   // canceling common terms of denominator
     1122    {                                  // and enumerator -
     1123      s=matrix(syz(ideal(A(2))));      // once gcd() is faster than syz()
     1124      A(2)[1,1]=-s[2,1];               // these three lines should be replaced
     1125      A(2)[1,2]=s[1,1];                // by the following three
     1126      // p=gcd(A(2)[1,1],A(2)[1,2]);
     1127      // A(2)[1,1]=A(2)[1,1]/p;
     1128      // A(2)[1,2]=A(2)[1,2]/p;
     1129    }
     1130    if (interval<>0)                   // canceling common terms of denominator
     1131    { if ((g/interval)*interval<>g)    // and enumerator
     1132      {
     1133        s=matrix(syz(ideal(A(2))));    // once gcd() is faster than syz()
     1134        A(2)[1,1]=-s[2,1];             // these three lines should be replaced
     1135        A(2)[1,2]=s[1,1];              // by the following three
     1136        // p=gcd(A(2)[1,1],A(2)[1,2]);
     1137        // A(2)[1,1]=A(2)[1,1]/p;
     1138        // A(2)[1,2]=A(2)[1,2]/p;
     1139      }
     1140    }
     1141    map slead=br,ideal(0);
    5181142    s=slead(A(2));
    5191143    A(2)[1,1]=1/s[1,1]*A(2)[1,1];      // numerator and denominator have to have
    … …  
    5251149    return(A(1..2));
    5261150  }
     1151 //------------------------ simulating characteristic 0 -----------------------
     1152  else                                 // if ch<>0 and mol_flag<>0
     1153  { if (typeof(#[1])<>"matrix")
     1154    { "ERROR:   the parameters must be a list of matrices and maybe an <intvec>";
     1155      return();
     1156    }
     1157    int n=nrows(#[1]);
     1158    if (n<>nvars(br))
     1159    { "ERROR:   the number of variables of the basering needs to be the same";
     1160      "         as the dimension of the matrices";
     1161      return();
     1162    }
     1163    if (n<>ncols(#[1]))
     1164    { "ERROR:   matrices need to be square and of the same dimensions";
     1165      return();
     1166    }
     1167    matrix vars=matrix(maxideal(1));   // creating an nx1-matrix containing the
     1168    vars=transpose(vars);              // variables of the ring -
     1169    matrix A(1)=#[1]*vars;             // calculating the first ring mapping -
     1170                                       // A(1) will contain the Reynolds
     1171                                       // operator
     1172    string chst=charstr(br);
     1173    for (int i=1;i<=size(chst);i=i+1)
     1174    { if (chst[i]==",")
     1175      { break;
     1176      }
     1177    }
     1178    if (minpoly==0)
     1179    { if (i>size(chst))
     1180      { execute "ring "+newring+"=0,("+varstr(br)+"),("+ordstr(br)+")";
     1181      }
     1182      else
     1183      { chst=chst[i..size(chst)];
     1184        execute "ring "+newring+"=(0"+chst+"),("+varstr(br)+"),("+ordstr(br)+")";
     1185      }
     1186    }
     1187    else
     1188    { string minp=string(minpoly);
     1189      minp=minp[2..size(minp)-1];
     1190      chst=chst[i..size(chst)];
     1191      execute "ring "+newring+"=(0"+chst+"),("+varstr(br)+"),("+ordstr(br)+")";
     1192      execute "minpoly="+minp;
     1193    }
     1194    poly v1=var(1);                    // the Molien series will be in terms of
     1195                                       // the first variable of the current
     1196                                       // ring
     1197    matrix I=diag(1,n);
     1198    int o;
     1199    setring br;
     1200    matrix G(1)=#[1];
     1201    string links, rechts;
     1202    string stM(1)=string(#[1]);
     1203    for (o=1;o<=size(stM(1));o=o+1)
     1204    { if (stM(1)[o]=="
     1205")
     1206      { links=stM(1)[1..o-1];
     1207        rechts=stM(1)[o+1..size(stM(1))];
     1208        stM(1)=links+rechts;
     1209      }
     1210    }
     1211    setring `newring`;
     1212    execute "matrix G(1)["+string(n)+"]["+string(n)+"]="+stM(1);
     1213    matrix A(2)[1][2];                 // A(2) will contain the Molien series -
     1214    A(2)[1,1]=1;                       // A(2)[1,1] will be the numerator
     1215    A(2)[1,2]=det(I-v1*(G(1)));        // A(2)[1,2] will be the denominator -
     1216    matrix s;                          // will help us canceling in the
     1217                                       // fraction
     1218    poly p;                            // will contain the denominator of the
     1219                                       // new term of the Molien series
     1220    i=1;
     1221    for (int j=2;j<=gen_num;j=j+1)     // this loop adds the parameters to the
     1222    {                                  // group, leaving out doubles and
     1223                                       // checking whether the parameters are
     1224                                       // compatible with the task of the
     1225                                       // procedure
     1226      setring br;
     1227      if (not(typeof(#[j])=="matrix"))
     1228      { "ERROR:   the parameters must be a list of matrices and maybe an <intvec>";
     1229        return();
     1230      }
     1231      if ((n!=nrows(#[j])) or (n!=ncols(#[j])))
     1232      { "ERROR:   matrices need to be square and of the same dimensions";
     1233         return();
     1234      }
     1235      if (unique(G(1..i),#[j]))
     1236      { i=i+1;
     1237        matrix G(i)=#[j];
     1238        A(1)=concat(A(1),G(i)*vars);   // adding ring homomorphisms to A(1)
     1239        string stM(i)=string(G(i));
     1240        for (o=1;o<=size(stM(i));o=o+1)
     1241        { if (stM(i)[o]=="
     1242")
     1243          { links=stM(i)[1..o-1];
     1244            rechts=stM(i)[o+1..size(stM(i))];
     1245            stM(i)=links+rechts;
     1246          }
     1247        }
     1248        setring `newring`;
     1249        execute "matrix G(i)["+string(n)+"]["+string(n)+"]="+stM(i);
     1250        p=det(I-v1*G(i));              // denominator of new term -
     1251        A(2)[1,1]=A(2)[1,1]*p+A(2)[1,2]; // expanding A(2)[1,1]/A(2)[1,2] +1/p
     1252        A(2)[1,2]=A(2)[1,2]*p;
     1253        if (interval<>0)               // canceling common terms of denominator
     1254        { if ((i/interval)*interval==i) // and enumerator
     1255          {
     1256            s=matrix(syz(ideal(A(2)))); // once gcd() is faster than syz() these
     1257            A(2)[1,1]=-s[2,1];         // three lines should be replaced by the
     1258            A(2)[1,2]=s[1,1];          // following three
     1259            // p=gcd(A(2)[1,1],A(2)[1,2]);
     1260            // A(2)[1,1]=A(2)[1,1]/p;
     1261            // A(2)[1,2]=A(2)[1,2]/p;
     1262          }
     1263        }
     1264        setring br;
     1265      }
     1266    }
     1267    int g=i;                           // G(1)..G(i) are generators without
     1268                                       // doubles - g generally is the number
     1269                                       // of elements in the group so far -
     1270    j=i;                               // j is the number of new elements that
     1271                                       // we use as factors
     1272    int k, m, l;
     1273    if (v)
     1274    { "";
     1275      "  Generating the entire matrix group. Whenever a new group element is found,";
     1276      "  the coressponding ring homomorphism of the Reynolds operator and the";
     1277      "  corresponding term of the Molien series is generated.";
     1278      "";
     1279    }
     1280 // taking all elements in a ring of characteristic 0 and computing the terms
     1281 // of the Molien series there
     1282    while (1)
     1283    { l=0;                             // l is the number of products we get in
     1284                                       // one going
     1285      for (m=g-j+1;m<=g;m=m+1)
     1286      { for (k=1;k<=i;k=k+1)
     1287        { l=l+1;
     1288          matrix P(l)=G(k)*G(m);       // possible new element
     1289        }
     1290      }
     1291      j=0;
     1292      for (k=1;k<=l;k=k+1)
     1293      { if (unique(G(1..g),P(k)))
     1294        { j=j+1;                       // a new factor for next run
     1295          g=g+1;
     1296          matrix G(g)=P(k);            // a new group element -
     1297          A(1)=concat(A(1),G(g)*vars); // adding new mapping to A(1)
     1298          string stM(g)=string(G(g));
     1299          for (o=1;o<=size(stM(g));o=o+1)
     1300          { if (stM(g)[o]=="
     1301")
     1302            { links=stM(g)[1..o-1];
     1303              rechts=stM(g)[o+1..size(stM(g))];
     1304              stM(g)=links+rechts;
     1305            }
     1306          }
     1307          setring `newring`;
     1308          execute "matrix G(g)["+string(n)+"]["+string(n)+"]="+stM(g);
     1309          p=det(I-v1*G(g));            // denominator of new term
     1310          A(2)[1,1]=A(2)[1,1]*p+A(2)[1,2];
     1311          A(2)[1,2]=A(2)[1,2]*p;       // expanding A(2)[1,1]/A(2)[1,2] + 1/p -
     1312          if (interval<>0)             // canceling common terms of denominator
     1313          { if ((g/interval)*interval==g) // and enumerator
     1314            {
     1315              s=matrix(syz(ideal(A(2)))); // once gcd() is faster than syz()
     1316              A(2)[1,1]=-s[2,1];       // these three lines should be replaced
     1317              A(2)[1,2]=s[1,1];        // by the following three
     1318              // p=gcd(A(2)[1,1],A(2)[1,2]);
     1319              // A(2)[1,1]=A(2)[1,1]/p;
     1320              // A(2)[1,2]=A(2)[1,2]/p;
     1321            }
     1322          }
     1323          if (v)
     1324          { "  Group element "+string(g)+" has been found.";
     1325          }
     1326          setring br;
     1327        }
     1328        kill P(k);
     1329      }
     1330      if (j==0)                        // when we didn't add any new elements
     1331      { break;                         // in one run through the while loop
     1332      }                                // we are done
     1333    }
     1334    if (v)
     1335    { if (g<=i)
     1336      { "  There are only "+string(g)+" group elements.";
     1337      }
     1338      "";
     1339    }
     1340    A(1)=transpose(A(1));              // when we evaluate the Reynolds operator
     1341                                       // later on, we actually want 1xn
     1342                                       // matrices
     1343    setring `newring`;
     1344    if (interval==0)                   // canceling common terms of denominator
     1345    {                                  // and enumerator -
     1346      s=matrix(syz(ideal(A(2))));      // once gcd() is faster than syz()
     1347      A(2)[1,1]=-s[2,1];               // these three lines should be replaced
     1348      A(2)[1,2]=s[1,1];                // by the following three
     1349      // p=gcd(A(2)[1,1],A(2)[1,2]);
     1350      // A(2)[1,1]=A(2)[1,1]/p;
     1351      // A(2)[1,2]=A(2)[1,2]/p;
     1352    }
     1353    if (interval<>0)                   // canceling common terms of denominator
     1354    { if ((g/interval)*interval<>g)    // and enumerator
     1355      {
     1356        s=matrix(syz(ideal(A(2))));    // once gcd() is faster than syz()
     1357        A(2)[1,1]=-s[2,1];             // these three lines should be replaced
     1358        A(2)[1,2]=s[1,1];              // by the following three
     1359        // p=gcd(A(2)[1,1],A(2)[1,2]);
     1360        // A(2)[1,1]=A(2)[1,1]/p;
     1361        // A(2)[1,2]=A(2)[1,2]/p;
     1362      }
     1363    }
     1364    map slead=`newring`,ideal(0);
     1365    s=slead(A(2));
     1366    A(2)[1,1]=1/s[1,1]*A(2)[1,1];      // numerator and denominator have to have
     1367    A(2)[1,2]=1/s[1,2]*A(2)[1,2];      // a constant term of 1
     1368    if (v)
     1369    { "  Now we are done calculating Molien series and Reynolds operator.";
     1370      "";
     1371    }
     1372    matrix M=A(2);
     1373    kill G(1..g), s, slead, p, v1, I, A(2);
     1374    export `newring`;                  // we keep the ring where we computed the
     1375    export M;                          // the Molien series such that we can
     1376    setring br;                        // keep it
     1377    return(A(1));
     1378  }
    5271379}
    5281380example
    529 { "  EXAMPLE: Sturmfels: Algorithms in Invariant Theory 2.3.7:";
    530   "           note the case of prime characteristic";
     1381{ "EXAMPLE: Sturmfels: Algorithms in Invariant Theory 2.3.7:";
     1382  "         note the case of prime characteristic";
    5311383  echo=2;
    532            ring R=0,(x,y,z),dp;
    533            matrix A[3][3]=0,1,0,-1,0,0,0,0,-1;
    534            matrix RM(1..2);
    535            RM(1..2)=rey_mol(A);
    536            print(RM(1..2));
    537            ring S=3,(x,y,z),dp;
    538            string newring="Qadjoint";
    539            matrix A[3][3]=0,1,0,-1,0,0,0,0,-1;
    540            matrix REY=rey_mol(A,newring);
    541            print(REY);
    542            setring Qadjoint;
    543            M;
    544            setring S;
    545            kill Qadjoint;
     1384         ring R=0,(x,y,z),dp;
     1385         matrix A[3][3]=0,1,0,-1,0,0,0,0,-1;
     1386         matrix REY,M=reynolds_molien(A);
     1387         print(REY);
     1388         print(M);
     1389         ring S=3,(x,y,z),dp;
     1390         string newring="Qadjoint";
     1391         matrix A[3][3]=0,1,0,-1,0,0,0,0,-1;
     1392         matrix REY=reynolds_molien(A,newring);
     1393         print(REY);
     1394         setring Qadjoint;
     1395         print(M);
     1396         setring S;
     1397         kill Qadjoint;
    5461398}
    5471399
    548 ////////////////////////////////////////////////////////////////////////////////
    549 // This procedure implements the following calculation:
    550 // (1+a[1]x+a[2]x2+...+a[n]xn)/(1+b[1]x+b[2]x2+...+b[m]xm)=(1+(a[1]-b[1])x+...
    551 // (1+b[1]x+b[2]x2+...+b[m]xm)
    552 // ---------------------------
    553 //    (a[1]-b[1])x+(a[2]-b[2])x2+...
    554 //    (a[1]-b[1])x+b[1](a[1]-b[1])x2+...
    555 ////////////////////////////////////////////////////////////////////////////////
    556 proc part_mol (matrix M, int n, list #)
    557   USAGE:   part_mol(M,n[,p]); M <matrix> (return value of 'rey_mol'), n <int>,
    558            indicating  number of terms in the expansion, p <poly> optionally, it
    559            ought to be the second return value of a previous run of 'part_mol'
    560            and avoids recalculating known terms
    561   RETURNS: n terms of partial expansion of the Molien series (type <poly>)
    562            (first n if there is no third argument given, otherwise the next n
    563            terms depending on a previous calculation) and an intermediate result
    564            (type <poly>) of the calculation to be used as third argument in a
    565            next run
    566   EXAMPLE: example part_mol; shows an example
     1400proc partial_molien (matrix M, int n, list #)
     1401USAGE:   partial_molien(M,n[,p]);
     1402         M: a 1x2 <matrix>, n: an <int> indicating  number of terms in the
     1403         expansion, p: an optional <poly>
     1404ASSUME:  M is the return value of molien or the second return value of
     1405         reynolds_molien, p ought to be the second return value of a previous
     1406         run of partial_molien and avoids recalculating known terms
     1407RETURN:  n terms (type <poly>) of the partial expansion of the Molien series
     1408         (first n if there is no third parameter given, otherwise the next n
     1409         terms depending on a previous calculation) and an intermediate result
     1410         (type <poly>) of the calculation to be used as third parameter in a next
     1411         run of partial_molien
     1412THEORY:  The following calculation is implemented:
     1413         (1+a1x+a2x^2+...+anx^n)/(1+b1x+b2x^2+...+bmx^m)=(1+(a1-b1)x+...
     1414         (1+b1x+b2x^2+...+bmx^m)
     1415         -----------------------
     1416            (a1-b1)x+(a2-b2)x^2+...
     1417            (a1-b1)x+b1(a1-b1)x^2+...
     1418EXAMPLE: example partial_molien; shows an example
    5671419{ poly A(2);                           // A(2) will contain the return value of
    5681420                                       // the intermediate result
    5691421  if (char(basering)<>0)
    570   { "  ERROR:   you have to change to a basering of characteristic 0, one in";
    571     "           which the Molien series is defined";
     1422  { "ERROR:   you have to change to a basering of characteristic 0, one in";
     1423    "         which the Molien series is defined";
    5721424  }
    5731425  if (ncols(M)==2 && nrows(M)==1 && n>0 && size(#)<2)
    … …  
    5761428    matrix s=slead(M);
    5771429    if (s[1,1]<>1 || s[1,2]<>1)
    578     { "  ERROR:   the constant terms of enumerator and denominator are not 1";
     1430    { "ERROR:   the constant terms of enumerator and denominator are not 1";
    5791431      return();
    5801432    }
    5811433
    5821434    if (size(#)==0)
    583     { A(2)=M[1,1];                     // if a third argument is not given, the
     1435    { A(2)=M[1,1];                     // if a third parameter is not given, the
    5841436                                       // intermediate result from the last run
    5851437                                       // corresponds to the numerator - we need
    … …  
    5901442      }                                // with its smallest term
    5911443      else
    592       { "  ERROR:   <poly> as third argument expected";
     1444      { "ERROR:   <poly> as third parameter expected";
    5931445        return();
    5941446      }
    5951447    }
    596     poly A(1)=M[1,2];                  // denominator of Molien series
    597                                        // (for now) -
     1448    poly A(1)=M[1,2];                  // denominator of Molien series (for now)
    5981449    string mp=string(minpoly);
    5991450    execute "ring R=("+charstr(br)+"),("+varstr(br)+"),ds;";
    … …  
    6141465  }
    6151466  else
    616   { "  ERROR:   the first argument has to be a 1x2-matrix, i.e. the matrix";
    617     "           returned by the procedure 'rey_mol', the second one";
    618     "           should be > 0 and there should be no more than 3 arguments;"
     1467  { "ERROR:   the first parameter has to be a 1x2-matrix, i.e. the matrix";
     1468    "         returned by the procedure 'reynolds_molien', the second one";
     1469    "         should be > 0 and there should be no more than 3 parameters;"
    6191470    return();
    6201471  }
    6211472}
    6221473example
    623 { "  EXAMPLE: Sturmfels: Algorithms in Invariant Theory 2.3.7:";
     1474{ "EXAMPLE: Sturmfels: Algorithms in Invariant Theory 2.3.7:";
    6241475  echo=2;
    625            ring R=0,(x,y,z),dp;
    626            matrix A[3][3]=0,1,0,-1,0,0,0,0,-1;
    627            matrix B(1..2);
    628            B(1..2)=rey_mol(A);
    629            poly C(1..2);
    630            C(1..2)=part_mol(B(2),5);
    631            C(1);
    632            C(1..2)=part_mol(B(2),5,C(2));
    633            C(1);
     1476         ring R=0,(x,y,z),dp;
     1477         matrix A[3][3]=0,1,0,-1,0,0,0,0,-1;
     1478         matrix REY,M=reynolds_molien(A);
     1479         poly p(1..2);
     1480         p(1..2)=partial_molien(M,5);
     1481         p(1);
     1482         p(1..2)=partial_molien(M,5,p(2));
     1483         p(1);
    6341484}
    6351485
    636 ////////////////////////////////////////////////////////////////////////////////
    637 // RO will simply be cut into pieces and each row will act as a ring
    638 // mapping of which the Reynolds operator is made up.
    639 ////////////////////////////////////////////////////////////////////////////////
    640 proc eval_rey (matrix RO, poly f)
    641   USAGE:   eval_rey(RO,f); RO <matrix> (result of rey_mol),
    642            f <poly>
    643   RETURNS: image of f under the Reynolds operator (type <poly>)
    644   NOTE:    the characteristic of the coefficient field of the polynomial ring
    645            should not divide the order of the finite matrix group
    646   EXAMPLE: example eval_rey; shows an example
     1486proc evaluate_reynolds (matrix REY, ideal I)
     1487USAGE:   evaluate_reynolds(REY,I);
     1488         REY: a <matrix> representing the Reynolds operator, I: an arbitrary
     1489         <ideal>
     1490ASSUME:  REY is the first return value of group_reynolds() or reynolds_molien()
     1491RETURNS: image of the polynomials defining I under the Reynolds operator
     1492         (type <ideal>)
     1493NOTE:    the characteristic of the coefficient field of the polynomial ring
     1494         should not divide the order of the finite matrix group
     1495EXAMPLE: example evaluate_reynolds; shows an example
     1496THEORY:  REY has been constructed in such a way that each row serves as a ring
     1497         mapping of which the Reynolds operator is made up.
    6471498{ def br=basering;
    6481499  int n=nvars(br);
    649   if (ncols(RO)==n)
    650   { int m;                             // we need m to 'cut' the ring
    651                                        // homomorphisms 'out' of RO and to
    652     m=nrows(RO);                       // divide by the group order in the end
    653     poly p=0;
    654     map pRO;
    655     matrix RH[1][n];
     1500  if (ncols(REY)==n)
     1501  { int m=nrows(REY);                  // we need m to 'cut' the ring
     1502                                       // homomorphisms 'out' of REY and to
     1503                                       // divide by the group order in the end
     1504    int num_poly=ncols(I);
     1505    matrix MI=matrix(I);
     1506    matrix MiI[1][num_poly];
     1507    map pREY;
     1508    matrix rowREY[1][n];
    6561509    for (int i=1;i<=m;i=i+1)
    657     { RH=RO[i,1..n];
    658       pRO=br,ideal(RH);                // f is now the i-th ring homomorphism
    659       p=pRO(f)+p;
    660     }
    661     p=(1/poly(m))*p;
    662     return(p);
     1510    { rowREY=REY[i,1..n];
     1511      pREY=br,ideal(rowREY);           // f is now the i-th ring homomorphism
     1512      MiI=pREY(MI)+MiI;
     1513    }
     1514    MiI=(1/number(m))*MiI;
     1515    return(ideal(MiI));
    6631516  }
    6641517  else
    665   { "  ERROR:   the number of columns in the matrix, being the first argument";
    666     "           should be the same as number of variables in the basering, in";
    667     "           fact it should be the matrix returned by 'rey_mol'";
     1518  { "ERROR:   the number of columns in the <matrix> should be the same as the";
     1519    "         number of variables in the basering; in fact it should be first";
     1520    "         return value of group_reynolds() or reynolds_molien().";
    6681521    return();
    6691522  }
    6701523}
    6711524example
    672 { "  EXAMPLE: Sturmfels: Algorithms in Invariant Theory 2.3.7:";
     1525{ "EXAMPLE: Sturmfels: Algorithms in Invariant Theory 2.3.7:";
    6731526  echo=2;
    674            ring R=0,(x,y,z),dp;
    675            matrix A[3][3]=0,1,0,-1,0,0,0,0,-1;
    676            matrix B(1..2);
    677            B(1..2)=rey_mol(A);
    678            poly p=x2;
    679            eval_rey(B(1),p);
     1527         ring R=0,(x,y,z),dp;
     1528         matrix A[3][3]=0,1,0,-1,0,0,0,0,-1;
     1529         list L=group_reynolds(A);
     1530         ideal I=x2,y2,z2;
     1531         print(evaluate_reynolds(L[1],I));
    6801532}
    6811533
    682 ////////////////////////////////////////////////////////////////////////////////
    683 // This procedure generates a basis of invariant polynomials in degree g. The
    684 // way this works, is that we look how the generators act on a general
    685 // polynomial of degree g - it turns out that one simply has to solve a system
    686 // of linear equations.
    687 ////////////////////////////////////////////////////////////////////////////////
    688 proc inv_basis (int g, list #)
    689   USAGE:   inv_basis(<int>,<generators of a finite matrix group>); <int>
    690            indicates in which degree (>0) we are looking for invariants
    691   RETURNS: the basis (type <ideal>) of the space of invariants of degree <int_1>
    692   EXAMPLE: example inv_basis; shows an example
     1534proc invariant_basis (int g,list #)
     1535USAGE:   invariant_basis(g,G1,G2,...);
     1536         g: an <int> indicating of which degree (>0) the homogeneous basis
     1537         shoud be, G1,G2,...: <matrices> generating a finite matrix group
     1538RETURNS: the basis (type <ideal>) of the space of invariants of degree g
     1539EXAMPLE: example invariant_basis; shows an example
     1540THEORY:  A general polynomial of degree g is generated and the generators of the
     1541         matrix group applied. The difference ought to be 0 and this way a
     1542         system of linear equations is created. It is solved by computing
     1543         syzygies.
    6931544{ if (g<=0)
    694   { "  ERROR:   the first argument should be > 0";
     1545  { "ERROR:   the first parameter should be > 0";
    6951546    return();
    6961547  }
    6971548  def br=basering;
    6981549  ideal mon=sort(maxideal(g))[1];      // needed for constructing a general
    699   int m=ncols(mon);                    // homogeneous polynomial of degree d
     1550  int m=ncols(mon);                    // homogeneous polynomial of degree g
     1551  mon=sort(mon,intvec(m..1))[1];
    7001552  int a=size(#);
    7011553  int i;
    7021554  int n=nvars(br);
    703   for (i=1;i<=a;i=i+1)                 // checking that input is ok
     1555 //---------------------- checking that the input is ok -----------------------
     1556  for (i=1;i<=a;i=i+1)
    7041557  { if (typeof(#[i])=="matrix")
    7051558    { if (nrows(#[i])==n && ncols(#[i])==n)
    … …  
    7071560      }
    7081561      else
    709       { "  ERROR:   the number of variables of the base ring needs to be the same";
    710         "           as the dimension of the square matrices";
     1562      { "ERROR:   the number of variables of the base ring needs to be the same";
     1563        "         as the dimension of the square matrices";
    7111564        return();
    7121565      }
    7131566    }
    7141567    else
    715     { "  ERROR:   the last arguments should be a list of matrices";
     1568    { "ERROR:   the last parameters should be a list of matrices";
    7161569      return();
    7171570    }
    7181571  }
    719   ideal vars_old=maxideal(1);
     1572 //----------------------------------------------------------------------------
    7201573  execute "ring T=("+charstr(br)+"),("+varstr(br)+",p(1..m)),lp;";
    721   ideal vars=imap(br,vars_old);
    722   // p(1..m) are general coefficients of
    723   // the general polynomial
     1574  // p(1..m) are the general coefficients of the general polynomial of degree g
     1575  execute "ideal vars="+varstr(br)+";";
    7241576  map f;
    7251577  ideal mon=imap(br,mon);
    … …  
    7301582  ideal I;                             // will help substituting variables in P
    7311583                                       // by linear combinations of variables -
    732   poly Pnew, temp;                     // Pnew is P with substitutions -
     1584  poly Pnew,temp;                      // Pnew is P with substitutions -
    7331585  matrix S[m*a][m];                    // will contain system of linear
    7341586                                       // equations
    735   int j, k;
    736   for (i=1;i<=a;i=i+1)                 // building system of linear equations
     1587  int j,k;
     1588 //------------------- building the system of linear equations ----------------
     1589  for (i=1;i<=a;i=i+1)
    7371590  { I=ideal(matrix(vars)*transpose(imap(br,G(i))));
    7381591    I=I,p(1..m);
    … …  
    7461599    }
    7471600  }
     1601 //----------------------------------------------------------------------------
    7481602  setring br;
    7491603  map f=T,ideal(0);
    … …  
    7601614}
    7611615example
    762 { "  EXAMPLE: Sturmfels: Algorithms in Invariant Theory 2.3.7:";
     1616{ "EXAMPLE: Sturmfels: Algorithms in Invariant Theory 2.3.7:";
    7631617  echo=2;
    764              ring R=0,(x,y,z),dp;
    765              matrix A[3][3]=0,1,0,-1,0,0,0,0,-1;
    766              print(inv_basis(2,A));
     1618           ring R=0,(x,y,z),dp;
     1619           matrix A[3][3]=0,1,0,-1,0,0,0,0,-1;
     1620           print(invariant_basis(2,A));
     1621}
     1622
     1623proc invariant_basis_reynolds (matrix REY,int d,list #)
     1624USAGE:   invariant_basis_reynolds(REY,d[,flags]);
     1625         REY: a <matrix> representing the Reynolds operator, d: an <int>
     1626         indicating of which degree (>0) the homogeneous basis shoud be, flags:
     1627         an optional <intvec> with two entries: its first component gives the
     1628         dimension of the space (default <0 meaning unknown) and its second
     1629         component is used as the number of polynomials that should be mapped
     1630         to invariants during one call of evaluate_reynolds if the dimension of
     1631         the space is unknown or the number such that number x dimension
     1632         polynomials are mapped to invariants during one call of
     1633         evaluate_reynolds
     1634ASSUME:  REY is the first return value of group_reynolds() or reynolds_molien()
     1635         and flags[1] given by partial_molien
     1636RETURN:  the basis (type <ideal>) of the space of invariants of degree d
     1637EXAMPLE: example invariant_basis_reynolds; shows an example
     1638THEORY:  Monomials of degree d are mapped to invariants with the Reynolds
     1639         operator. A linearly independent set is generated with the help of
     1640         minbase.
     1641{
     1642 //---------------------- checking that the input is ok -----------------------
     1643  if (d<=0)
     1644  { "  ERROR:   the second parameter should be > 0";
     1645     return();
     1646  }
     1647  if (size(#)>1)
     1648  { "  ERROR:   there should be at most three parameters";
     1649    return();
     1650  }
     1651  if (size(#)==1)
     1652  { if (typeof(#[1])<>"intvec")
     1653    { "  ERROR: the third parameter should be of type <intvec>";
     1654      return();
     1655    }
     1656    if (size(#[1])<>2)
     1657    { "  ERROR: there should be two components in <intvec>";
     1658      return();
     1659    }
     1660    else
     1661    { int cd=#[1][1];
     1662      int step_fac=#[1][2];
     1663    }
     1664    if (step_fac<=0)
     1665    { "  ERROR: the second component of <intvec> should be > 0";
     1666      return();
     1667    }
     1668    if (cd==0)
     1669    { return(ideal(0));
     1670    }
     1671  }
     1672  else
     1673  { int step_fac=1;
     1674    int cd=-1;
     1675  }
     1676  if (ncols(REY)<>nvars(basering))
     1677  { "ERROR:   the number of columns in the <matrix> should be the same as the";
     1678    "         number of variables in the basering; in fact it should be first";
     1679    "         return value of group_reynolds() or reynolds_molien().";
     1680    return();
     1681  }
     1682 //----------------------------------------------------------------------------
     1683  ideal mon=sort(maxideal(d))[1];
     1684  degBound=d;
     1685  int j=ncols(mon);
     1686  mon=sort(mon,intvec(j..1))[1];
     1687  ideal B;                             // will contain the basis
     1688  if (cd<0)
     1689  { if (step_fac>j)                    // all of mon will be mapped to
     1690    { B=evaluate_reynolds(REY,mon);    // invariants at once
     1691      B=minbase(B);
     1692      degBound=0;
     1693      return(B);
     1694    }
     1695  }
     1696  else
     1697  { if (step_fac*cd>j)                 // all of mon will be mapped to
     1698    { B=evaluate_reynolds(REY,mon);    // invariants at once
     1699      B=minbase(B);
     1700      degBound=0;
     1701      return(B);
     1702    }
     1703  }
     1704  int i,k;
     1705  int upper_bound=0;
     1706  int lower_bound=0;
     1707  ideal part_mon;                      // a part of mon of size step_fac*cd
     1708  while (1)
     1709  { lower_bound=upper_bound+1;
     1710    if (cd<0)
     1711    { upper_bound=upper_bound+step_fac;
     1712    }
     1713    else
     1714    { upper_bound=upper_bound+step_fac*cd;
     1715    }
     1716    if (upper_bound>j)
     1717    { upper_bound=j;
     1718    }
     1719    part_mon=mon[lower_bound..upper_bound];
     1720    B=minbase(B+evaluate_reynolds(REY,part_mon));
     1721    if (ncols(B)==cd or upper_bound==j)
     1722    { degBound=0;
     1723      return(B);
     1724    }
     1725  }
     1726}
     1727example
     1728{ "EXAMPLE: Sturmfels: Algorithms in Invariant Theory 2.3.7:";
     1729  echo=2;
     1730           ring R=0,(x,y,z),dp;
     1731           matrix A[3][3]=0,1,0,-1,0,0,0,0,-1;
     1732           intvec flags=0,1,0;
     1733           matrix REY,M=reynolds_molien(A,flags);
     1734           flags=8,6;
     1735           print(invariant_basis_reynolds(REY,6,flags));
    7671736}
    7681737
    7691738////////////////////////////////////////////////////////////////////////////////
    770 // This procedure generates invariant polynomials of degree g via the Reynolds
    771 // operator and checks by calculating syzygies whether they are linearly
    772 // independent. If they are the first column of syzygies does not contain any
    773 // constant polynomials. If a third argument of type <int> is given, the
    774 // program stopes once that many linearly independent polynomials have been
    775 // found.
     1739// This procedure generates linearly independent invariant polynomials of degree
     1740// d that do not reduce to 0 modulo the primary invariants. It does this by
     1741// applying the Reynolds operator to the monomials returned by kbase(sP,d). The
     1742// result is used when computing secondary invariants.
    7761743////////////////////////////////////////////////////////////////////////////////
    777 proc inv_basis_rey (matrix RO, int g, list #)
    778   USAGE:   inv_basis_rey(<matrix>,<int_1>[,<int_2>]); <matrix> should be the
    779            Reynolds operator which is the first return value of rey_mol, <int_1>           indicates the degree of the invariants and <int_2> optionally the
    780            dimension of the space which is known from 'part_mol'
    781   RETURNS: the basis <ideal> of the space of invariants of degree <int_1>
    782   EXAMPLE: example inv_basis_rey; shows an example
    783 { if (g<=0)
    784   { "  ERROR:   the second argument should be > 0";
    785      return();
    786   }
    787   if (size(#)>0)
    788   { if (typeof(#[1])<>"int")
    789     { "  ERROR: the third argument should be of type <int>";
    790       return();
    791     }
    792     if (#[1]<0)
    793     { "  ERROR: the third argument should be and <int> >= 0";
    794       return();
    795     }
    796   }
    797   int i, k;
    798   ideal mon=sort(maxideal(g))[1];
     1744proc sort_of_invariant_basis (ideal sP,matrix REY,int d,int step_fac)
     1745{ ideal mon=kbase(sP,d);
     1746  degBound=d;
    7991747  int j=ncols(mon);
    800   matrix S[ncols(mon)][1];             // will contain linear systems of
    801   int counter=0;                       // equations -
    802   degBound=g;                          // syzygies of higher degree need not be
    803                                        // computed -
    804   poly imRO;                           // image of Reynolds operator -
    805   ideal B;                             // will contain the basis
    806   for (i=j;i>0;i=i-1)
    807   { imRO=eval_rey(RO,mon[i]);
    808     if (imRO<>0)                       // the first candidate<>0 will definitely
    809     { if (counter==0)                  // be in the basis
    810       { B[1]=imRO;
    811         B[1]=B[1]/leadcoef(B[1]);
    812         counter=counter+1;
    813       }
    814       else                             // other candidates have to be checked
    815       { B=B,imRO;                      // for linear independence
    816         S=syz(B);
    817         k=1;
    818         while(k<>counter+2)
    819         { if (S[k,1]==0)               // checking whether there are constant
    820           { k=k+1;                     // entries <>0 in S
    821           }
    822           else
    823           { break;
    824           }
    825         }
    826         if (k==counter+2)              // this means that the loop was not
    827         { counter=counter+1;           // broken, we can keep B[counter]
    828           B[counter]=B[counter]/leadcoef(B[counter]);
    829         }
    830         else                           // we have to get rid of B[counter]
    831         { B[counter+1]=0;
    832           B=compress(B);
    833         }
    834       }
    835     }
    836     if (size(#)>0)
    837     { if (counter==#[1])               // we have found enough elements (if the
    838       { break;                         // user entered the right dim...
    839       }
    840     }
    841   }
    842   degBound=0;
    843   return(B);
    844 }
    845 example
    846 { "  EXAMPLE: Sturmfels: Algorithms in Invariant Theory 2.3.7:";
    847   echo=2;
    848              ring R=0,(x,y,z),dp;
    849              matrix A[3][3]=0,1,0,-1,0,0,0,0,-1;
    850              matrix B(1..2);
    851              B(1..2)=rey_mol(A);
    852              print(inv_basis_rey(B(1),6,8));
     1748  int i;
     1749  mon=sort(mon,intvec(j..1))[1];
     1750  ideal B;                             // will contain the "sort of basis"
     1751  if (step_fac>j)
     1752  { B=compress(evaluate_reynolds(REY,mon));
     1753    for (i=1;i<=ncols(B);i=i+1)        // those are taken our that are o mod sP
     1754    { if (reduce(B[i],sP)==0)
     1755      { B[i]=0;
     1756      }
     1757    }
     1758    B=minbase(B);                      // here are the linearly independent ones
     1759    degBound=0;
     1760    return(B);
     1761  }
     1762  int upper_bound=0;
     1763  int lower_bound=0;
     1764  ideal part_mon;                      // parts of mon
     1765  while (1)
     1766  { lower_bound=upper_bound+1;
     1767    upper_bound=upper_bound+step_fac;
     1768    if (upper_bound>j)
     1769    { upper_bound=j;
     1770    }
     1771    part_mon=mon[lower_bound..upper_bound];
     1772    part_mon=compress(evaluate_reynolds(REY,part_mon));
     1773    for (i=1;i<=ncols(part_mon);i=i+1)
     1774    { if (reduce(part_mon[i],sP)==0)
     1775      { part_mon[i]=0;
     1776      }
     1777    }
     1778    B=minbase(B+part_mon);             // here are the linearly independent ones
     1779    if (upper_bound==j)
     1780    { degBound=0;
     1781      return(B);
     1782    }
     1783  }
    8531784}
    8541785
    … …  
    8581789// increasing sum of the absolute value of their entries.
    8591790////////////////////////////////////////////////////////////////////////////////
    860 proc nextvec(intmat vec)
     1791proc next_vector(intmat vec)
    8611792{ int n=ncols(vec);                    // p: >0, n: <0, p0: >=0, n0: <=0
    8621793  for (int i=1;i<=n;i=i+1)             // finding out which is the first
    … …  
    8881819  if (i>1)
    8891820  { intmat temp[1][n-i+1]=vec[1,i..n]; // 0,...,0,1,*,...,* --> 1,*,...,*
    890     temp=nextvec(temp);
     1821    temp=next_vector(temp);
    8911822    new[1,i..n]=temp[1,1..n-i+1];
    8921823    return(new);
    … …  
    9161847
    9171848////////////////////////////////////////////////////////////////////////////////
    918 // Input is a list of nxm-matrices with n<m and rank n. Procedure checks whether
    919 // the space generated by the rows of the last matrix lies in any of the spaces
    920 // generated by other matrices' rows. Returns a boolean answer.
    921 ////////////////////////////////////////////////////////////////////////////////
    922 proc space_con (list #)
    923 { matrix H;
    924   int n=nrows(#[1]);
    925   for (int i=1;i<size(#);i=i+1)
    926   { H=transpose(#[i]);
    927     H=concat(H,transpose(#[size(#)])); // concatenating works column-wise -
    928     H=bareiss(transpose(H));           // bareiss works row-wise -
    929     if (ncols(compress(transpose(H)))==n)  // means that the last rows of the
    930     { return(1);                       // matrix were in the span of the rows of
    931     }                                  // #[i]
    932   }
    933   return(0);
    934 }
    935 
    936 ////////////////////////////////////////////////////////////////////////////////
    9371849// Maps integers to elements of the base field. It is only called if the base
    9381850// field is of prime characteristic. If the base field has q elements (depending
    9391851// on minpoly) 1..q is mapped to those q elements.
    9401852////////////////////////////////////////////////////////////////////////////////
    941 proc intnumap (int i)
     1853proc int_number_map (int i)
    9421854{ int p=char(basering);
    9431855  if (minpoly==0)                      // if no minpoly is given, we have p
    … …  
    9501862    i=(-1)*i;
    9511863  }
    952   i=i%p^d;                             // base field has p^d elements
    953   number a=par(1);                     // a is the root of the minpoly, we have
     1864  i=i%p^d;                             // base field has p^d elements -
     1865  number a=par(1);                     // a is the root of the minpoly - we have
    9541866  number out=0;                        // to construct a linear combination of
    9551867  int j=1;                             // a^k
    … …  
    9581870  { if (i<p^j)                         // finding an upper bound on i
    9591871    { for (k=0;k<j-1;k=k+1)
    960       { out=out+((i div p^k)%p)*a^k;   // finding how often p^k is contained in
     1872      { out=out+((i/p^k)%p)*a^k;       // finding how often p^k is contained in
    9611873      }                                // i
    962       out=out+(i div p^(j-1))*a^(j-1);
    963       if (defined(bool)=voice)
     1874      out=out+(i/p^(j-1))*a^(j-1);
     1875      if (defined(bool)==voice)
    9641876      { return((-1)*out);
    9651877      }
    … …  
    9711883
    9721884////////////////////////////////////////////////////////////////////////////////
    973 // Attempting to construct n=[number of variables in the base ring] linear
    974 // combinations of the m>n entries in Q such that the ideal generated by these
    975 // combinations is of dimension 0. It is then a Noetherian normalization of the
    976 // invariant ring. In characteristic 0 the existence of such a linear
    977 // combination is ensured.
     1885// This procedure finds dif primary invariants in degree d. It returns all
     1886// primary invariants found so far. The coefficients lie in a field of
     1887// characteristic 0.
    9781888////////////////////////////////////////////////////////////////////////////////
    979 proc noethernorm(ideal Q)
    980 { def br=basering;
    981   int lcm=deg(Q[1]);                   // will contain lowest common multiple of
    982   int ch=char(br);                     // degrees of polynomials in Q
    983   int n=nvars(br);
    984   int i, j;
    985   intvec degvec;
    986   int m=ncols(Q);
    987   degvec[1]=lcm;
    988   for (i=2;i<=m;i=i+1)
    989   { degvec[i]=deg(Q[i]);
    990     lcm=lcm*degvec[i] div gcd(lcm,degvec[i]); // lcm is now the least common
    991   }                                    // multiple of the first i elements of Q
    992   ideal A(1)=Q;
    993   for (i=1;i<=m;i=i+1)
    994   { A(1)[i]=(A(1)[i])^(lcm div degvec[i]); // now all elements in A(1) are of the
    995   }                                    // same degree, they are the elements of
    996                                        // Q raised to a power -
    997   matrix T[n][1];                      // will contain the n linear combinations
    998   matrix I[n][n]=unitmat(n);
    999   matrix H(1)[n][m];
    1000   H(1)[1..n,1..n]=I[1..n,1..n];        // H(1) will be the first matrix, we try
    1001   kill I;
    1002   if ((n%2)==0)                        // H(1) ought to be of the form:
    1003   { j=n div 2;                         // 1,0,...,0,0,1,0,...,0
    1004   }                                    // 0,0,...,0,1,0,0,...,0
    1005   else                                 //      .           .
    1006   { j=(n-1) div 2;                     //      .           .
    1007   }                                    //      .           .
    1008   for (i=1;i<=j;i=i+1)                 // 1,0,...,0,0,0,0,...,0
    1009   { H(1)=permcol(H(1),i,n-i+1);
    1010   }
    1011   H(1)[1,1]=1;
    1012   int c=1;
    1013   intmat vec[1][n*m];
    1014   vec[1,1..n*m]=int(H(1)[1..n,1..m]);  // we rewrite H(1) as a vector
    1015   while (1)
    1016   { T=H(c)*transpose(matrix(A(1)));
    1017     Q=ideal(T);
    1018     attrib(Q,"isSB",1);
    1019     if (dim(Q)>0)
    1020     { if (dim(std(Q))==0)              // we found n linear combinations
    1021       { A(1)=T;
     1889proc search (int n,int d,ideal B,int cd,ideal P,ideal sP,int i,int dif,int dB,ideal CI)
     1890{ intmat vec[1][cd];                   // the coefficients for the next
     1891                                       // combination -
     1892  degBound=0;
     1893  poly test_poly;                      // the linear combination to test
     1894  int test_dim;
     1895  intvec h;                            // Hilbert series
     1896  int j=i+1;
     1897  matrix tB=transpose(B);
     1898  ideal TEST;
     1899  while(j<=i+dif)
     1900  { CI=CI+ideal(var(j)^d);             // homogeneous polynomial of the same
     1901                                       // degree as the one we're looking for is
     1902                                       // added
     1903    // h=hilb(std(CI),1);
     1904    dB=dB+d-1;                         // used as degBound
     1905    while(1)
     1906    { vec=next_vector(vec);            // next vector
     1907      test_poly=(vec*tB)[1,1];
     1908      // degBound=dB;
     1909      TEST=sP+ideal(test_poly);
     1910      attrib(TEST,"isSB",1);
     1911      test_dim=dim(TEST);
     1912      // degBound=0;
     1913      if (n-test_dim==j)               // the dimension has been lowered by one
     1914      { sP=TEST;
    10221915        break;
    10231916      }
    1024     }
    1025     else                               // we found n linear combinations
    1026     { A(1)=T;
    1027       break;
    1028     }
    1029     matrix H(c+1)[n][m];               // we have to find a new matrix
    1030     while(1)                           // generating n linear combinations
    1031     { vec=nextvec(vec);
    1032       if (ch==0)
    1033       { H(c+1)[1..n,1..m]=vec[1,1..n*m];
    1034       }
    1035       else
    1036       { for (i=1;i<=n;i=i+1)
    1037         { for (j=1;j<=m;j=j+1)
    1038           { H(c+1)[i,j]=intnumap(vec[1,(i-1)*m+j]); // mapping integers to the
    1039           }                            // field
    1040         }
    1041       }
    1042       if (minor(H(c+1),n)[1]<>0 && not(space_con(H(1..c+1)))) // if the ideal
    1043       { c=c+1;                         // generated by the minors is not the 0
    1044         break;                         // ideal and if the span of rows of
    1045       }                                // H(c+1) is not in the span of rows
    1046                                        // previously tried, then we found a new
    1047                                        // interesting matrix
    1048     }
    1049   }
    1050   if (ch==0)
    1051   { poly p(1)=(1-var(1)^lcm)^n;        // since all elements are of degree
    1052                                        // lcm, the denominator of the Hilbert
    1053                                        // series of the ring generated by the
    1054                                        // primary invariants equals p(1)
    1055     return(A(1),p(1));
    1056   }
    1057   else
    1058   { if (defined(Qa))                   // here is where we store Molien series
    1059     { setring Qa;
    1060       poly p(1)=(1-x^lcm)^n;           // since all elements are of degree
    1061                                        // lcm, the denominator of the Hilbert
    1062                                        // series of the ring generated by the
    1063                                        // primary invariants equals p(1)
    1064       setring br;
    1065       return(A(1),p(1));
    1066     }
    1067     else
    1068     { return(A(1));
    1069     }
    1070   }
     1917      // degBound=dB;
     1918      TEST=std(sP+ideal(test_poly));   // should soon be replaced by next line
     1919      // TEST=std(sP,test_poly,h);        // Hilbert driven std-calculation
     1920      test_dim=dim(TEST);
     1921      // degBound=0;
     1922      if (n-test_dim==j)               // the dimension has been lowered by one
     1923      { sP=TEST;
     1924        break;
     1925      }
     1926    }
     1927    P[j]=test_poly;                    // test_poly ist added to primary
     1928    j=j+1;                             // invariants
     1929  }
     1930  return(P,sP,CI,dB);
    10711931}
    10721932
    10731933////////////////////////////////////////////////////////////////////////////////
    1074 // Computing the entire matrix group from generators and returning its
    1075 // cardinality.
     1934// This procedure finds at most dif primary invariants in degree d. It returns
     1935// all primary invariants found so far. The coefficients lie in the field of
     1936// characteristic p>0.
    10761937////////////////////////////////////////////////////////////////////////////////
    1077 proc group (list #)
    1078 { matrix G(1)=#[1];                    // first group element
    1079   int i=1;
    1080   for (int j=2;j<=size(#);j=j+1)       // throwing out doubles among the
    1081   { if (unique(G(1..i),#[j]))          // generators
    1082     { i=i+1;
    1083       matrix G(i)=#[j];
    1084     }
    1085   }
    1086   int g=i;                             // g: elements in the group so far, i:
    1087   j=i;                                 // generators, j: new ones used as
    1088   int m, k, l;                         // as factors, l: counting possible new
    1089                                        // new elements
    1090   while (1)
    1091   { l=0;
    1092     for (m=g-j+1;m<=g;m=m+1)
    1093     { for (k=1;k<=i;k=k+1)
    1094       { l=l+1;
    1095         matrix P(l)=G(k)*G(m);         // possible new element
    1096       }
    1097     }
    1098     j=0;
    1099     for (k=1;k<=l;k=k+1)               // checking whether the P(k) are new
    1100     { if (unique(G(1..g),P(k)))
    1101       { j=j+1;
    1102         g=g+1;
    1103         matrix G(g)=P(k);              // adding new elements -
    1104       }
    1105       kill P(k);
    1106     }
    1107     if (j==0)                          // when we didn't add any new elements
    1108     { break;                           // in one run through the while loop, we
    1109     }                                  // are done
    1110   }
    1111   return(g);
     1938proc p_search (int n,int d,ideal B,int cd,ideal P,ideal sP,int i,int dif,int dB,ideal CI)
     1939{ def br=basering;
     1940  degBound=0;
     1941  matrix vec(1)[1][cd];                // starting with 0-vector -
     1942  intmat new[1][cd];                   // the coefficients for the next
     1943                                       // combination -
     1944  matrix pnew[1][cd];                  // new needs to be mapped into br -
     1945  int counter=1;                       // counts the vectors
     1946  int j;
     1947  int p=char(br);
     1948  if (minpoly<>0)
     1949  { int ext_deg=pardeg(minpoly);       // field has p^d elements
     1950  }
     1951  else
     1952  { int ext_deg=1;                     // field has p^d elements
     1953  }
     1954  poly test_poly;                      // the linear combination to test
     1955  int test_dim;
     1956  ring R=0,x,dp;                       // just to calculate next variable
     1957                                       // bound -
     1958  number bound=(number(p)^(ext_deg*cd)-1)/(number(p)^ext_deg-1)+1; // this is
     1959                                       // how many linearly independent vectors
     1960                                       // of size cd exist having entries in the
     1961                                       // base field of br
     1962  setring br;
     1963  intvec h;                            // Hilbert series
     1964  int k=i+1;
     1965  matrix tB=transpose(B);
     1966  ideal TEST;
     1967  while (k<=i+dif)
     1968  { CI=CI+ideal(var(k)^d);             // homogeneous polynomial of the same
     1969                                       // degree as the one we're looking for is
     1970                                       // added
     1971    // h=hilb(std(CI),1);
     1972    dB=dB+d-1;                         // used as degBound
     1973    setring R;
     1974    while (number(counter)<>bound)     // otherwise, we are done
     1975    { setring br;
     1976      new=next_vector(new);
     1977      for (j=1;j<=cd;j=j+1)
     1978      { pnew[1,j]=int_number_map(new[1,j]); // mapping an integer into br
     1979      }
     1980      if (unique(vec(1..counter),pnew)) // checking whether we tried pnew before
     1981      { counter=counter+1;
     1982        matrix vec(counter)=pnew;      // keeping track of the ones we tried -
     1983        test_poly=(vec(counter)*tB)[1,1]; // linear combination -
     1984        // degBound=dB;
     1985        TEST=sP+ideal(test_poly);
     1986        attrib(TEST,"isSB",1);
     1987        test_dim=dim(TEST);
     1988        // degBound=0;
     1989        if (n-test_dim==k)             // the dimension has been lowered by one
     1990        { sP=TEST;
     1991          setring R;
     1992          break;
     1993        }
     1994        // degBound=dB;
     1995        TEST=std(sP+ideal(test_poly)); // should soon to be replaced by next
     1996                                       // line
     1997        // TEST=std(sP,test_poly,h);      // Hilbert driven std-calculation
     1998        test_dim=dim(TEST);
     1999        // degBound=0;
     2000        if (n-test_dim==k)             // the dimension has been lowered by one
     2001        { sP=TEST;
     2002          setring R;
     2003          break;
     2004        }
     2005      }
     2006      setring R;
     2007    }
     2008    if (number(counter)<=bound)
     2009    { setring br;
     2010      P[k]=test_poly;                  // test_poly ist added to primary
     2011    }                                  // invariants
     2012    else
     2013    { setring br;
     2014      CI=CI[1..size(CI)-1];
     2015      return(P,sP,CI,dB-d+1);
     2016    }
     2017    k=k+1;
     2018  }
     2019  return(P,sP,CI,dB);
     2020}
     2021
     2022proc primary_char0 (matrix REY,matrix M,list #)
     2023USAGE:   primary_char0(REY,M[,v]);
     2024         REY: a <matrix> representing the Reynolds operator, M: a 1x2 <matrix>
     2025         representing the Molien series, v: an optional <int>
     2026ASSUME:  REY is the first return value of group_reynolds or reynolds_molien and
     2027         M the one of molien or the second one of reynolds_molien
     2028DISPLAY: information about the various stages of the programme if v does not
     2029         equal 0
     2030RETURN:  primary invariants (type <matrix>) of the invariant ring
     2031EXAMPLE: example primary_char0; shows an example
     2032THEORY:  Bases of homogeneous invariants are generated successively and those
     2033         are chosen as primary invariants that lower the dimension of the ideal
     2034         generated by the previously found invariants (see paper "Generating a
     2035         Noetherian Normalization of the Invariant Ring of a Finite Group" by
     2036         Decker, Heydtmann, Schreyer (1997) to appear in JSC).
     2037{ degBound=0;
     2038  if (char(basering)<>0)
     2039  { "ERROR:   primary_char0 should only be used with rings of characteristic 0.";
     2040    return();
     2041  }
     2042 //----------------- checking input and setting verbose mode ------------------
     2043  if (size(#)>1)
     2044  { "ERROR:   primary_char0 can only have three parameters.";
     2045    return();
     2046  }
     2047  if (size(#)==1)
     2048  { if (typeof(#[1])<>"int")
     2049    { "ERROR:   The third parameter should be of type <int>.";
     2050      return();
     2051    }
     2052    else
     2053    { int v=#[1];
     2054    }
     2055  }
     2056  else
     2057  { int v=0;
     2058  }
     2059  int n=nvars(basering);               // n is the number of variables, as well
     2060                                       // as the size of the matrices, as well
     2061                                       // as the number of primary invariants,
     2062                                       // we should get
     2063  if (ncols(REY)<>n)
     2064  { "ERROR:   First parameter ought to be the Reynolds operator."
     2065    return();
     2066  }
     2067  if (ncols(M)<>2 or nrows(M)<>1)
     2068  { "ERROR:   Second parameter ought to be the Molien series."
     2069    return();
     2070  }
     2071 //----------------------------------------------------------------------------
     2072  if (v && voice<>2)
     2073  { "  We can start looking for primary invariants...";
     2074    "";
     2075  }
     2076  if (v && voice==2)
     2077  { "";
     2078  }
     2079 //------------------------- initializing variables ---------------------------
     2080  int dB;
     2081  poly p(1..2);                        // p(1) will be used for single terms of
     2082                                       // the partial expansion, p(2) to store
     2083  p(1..2)=partial_molien(M,1);         // the intermediate result -
     2084  poly v1=var(1);                      // we need v1 to split off coefficients
     2085                                       // in the partial expansion of M (which
     2086                                       // is in terms of the first variable) -
     2087  int j,d,cd,newdim,dif;               // d: current degree, cd: dimension of
     2088                                       // space of invariants of degree d,
     2089                                       // newdim: dimension the ideal generated
     2090                                       // the primary invariants plus basis
     2091                                       // elements, dif=n-i-newdim, i.e. the
     2092                                       // number of new primary invairants that
     2093                                       // should be added in this degree -
     2094  ideal P,Pplus,sPplus,CI,B;           // P: will contain primary invariants,
     2095                                       // Pplus: P+B, CI: a complete
     2096                                       // intersection with the same Hilbert
     2097                                       // function as P
     2098  ideal sP=std(P);
     2099  dB=1;                                // used as degree bound
     2100  int i=0;
     2101 //-------------- loop that searches for primary invariants  ------------------
     2102  while(1)                             // repeat until n primary invariants are
     2103  {                                    // found -
     2104    p(1..2)=partial_molien(M,1,p(2));  // next term of the partial expansion -
     2105    d=deg(p(1));                       // degree where we'll search -
     2106    cd=int(coef(p(1),v1)[2,1]);        // dimension of the homogeneous space of
     2107                                       // inviarants of degree d
     2108    if (v)
     2109    { "  Computing primary invariants in degree "+string(d)+":";
     2110    }
     2111    B=invariant_basis_reynolds(REY,d,intvec(cd,6)); // basis of invariants of
     2112                                       // degree d
     2113    if (B[1]<>0)
     2114    { Pplus=P+B;
     2115      sPplus=std(Pplus);
     2116      newdim=dim(sPplus);
     2117      dif=n-i-newdim;
     2118    }
     2119    else
     2120    { dif=0;
     2121    }
     2122    if (dif<>0)                        // we have to find dif new primary
     2123    {                                  // invariants
     2124      if (cd<>dif)
     2125      { P,sP,CI,dB=search(n,d,B,cd,P,sP,i,dif,dB,CI); // searching for dif invariants
     2126      }                                // i.e. we can take all of B
     2127      else
     2128      { for(j=i+1;j>i+dif;j=j+1)
     2129        { CI=CI+ideal(var(j)^d);
     2130        }
     2131        dB=dB+dif*(d-1);
     2132        P=Pplus;
     2133        sP=sPplus;
     2134      }
     2135      if (v)
     2136      { for (j=1;j<=dif;j=j+1)
     2137        { "  We find: "+string(P[i+j]);
     2138        }
     2139      }
     2140      i=i+dif;
     2141      if (i==n)                        // found all primary invariants
     2142      { if (v)
     2143        { "";
     2144          "  We found all primary invariants.";
     2145          "";
     2146        }
     2147        return(matrix(P));
     2148      }
     2149    }                                  // done with degree d
     2150  }
     2151}
     2152example
     2153{ "EXAMPLE: Sturmfels: Algorithms in Invariant Theory 2.3.7:";
     2154  echo=2;
     2155         ring R=0,(x,y,z),dp;
     2156         matrix A[3][3]=0,1,0,-1,0,0,0,0,-1;
     2157         matrix REY,M=reynolds_molien(A);
     2158         matrix P=primary_char0(REY,M);
     2159         print(P);
     2160}
     2161
     2162proc primary_charp (matrix REY,string ring_name,list #)
     2163USAGE:   primary_charp(REY,ringname[,v]);
     2164         REY: a <matrix> representing the Reynolds operator, ringname: a
     2165         <string> giving the name of a ring where the Molien series is stored,
     2166         v: an optional <int>
     2167ASSUME:  REY is the first return value of group_reynolds or reynolds_molien and
     2168         ringname gives the name of a ring of characteristic 0 that has been
     2169         created by molien or reynolds_molien
     2170DISPLAY: information about the various stages of the programme if v does not
     2171         equal 0
     2172RETURN:  primary invariants (type <matrix>) of the invariant ring
     2173EXAMPLE: example primary_charp; shows an example
     2174THEORY:  Bases of homogeneous invariants are generated successively and those
     2175         are chosen as primary invariants that lower the dimension of the ideal
     2176         generated by the previously found invariants (see paper "Generating a
     2177         Noetherian Normalization of the Invariant Ring of a Finite Group" by
     2178         Decker, Heydtmann, Schreyer (1997) to appear in JSC).
     2179{ degBound=0;
     2180// ---------------- checking input and setting verbose mode -------------------
     2181  if (char(basering)==0)
     2182  { "ERROR:   primary_charp should only be used with rings of characteristic p>0.";
     2183    return();
     2184  }
     2185  if (size(#)>1)
     2186  { "ERROR:   primary_charp can only have three parameters.";
     2187    return();
     2188  }
     2189  if (size(#)==1)
     2190  { if (typeof(#[1])<>"int")
     2191    { "ERROR:   The third parameter should be of type <int>.";
     2192      return();
     2193    }
     2194    else
     2195    { int v=#[1];
     2196    }
     2197  }
     2198  else
     2199  { int v=0;
     2200  }
     2201  def br=basering;
     2202  int n=nvars(br);                     // n is the number of variables, as well
     2203                                       // as the size of the matrices, as well
     2204                                       // as the number of primary invariants,
     2205                                       // we should get
     2206  if (ncols(REY)<>n)
     2207  { "ERROR:   First parameter ought to be the Reynolds operator."
     2208    return();
     2209  }
     2210  if (typeof(`ring_name`)<>"ring")
     2211  { "ERROR:   Second parameter ought to the name of a ring where the Molien";
     2212    "         is stored.";
     2213    return();
     2214  }
     2215 //----------------------------------------------------------------------------
     2216  if (v && voice<>2)
     2217  { "  We can start looking for primary invariants...";
     2218    "";
     2219  }
     2220  if (v && voice==2)
     2221  { "";
     2222  }
     2223 //----------------------- initializing variables -----------------------------
     2224  int dB;
     2225  setring `ring_name`;                 // the Molien series is stores here -
     2226  poly p(1..2);                        // p(1) will be used for single terms of
     2227                                       // the partial expansion, p(2) to store
     2228  p(1..2)=partial_molien(M,1);         // the intermediate result -
     2229  poly v1=var(1);                      // we need v1 to split off coefficients
     2230                                       // in the partial expansion of M (which
     2231                                       // is in terms of the first variable)
     2232  setring br;
     2233  int j,d,cd,newdim,dif;               // d: current degree, cd: dimension of
     2234                                       // space of invariants of degree d,
     2235                                       // newdim: dimension the ideal generated
     2236                                       // the primary invariants plus basis
     2237                                       // elements, dif=n-i-newdim, i.e. the
     2238                                       // number of new primary invairants that
     2239                                       // should be added in this degree -
     2240  ideal P,Pplus,sPplus,CI,B;           // P: will contain primary invariants,
     2241                                       // Pplus: P+B, CI: a complete
     2242                                       // intersection with the same Hilbert
     2243                                       // function as P
     2244  ideal sP=std(P);
     2245  dB=1;                                // used as degree bound
     2246  int i=0;
     2247 //---------------- loop that searches for primary invariants -----------------
     2248  while(1)                             // repeat until n primary invariants are
     2249  {                                    // found
     2250    setring `ring_name`;
     2251    p(1..2)=partial_molien(M,1,p(2));  // next term of the partial expansion -
     2252    d=deg(p(1));                       // degree where we'll search -
     2253    cd=int(coef(p(1),v1)[2,1]);        // dimension of the homogeneous space of
     2254                                       // inviarants of degree d
     2255    setring br;
     2256    if (v)
     2257    { "  Computing primary invariants in degree "+string(d)+":";
     2258    }
     2259    B=invariant_basis_reynolds(REY,d,intvec(cd,6)); // basis of invariants of
     2260                                       // degree d
     2261    if (B[1]<>0)
     2262    { Pplus=P+B;
     2263      sPplus=std(Pplus);
     2264      newdim=dim(sPplus);
     2265      dif=n-i-newdim;
     2266    }
     2267    else
     2268    { dif=0;
     2269    }
     2270    if (dif<>0)                        // we have to find dif new primary
     2271    {                                  // invariants
     2272      if (cd<>dif)
     2273      { P,sP,CI,dB=p_search(n,d,B,cd,P,sP,i,dif,dB,CI);
     2274      }
     2275      else                             // i.e. we can take all of B
     2276      { for(j=i+1;j>i+dif;j=j+1)
     2277        { CI=CI+ideal(var(j)^d);
     2278        }
     2279        dB=dB+dif*(d-1);
     2280        P=Pplus;
     2281        sP=sPplus;
     2282      }
     2283      if (v)
     2284      { for (j=1;j<=size(P)-i;j=j+1)
     2285        { "  We find: "+string(P[i+j]);
     2286        }
     2287      }
     2288      i=size(P);
     2289      if (i==n)                        // found all primary invariants
     2290      { if (v)
     2291        { "";
     2292          "  We found all primary invariants.";
     2293          "";
     2294        }
     2295        return(matrix(P));
     2296      }
     2297    }                                  // done with degree d
     2298  }
     2299}
     2300example
     2301{ "EXAMPLE: Sturmfels: Algorithms in Invariant Theory 2.3.7 (changed into";
     2302  "         characteristic 3)";
     2303  echo=2;
     2304         ring R=3,(x,y,z),dp;
     2305         matrix A[3][3]=0,1,0,-1,0,0,0,0,-1;
     2306         list L=group_reynolds(A);
     2307         string newring="alskdfj";
     2308         molien(L[2..size(L)],newring);
     2309         matrix P=primary_charp(L[1],newring);
     2310         kill `newring`;
     2311         print(P);
     2312}
     2313
     2314proc primary_char0_no_molien (matrix REY, list #)
     2315USAGE:   primary_char0_no_molien(REY[,v]);
     2316         REY: a <matrix> representing the Reynolds operator, v: an optional
     2317         <int>
     2318ASSUME:  REY is the first return value of group_reynolds or reynolds_molien
     2319DISPLAY: information about the various stages of the programme if v does not
     2320         equal 0
     2321RETURN:  primary invariants (type <matrix>) of the invariant ring and an
     2322         <intvec> listing some of the degrees where no non-trivial homogeneous
     2323         invariants are to be found
     2324EXAMPLE: example primary_char0_no_molien; shows an example
     2325THEORY:  Bases of homogeneous invariants are generated successively and those
     2326         are chosen as primary invariants that lower the dimension of the ideal
     2327         generated by the previously found invariants (see paper "Generating a
     2328         Noetherian Normalization of the Invariant Ring of a Finite Group" by
     2329         Decker, Heydtmann, Schreyer (1997) to appear in JSC).
     2330{ degBound=0;
     2331 //-------------- checking input and setting verbose mode ---------------------
     2332  if (char(basering)<>0)
     2333  { "ERROR:   primary_char0_no_molien should only be used with rings of";
     2334    "         characteristic 0.";
     2335    return();
     2336  }
     2337  if (size(#)>1)
     2338  { "ERROR:   primary_char0_no_molien can only have two parameters.";
     2339    return();
     2340  }
     2341  if (size(#)==1)
     2342  { if (typeof(#[1])<>"int")
     2343    { "ERROR:   The second parameter should be of type <int>.";
     2344      return();
     2345    }
     2346    else
     2347    { int v=#[1];
     2348    }
     2349  }
     2350  else
     2351  { int v=0;
     2352  }
     2353  int n=nvars(basering);               // n is the number of variables, as well
     2354                                       // as the size of the matrices, as well
     2355                                       // as the number of primary invariants,
     2356                                       // we should get
     2357  if (ncols(REY)<>n)
     2358  { "ERROR:   First parameter ought to be the Reynolds operator."
     2359    return();
     2360  }
     2361 //----------------------------------------------------------------------------
     2362  if (v && voice<>2)
     2363  { "  We can start looking for primary invariants...";
     2364    "";
     2365  }
     2366  if (v && voice==2)
     2367  { "";
     2368  }
     2369 //----------------------- initializing variables -----------------------------
     2370  int dB;
     2371  int j,d,cd,newdim,dif;               // d: current degree, cd: dimension of
     2372                                       // space of invariants of degree d,
     2373                                       // newdim: dimension the ideal generated
     2374                                       // the primary invariants plus basis
     2375                                       // elements, dif=n-i-newdim, i.e. the
     2376                                       // number of new primary invairants that
     2377                                       // should be added in this degree -
     2378  ideal P,Pplus,CI,B;                  // P: will contain primary invariants,
     2379                                       // Pplus: P+B, CI: a complete
     2380                                       // intersection with the same Hilbert
     2381                                       // function as P
     2382  ideal sP=std(P);
     2383  dB=1;                                // used as degree bound -
     2384  d=0;                                 // initializing
     2385  int i=0;
     2386  intvec deg_vector;
     2387 //------------------ loop that searches for primary invariants ---------------
     2388  while(1)                             // repeat until n primary invariants are
     2389  {                                    // found -
     2390    d=d+1;                             // degree where we'll search
     2391    if (v)
     2392    { "  Computing primary invariants in degree "+string(d)+":";
     2393    }
     2394    B=invariant_basis_reynolds(REY,d,intvec(-1,6)); // basis of invariants of
     2395                                       // degree d
     2396    if (B[1]<>0)
     2397    { Pplus=P+B;
     2398      newdim=dim(std(Pplus));
     2399      dif=n-i-newdim;
     2400    }
     2401    else
     2402    { dif=0;
     2403      deg_vector=deg_vector,d;
     2404    }
     2405    if (dif<>0)                        // we have to find dif new primary
     2406    {                                  // invariants
     2407      cd=size(B);
     2408      if (cd<>dif)
     2409      { P,sP,CI,dB=search(n,d,B,cd,P,sP,i,dif,dB,CI);
     2410      }
     2411      else                             // i.e. we can take all of B
     2412      { for(j=i+1;j<=i+dif;j=j+1)
     2413        { CI=CI+ideal(var(j)^d);
     2414        }
     2415        dB=dB+dif*(d-1);
     2416        P=Pplus;
     2417        sP=std(P);
     2418      }
     2419      if (v)
     2420      { for (j=1;j<=dif;j=j+1)
     2421        { "  We find: "+string(P[i+j]);
     2422        }
     2423      }
     2424      i=i+dif;
     2425      if (i==n)                        // found all primary invariants
     2426      { if (v)
     2427        { "";
     2428          "  We found all primary invariants.";
     2429          "";
     2430        }
     2431        if (deg_vector==0)
     2432        { return(matrix(P));
     2433        }
     2434        else
     2435        { return(matrix(P),compress(deg_vector));
     2436        }
     2437      }
     2438    }                                  // done with degree d
     2439    else
     2440    { if (v)
     2441      { "  None here...";
     2442      }
     2443    }
     2444  }
     2445}
     2446example
     2447{ "EXAMPLE: Sturmfels: Algorithms in Invariant Theory 2.3.7:";
     2448  echo=2;
     2449         ring R=0,(x,y,z),dp;
     2450         matrix A[3][3]=0,1,0,-1,0,0,0,0,-1;
     2451         list L=group_reynolds(A);
     2452         list l=primary_char0_no_molien(L[1]);
     2453         print(l[1]);
     2454}
     2455
     2456proc primary_charp_no_molien (matrix REY, list #)
     2457USAGE:   primary_charp_no_molien(REY[,v]);
     2458         REY: a <matrix> representing the Reynolds operator, v: an optional
     2459         <int>
     2460ASSUME:  REY is the first return value of group_reynolds or reynolds_molien
     2461DISPLAY: information about the various stages of the programme if v does not
     2462         equal 0
     2463RETURN:  primary invariants (type <matrix>) of the invariant ring  and an
     2464         <intvec> listing some of the degrees where no non-trivial homogeneous
     2465         invariants are to be found
     2466EXAMPLE: example primary_charp_no_molien; shows an example
     2467THEORY:  Bases of homogeneous invariants are generated successively and those
     2468         are chosen as primary invariants that lower the dimension of the ideal
     2469         generated by the previously found invariants (see paper "Generating a
     2470         Noetherian Normalization of the Invariant Ring of a Finite Group" by
     2471         Decker, Heydtmann, Schreyer (1997) to appear in JSC).
     2472{ degBound=0;
     2473 //----------------- checking input and setting verbose mode ------------------
     2474  if (char(basering)==0)
     2475  { "ERROR:   primary_charp_no_molien should only be used with rings of";
     2476    "         characteristic p>0.";
     2477    return();
     2478  }
     2479  if (size(#)>1)
     2480  { "ERROR:   primary_charp_no_molien can only have two parameters.";
     2481    return();
     2482  }
     2483  if (size(#)==1)
     2484  { if (typeof(#[1])<>"int")
     2485    { "ERROR:   The second parameter should be of type <int>.";
     2486      return();
     2487    }
     2488    else
     2489    { int v=#[1];
     2490    }
     2491  }
     2492  else
     2493  { int v=0;
     2494  }
     2495  int n=nvars(basering);               // n is the number of variables, as well
     2496                                       // as the size of the matrices, as well
     2497                                       // as the number of primary invariants,
     2498                                       // we should get
     2499  if (ncols(REY)<>n)
     2500  { "ERROR:   First parameter ought to be the Reynolds operator."
     2501    return();
     2502  }
     2503 //----------------------------------------------------------------------------
     2504  if (v && voice<>2)
     2505  { "  We can start looking for primary invariants...";
     2506    "";
     2507  }
     2508  if (v && voice==2)
     2509  { "";
     2510  }
     2511 //-------------------- initializing variables --------------------------------
     2512  int dB;
     2513  int j,d,cd,newdim,dif;               // d: current degree, cd: dimension of
     2514                                       // space of invariants of degree d,
     2515                                       // newdim: dimension the ideal generated
     2516                                       // the primary invariants plus basis
     2517                                       // elements, dif=n-i-newdim, i.e. the
     2518                                       // number of new primary invairants that
     2519                                       // should be added in this degree -
     2520  ideal P,Pplus,sPplus,CI,B;           // P: will contain primary invariants,
     2521                                       // Pplus: P+B, CI: a complete
     2522                                       // intersection with the same Hilbert
     2523                                       // function as P
     2524  ideal sP=std(P);
     2525  dB=1;                                // used as degree bound -
     2526  d=0;                                 // initializing
     2527  int i=0;
     2528  intvec deg_vector;
     2529 //------------------ loop that searches for primary invariants ---------------
     2530  while(1)                             // repeat until n primary invariants are
     2531  {                                    // found -
     2532    d=d+1;                             // degree where we'll search
     2533    if (v)
     2534    { "  Computing primary invariants in degree "+string(d)+":";
     2535    }
     2536    B=invariant_basis_reynolds(REY,d,intvec(-1,6)); // basis of invariants of
     2537                                       // degree d
     2538    if (B[1]<>0)
     2539    { Pplus=P+B;
     2540      sPplus=std(Pplus);
     2541      newdim=dim(sPplus);
     2542      dif=n-i-newdim;
     2543    }
     2544    else
     2545    { dif=0;
     2546      deg_vector=deg_vector,d;
     2547    }
     2548    if (dif<>0)                        // we have to find dif new primary
     2549    {                                  // invariants
     2550      cd=size(B);
     2551      if (cd<>dif)
     2552      { P,sP,CI,dB=p_search(n,d,B,cd,P,sP,i,dif,dB,CI);
     2553      }
     2554      else                             // i.e. we can take all of B
     2555      { for(j=i+1;j<=i+dif;j=j+1)
     2556        { CI=CI+ideal(var(j)^d);
     2557        }
     2558        dB=dB+dif*(d-1);
     2559        P=Pplus;
     2560        sP=sPplus;
     2561      }
     2562      if (v)
     2563      { for (j=1;j<=size(P)-i;j=j+1)
     2564        { "  We find: "+string(P[i+j]);
     2565        }
     2566      }
     2567      i=size(P);
     2568      if (i==n)                        // found all primary invariants
     2569      { if (v)
     2570        { "";
     2571          "  We found all primary invariants.";
     2572          "";
     2573        }
     2574        if (deg_vector==0)
     2575        { return(matrix(P));
     2576        }
     2577        else
     2578        { return(matrix(P),compress(deg_vector));
     2579        }
     2580      }
     2581    }                                  // done with degree d
     2582    else
     2583    { if (v)
     2584      { "  None here...";
     2585      }
     2586    }
     2587  }
     2588}
     2589example
     2590{ "EXAMPLE: Sturmfels: Algorithms in Invariant Theory 2.3.7 (changed into";
     2591  "         characteristic 3)";
     2592  echo=2;
     2593         ring R=3,(x,y,z),dp;
     2594         matrix A[3][3]=0,1,0,-1,0,0,0,0,-1;
     2595         list L=group_reynolds(A);
     2596         list l=primary_charp_no_molien(L[1]);
     2597         print(l[1]);
     2598}
     2599
     2600proc primary_charp_without (list #)
     2601USAGE:   primary_charp_without(G1,G2,...[,v]);
     2602         G1,G2,...: <matrices> generating a finite matrix group, v: an optional
     2603         <int>
     2604DISPLAY: information about the various stages of the programme if v does not
     2605         equal 0
     2606RETURN:  primary invariants (type <matrix>) of the invariant ring
     2607EXAMPLE: example primary_charp_without; shows an example
     2608THEORY:  Bases of homogeneous invariants are generated successively and those
     2609         are chosen as primary invariants that lower the dimension of the ideal
     2610         generated by the previously found invariants (see paper "Generating a
     2611         Noetherian Normalization of the Invariant Ring of a Finite Group" by
     2612         Decker, Heydtmann, Schreyer (1997) to appear in JSC). No Reynolds
     2613         operator or Molien series is used.
     2614{ degBound=0;
     2615 //--------------------- checking input and setting verbose mode --------------
     2616  if (char(basering)==0)
     2617  { "ERROR:   primary_charp_without should only be used with rings of";
     2618    "         characteristic 0.";
     2619    return();
     2620  }
     2621  if (size(#)==0)
     2622  { "ERROR:   There are no parameters.";
     2623    return();
     2624  }
     2625  if (typeof(#[size(#)])=="int")
     2626  { int v=#[size(#)];
     2627    int gen_num=size(#)-1;
     2628    if (gen_num==0)
     2629    { "ERROR:   There are no generators of a finite matrix group given.";
     2630      return();
     2631    }
     2632  }
     2633  else
     2634  { int v=0;
     2635    int gen_num=size(#);
     2636  }
     2637  int n=nvars(basering);               // n is the number of variables, as well
     2638                                       // as the size of the matrices, as well
     2639                                       // as the number of primary invariants,
     2640                                       // we should get
     2641  for (int i=1;i<=gen_num;i=i+1)
     2642  { if (typeof(#[i])=="matrix")
     2643    { if (nrows(#[i])<>n or ncols(#[i])<>n)
     2644      { "ERROR:   The number of variables of the base ring needs to be the same";
     2645        "         as the dimension of the square matrices";
     2646        return();
     2647      }
     2648    }
     2649    else
     2650    { "ERROR:   The first parameters should be a list of matrices";
     2651      return();
     2652    }
     2653  }
     2654 //----------------------------------------------------------------------------
     2655  if (v && voice==2)
     2656  { "";
     2657  }
     2658 //---------------------------- initializing variables ------------------------
     2659  int dB;
     2660  int j,d,cd,newdim,dif;               // d: current degree, cd: dimension of
     2661                                       // space of invariants of degree d,
     2662                                       // newdim: dimension the ideal generated
     2663                                       // the primary invariants plus basis
     2664                                       // elements, dif=n-i-newdim, i.e. the
     2665                                       // number of new primary invairants that
     2666                                       // should be added in this degree -
     2667  ideal P,Pplus,sPplus,CI,B;           // P: will contain primary invariants,
     2668                                       // Pplus: P+B, CI: a complete
     2669                                       // intersection with the same Hilbert
     2670                                       // function as P
     2671  ideal sP=std(P);
     2672  dB=1;                                // used as degree bound -
     2673  d=0;                                 // initializing
     2674  i=0;
     2675  intvec deg_vector;
     2676 //-------------------- loop that searches for primary invariants -------------
     2677  while(1)                             // repeat until n primary invariants are
     2678  {                                    // found -
     2679    d=d+1;                             // degree where we'll search
     2680    if (v)
     2681    { "  Computing primary invariants in degree "+string(d)+":";
     2682    }
     2683    B=invariant_basis(d,#[1..gen_num]); // basis of invariants of degree d
     2684    if (B[1]<>0)
     2685    { Pplus=P+B;
     2686      sPplus=std(Pplus);
     2687      newdim=dim(sPplus);
     2688      dif=n-i-newdim;
     2689    }
     2690    else
     2691    { dif=0;
     2692      deg_vector=deg_vector,d;
     2693    }
     2694    if (dif<>0)                        // we have to find dif new primary
     2695    {                                  // invariants
     2696      cd=size(B);
     2697      if (cd<>dif)
     2698      { P,sP,CI,dB=p_search(n,d,B,cd,P,sP,i,dif,dB,CI);
     2699      }
     2700      else                             // i.e. we can take all of B
     2701      { for(j=i+1;j<=i+dif;j=j+1)
     2702        { CI=CI+ideal(var(j)^d);
     2703        }
     2704        dB=dB+dif*(d-1);
     2705        P=Pplus;
     2706        sP=sPplus;
     2707      }
     2708      if (v)
     2709      { for (j=1;j<=size(P)-i;j=j+1)
     2710        { "  We find: "+string(P[i+j]);
     2711        }
     2712      }
     2713      i=size(P);
     2714      if (i==n)                        // found all primary invariants
     2715      { if (v)
     2716        { "";
     2717          "  We found all primary invariants.";
     2718          "";
     2719        }
     2720        return(matrix(P));
     2721      }
     2722    }                                  // done with degree d
     2723    else
     2724    { if (v)
     2725      { "  None here...";
     2726      }
     2727    }
     2728  }
     2729}
     2730example
     2731{ echo=2;
     2732         ring R=2,(x,y,z),dp;
     2733         matrix A[3][3]=0,1,0,-1,0,0,0,0,-1;
     2734         matrix P=primary_charp_without(A);
     2735         print(P);
     2736}
     2737
     2738proc primary_invariants (list #)
     2739USAGE:   primary_invariants(G1,G2,...[,flags]);
     2740         G1,G2,...: <matrices> generating a finite matrix group, flags: an
     2741         optional <intvec> with three entries, if the first one equals 0 (also
     2742         the default), the programme attempts to compute the Molien series and
     2743         Reynolds operator, if it equals 1, the programme is told that the
     2744         Molien series should not be computed, if it equals -1 characteristic 0
     2745         is simulated, i.e. the Molien series is computed as if the base field
     2746         were characteristic 0 (the user must choose a field of large prime
     2747         characteristic, e.g. 32003) and if the first one is anything else, it
     2748         means that the characteristic of the base field divides the group
     2749         order, the second component should give the size of intervals between
     2750         canceling common factors in the expansion of the Molien series, 0 (the
     2751         default) means only once after generating all terms, in prime
     2752         characteristic also a negative number can be given to indicate that
     2753         common factors should always be canceled when the expansion is simple
     2754         (the root of the extension field does not occur among the coefficients)
     2755DISPLAY: information about the various stages of the programme if the third
     2756         flag does not equal 0
     2757RETURN:  primary invariants (type <matrix>) of the invariant ring and if
     2758         computable Reynolds operator (type <matrix>) and Molien series (type
     2759         <matrix>), if the first flag is 1 and we are in the non-modular case
     2760         then an <intvec> is returned giving some of the degrees where no
     2761         non-trivial homogeneous invariants can be found
     2762EXAMPLE: example primary_invariants; shows an example
     2763THEORY:  Bases of homogeneous invariants are generated successively and those
     2764         are chosen as primary invariants that lower the dimension of the ideal
     2765         generated by the previously found invariants (see paper "Generating a
     2766         Noetherian Normalization of the Invariant Ring of a Finite Group" by
     2767         Decker, Heydtmann, Schreyer (1997) to appear in JSC).
     2768{
     2769 // ----------------- checking input and setting flags ------------------------
     2770  if (size(#)==0)
     2771  { "ERROR:   There are no parameters.";
     2772    return();
     2773  }
     2774  int ch=char(basering);               // the algorithms depend very much on the
     2775                                       // characteristic of the ground field
     2776  int n=nvars(basering);               // n is the number of variables, as well
     2777                                       // as the size of the matrices, as well
     2778                                       // as the number of primary invariants,
     2779                                       // we should get
     2780  int gen_num;
     2781  int mol_flag,v;
     2782  if (typeof(#[size(#)])=="intvec")
     2783  { if (size(#[size(#)])<>3)
     2784    { "ERROR:   <intvec> should have three entries.";
     2785      return();
     2786    }
     2787    gen_num=size(#)-1;
     2788    mol_flag=#[size(#)][1];
     2789    if (#[size(#)][2]<0 && (ch==0 or (ch<>0 && mol_flag==-1)))
     2790    { "ERROR:   the second component of <intvec> should be >=0";
     2791      return();
     2792    }
     2793    int interval=#[size(#)][2];
     2794    v=#[size(#)][3];
     2795    if (gen_num==0)
     2796    { "ERROR:   There are no generators of a finite matrix group given.";
     2797      return();
     2798    }
     2799  }
     2800  else
     2801  { gen_num=size(#);
     2802    mol_flag=0;
     2803    int interval=0;
     2804    v=0;
     2805  }
     2806  for (int i=1;i<=gen_num;i=i+1)
     2807  { if (typeof(#[i])=="matrix")
     2808    { if (nrows(#[i])<>n or ncols(#[i])<>n)
     2809      { "ERROR:   The number of variables of the base ring needs to be the same";
     2810        "         as the dimension of the square matrices";
     2811        return();
     2812      }
     2813    }
     2814    else
     2815    { "ERROR:   The first parameters should be a list of matrices";
     2816      return();
     2817    }
     2818  }
     2819 //----------------------------------------------------------------------------
     2820  if (mol_flag==0)
     2821  { if (ch==0)
     2822    { matrix REY,M=reynolds_molien(#[1..gen_num],intvec(mol_flag,interval,v));
     2823                                       // one will contain Reynolds operator and
     2824                                       // the other enumerator and denominator
     2825                                       // of Molien series
     2826      matrix P=primary_char0(REY,M,v);
     2827      return(P,REY,M);
     2828    }
     2829    else
     2830    { list L=group_reynolds(#[1..gen_num],v);
     2831      if (L[1]<>0)                     // testing whether we are in the modular
     2832      { string newring="aksldfalkdsflkj"; // case
     2833        if (minpoly==0)
     2834        { if (v)
     2835          { "  We are dealing with the non-modular case.";
     2836          }
     2837          if (typeof(L[2])=="int")
     2838          { molien(L[3..size(L)],newring,L[2],intvec(mol_flag,interval,v));
     2839          }
     2840          else
     2841          { molien(L[2..size(L)],newring,intvec(mol_flag,interval,v));
     2842          }
     2843          matrix P=primary_charp(L[1],newring,v);
     2844          return(P,L[1],newring);
     2845        }
     2846        else
     2847        { if (v)
     2848          { "  Since it is impossible for this programme to calculate the Molien series for";
     2849            "  invariant rings over extension fields of prime characteristic, we have to";
     2850            "  continue without it.";
     2851            "";
     2852
     2853          }
     2854          list l=primary_charp_no_molien(L[1],v);
     2855          if (size(l)==2)
     2856          { return(l[1],L[1],l[2]);
     2857          }
     2858          else
     2859          { return(l[1],L[1]);
     2860          }
     2861        }
     2862      }
     2863      else                             // the modular case
     2864      { if (v)
     2865        { "  There is also no Molien series, we can make use of...";
     2866          "";
     2867          "  We can start looking for primary invariants...";
     2868          "";
     2869        }
     2870        return(primary_charp_without(#[1..gen_num],v));
     2871      }
     2872    }
     2873  }
     2874  if (mol_flag==1)                     // the user wants no calculation of the
     2875  { list L=group_reynolds(#[1..gen_num],v); // Molien series
     2876    if (ch==0)
     2877    { list l=primary_char0_no_molien(L[1],v);
     2878      if (size(l)==2)
     2879      { return(l[1],L[1],l[2]);
     2880      }
     2881      else
     2882      { return(l[1],L[1]);
     2883      }
     2884    }
     2885    else
     2886    { if (L[1]<>0)                     // testing whether we are in the modular
     2887      { list l=primary_charp_no_molien(L[1],v); // case
     2888        if (size(l)==2)
     2889        { return(l[1],L[1],l[2]);
     2890        }
     2891        else
     2892        { return(l[1],L[1]);
     2893        }
     2894      }
     2895      else                             // the modular case
     2896      { if (v)
     2897        { "  We can start looking for primary invariants...";
     2898          "";
     2899        }
     2900        return(primary_charp_without(#[1..gen_num],v));
     2901      }
     2902    }
     2903  }
     2904  if (mol_flag==-1)
     2905  { if (ch==0)
     2906    { "ERROR:   Characteristic 0 can only be simulated in characteristic p>>0.";
     2907      return();
     2908    }
     2909    list L=group_reynolds(#[1..gen_num],v);
     2910    string newring="aksldfalkdsflkj";
     2911    molien(L[2..size(L)],newring,intvec(1,interval,v));
     2912    matrix P=primary_charp(L[1],newring,v);
     2913    return(P,L[1],newring);
     2914  }
     2915  else                                 // the user specified that the
     2916  { if (ch==0)                         // characteristic divides the group order
     2917    { "ERROR:   The characteristic cannot divide the group order when it is 0.";
     2918      return();
     2919    }
     2920    if (v)
     2921    { "";
     2922    }
     2923    return(primary_charp_without(#[1..gen_num],v));
     2924  }
     2925}
     2926example
     2927{ "EXAMPLE: Sturmfels: Algorithms in Invariant Theory 2.3.7:";
     2928  echo=2;
     2929         ring R=0,(x,y,z),dp;
     2930         matrix A[3][3]=0,1,0,-1,0,0,0,0,-1;
     2931         list L=primary_invariants(A);
     2932         print(L[1]);
    11122933}
    11132934
    11142935////////////////////////////////////////////////////////////////////////////////
    1115 // If the characteristic of the base field is zero or prime not dividing the
    1116 // order of the group G, one can compute secondary invariants (free module
    1117 // generators) even without the Molien series. In other words, when the user
    1118 // enters a flag that tells the procedures inv_ring_s or inv_ring_k not to compute
    1119 // the Molien series, it the number of group elements will be computed (with
    1120 // group). If the characteristic is 0 or prime not dividing the order of the
    1121 // group, there are deg(P[1])*...*deg(P[n])/|G| free module generators where P
    1122 // contains the primary invariants. sec_minus_mol computes these secondary
    1123 // invariants by going through the various spaces of homogeneous invariants
    1124 // successively, starting with degree 1.
    1125 // list # is made of of various things. The last component is an integer, saying
    1126 // how many of the immediately preceding elements are bases of various vector
    1127 // spaces of homogeneous invariants. Before these bases, is a boolean variable.
    1128 // if it is 0, the preceding elements are group generators (we will use
    1129 // inv_basis), if it is 0, the Reynolds operator is passed on (and we can use
    1130 // inv_basis_rey).
    1131 // sP is the standard basis of the ideal generated by primary invariants in P. g
    1132 // is the cardinality of the group. v is the verbose-level.
     2936// This procedure finds dif primary invariants in degree d. It returns all
     2937// primary invariants found so far. The coefficients lie in a field of
     2938// characteristic 0.
    11332939////////////////////////////////////////////////////////////////////////////////
    1134 proc sec_minus_mol (ideal P, ideal sP, int g, int v, list#)
     2940proc search_random (int n,int d,ideal B,int cd,ideal P,int i,int dif,int dB,ideal CI,int max)
     2941{ string answer;
     2942  degBound=0;
     2943  int j,k,test_dim,flag;
     2944  matrix test_matrix[1][dif];          // the linear combination to test
     2945  intvec h;                            // Hilbert series
     2946  for (j=i+1;j<=i+dif;j=j+1)
     2947  { CI=CI+ideal(var(j)^d);             // homogeneous polynomial of the same
     2948                                       // degree as the one we're looking for
     2949                                       // is added
     2950  }
     2951  ideal TEST;
     2952  // h=hilb(std(CI),1);
     2953  dB=dB+dif*(d-1);                     // used as degBound
     2954  while (1)
     2955  { test_matrix=matrix(B)*random(max,cd,dif);
     2956    // degBound=dB;
     2957    TEST=P+ideal(test_matrix);
     2958    attrib(TEST,"isSB",1);
     2959    test_dim=dim(TEST);
     2960    // degBound=0;
     2961    if (n-test_dim==i+dif)
     2962    { break;
     2963    }
     2964    // degBound=dB;
     2965    test_dim=dim(std(TEST));
     2966    // test_dim=dim(std(TEST,h));         // Hilbert driven std-calculation
     2967    // degBound=0;
     2968    if (n-test_dim==i+dif)
     2969    { break;
     2970    }
     2971    else
     2972    { "HELP:    The "+string(dif)+" random combination(s) of the "+string(cd)+" basis elements with";
     2973      "         coefficients in the range from -"+string(max)+" to "+string(max)+" did not lower the";
     2974      "         dimension by "+string(dif)+". You can abort, try again or give a new range:";
     2975      answer="";
     2976      while (answer<>"n
     2977" && answer<>"y
     2978")
     2979      { "         Do you want to abort (y/n)?";
     2980        answer=read("");
     2981      }
     2982      if (answer=="y
     2983")
     2984      { flag=1;
     2985        break;
     2986      }
     2987      answer="";
     2988      while (answer<>"n
     2989" && answer<>"y
     2990")
     2991      { "         Do you want to try again (y/n)?";
     2992        answer=read("");
     2993      }
     2994      if (answer=="n
     2995")
     2996      { flag=1;
     2997        while (flag)
     2998        { "         Give a new <int> > "+string(max)+" that bounds the range of coefficients:";
     2999          answer=read("");
     3000          for (j=1;j<=size(answer)-1;j=j+1)
     3001          { for (k=0;k<=9;k=k+1)
     3002            { if (answer[j]==string(k))
     3003              { break;
     3004              }
     3005            }
     3006            if (k>9)
     3007            { flag=1;
     3008              break;
     3009            }
     3010            flag=0;
     3011          }
     3012          if (not(flag))
     3013          { execute "test_dim="+string(answer[1..size(answer)]);
     3014            if (test_dim<=max)
     3015            { flag=1;
     3016            }
     3017            else
     3018            { max=test_dim;
     3019            }
     3020          }
     3021        }
     3022      }
     3023    }
     3024  }
     3025  if (not(flag))
     3026  { P[(i+1)..(i+dif)]=test_matrix[1,1..dif];
     3027  }
     3028  return(P,CI,dB);
     3029}
     3030
     3031////////////////////////////////////////////////////////////////////////////////
     3032// This procedure finds at most dif primary invariants in degree d. It returns
     3033// all primary invariants found so far. The coefficients lie in the field of
     3034// characteristic p>0.
     3035////////////////////////////////////////////////////////////////////////////////
     3036proc p_search_random (int n,int d,ideal B,int cd,ideal P,int i,int dif,int dB,ideal CI,int max)
     3037{ string answer;
     3038  degBound=0;
     3039  int j,k,test_dim,flag;
     3040  matrix test_matrix[1][dif];          // the linear combination to test
     3041  intvec h;                            // Hilbert series
     3042  ideal TEST;
     3043  while (dif>0)
     3044  { for (j=i+1;j<=i+dif;j=j+1)
     3045    { CI=CI+ideal(var(j)^d);           // homogeneous polynomial of the same
     3046                                       // degree as the one we're looking for
     3047                                       // is added
     3048    }
     3049    // h=hilb(std(CI),1);
     3050    dB=dB+dif*(d-1);                   // used as degBound
     3051    test_matrix=matrix(B)*random(max,cd,dif);
     3052    // degBound=dB;
     3053    TEST=P+ideal(test_matrix);
     3054    attrib(TEST,"isSB",1);
     3055    test_dim=dim(TEST);
     3056    // degBound=0;
     3057    if (n-test_dim==i+dif)
     3058    { break;
     3059    }
     3060    // degBound=dB;
     3061    test_dim=dim(std(TEST));
     3062    // test_dim=dim(std(TEST,h));         // Hilbert driven std-calculation
     3063    // degBound=0;
     3064    if (n-test_dim==i+dif)
     3065    { break;
     3066    }
     3067    else
     3068    { "HELP:    The "+string(dif)+" random combination(s) of the "+string(cd)+" basis elements with";
     3069      "         coefficients in the range from -"+string(max)+" to "+string(max)+" did not lower the";
     3070      "         dimension by "+string(dif)+". You can abort, try again, lower the number of";
     3071      "         combinations searched for by 1 or give a larger coefficient range:";
     3072      answer="";
     3073      while (answer<>"n
     3074" && answer<>"y
     3075")
     3076      { "         Do you want to abort (y/n)?";
     3077        answer=read("");
     3078      }
     3079      if (answer=="y
     3080")
     3081      { flag=1;
     3082        break;
     3083      }
     3084      answer="";
     3085      while (answer<>"n
     3086" && answer<>"y
     3087")
     3088      { "         Do you want to try again (y/n)?";
     3089        answer=read("");
     3090      }
     3091      if (answer=="n
     3092")
     3093      { answer="";
     3094        while (answer<>"n
     3095" && answer<>"y
     3096")
     3097        { "         Do you want to lower the number of combinations by 1 (y/n)?";
     3098          answer=read("");
     3099        }
     3100        if (answer=="y
     3101")
     3102        { dif=dif-1;
     3103        }
     3104        else
     3105        { flag=1;
     3106          while (flag)
     3107          { "         Give a new <int> > "+string(max)+" that bounds the range of coefficients:";
     3108            answer=read("");
     3109            for (j=1;j<=size(answer)-1;j=j+1)
     3110            { for (k=0;k<=9;k=k+1)
     3111              { if (answer[j]==string(k))
     3112                { break;
     3113                }
     3114              }
     3115              if (k>9)
     3116              { flag=1;
     3117                break;
     3118              }
     3119              flag=0;
     3120            }
     3121            if (not(flag))
     3122            { execute "test_dim="+string(answer[1..size(answer)]);
     3123              if (test_dim<=max)
     3124              { flag=1;
     3125              }
     3126              else
     3127              { max=test_dim;
     3128              }
     3129            }
     3130          }
     3131        }
     3132      }
     3133    }
     3134    CI=CI[1..i];
     3135    dB=dB-dif*(d-1);
     3136  }
     3137  if (dif && not(flag))
     3138  { P[(i+1)..(i+dif)]=test_matrix[1,1..dif];
     3139  }
     3140  if (dif && flag)
     3141  { P[n+1]=0;
     3142  }
     3143  return(P,CI,dB);
     3144}
     3145
     3146proc primary_char0_random (matrix REY,matrix M,int max,list #)
     3147USAGE:   primary_char0_random(REY,M,r[,v]);
     3148         REY: a <matrix> representing the Reynolds operator, M: a 1x2 <matrix>
     3149         representing the Molien series, r: an <int> where -|r| to |r| is the
     3150         range of coefficients of the random combinations of bases elements,
     3151         v: an optional <int>
     3152ASSUME:  REY is the first return value of group_reynolds or reynolds_molien and
     3153         M the one of molien or the second one of reynolds_molien
     3154DISPLAY: information about the various stages of the programme if v does not
     3155         equal 0
     3156RETURN:  primary invariants (type <matrix>) of the invariant ring
     3157EXAMPLE: example primary_char0_random; shows an example
     3158THEORY:  Bases of homogeneous invariants are generated successively and random
     3159         linear combinations are chosen as primary invariants that lower the
     3160         dimension of the ideal generated by the previously found invariants
     3161         (see paper "Generating a Noetherian Normalization of the Invariant Ring
     3162         of a Finite Group" by Decker, Heydtmann, Schreyer (1997) to appear in
     3163         JSC).
     3164{ degBound=0;
     3165  if (char(basering)<>0)
     3166  { "ERROR:   primary_char0_random should only be used with rings of";
     3167    "         characteristic 0.";
     3168    return();
     3169  }
     3170 //----------------- checking input and setting verbose mode ------------------
     3171  if (size(#)>1)
     3172  { "ERROR:   primary_char0_random can only have four parameters.";
     3173    return();
     3174  }
     3175  if (size(#)==1)
     3176  { if (typeof(#[1])<>"int")
     3177    { "ERROR:   The fourth parameter should be of type <int>.";
     3178      return();
     3179    }
     3180    else
     3181    { int v=#[1];
     3182    }
     3183  }
     3184  else
     3185  { int v=0;
     3186  }
     3187  int n=nvars(basering);               // n is the number of variables, as well
     3188                                       // as the size of the matrices, as well
     3189                                       // as the number of primary invariants,
     3190                                       // we should get
     3191  if (ncols(REY)<>n)
     3192  { "ERROR:   First parameter ought to be the Reynolds operator."
     3193    return();
     3194  }
     3195  if (ncols(M)<>2 or nrows(M)<>1)
     3196  { "ERROR:   Second parameter ought to be the Molien series."
     3197    return();
     3198  }
     3199 //----------------------------------------------------------------------------
     3200  if (v && voice<>2)
     3201  { "  We can start looking for primary invariants...";
     3202    "";
     3203  }
     3204  if (v && voice==2)
     3205  { "";
     3206  }
     3207 //------------------------- initializing variables ---------------------------
     3208  int dB;
     3209  poly p(1..2);                        // p(1) will be used for single terms of
     3210                                       // the partial expansion, p(2) to store
     3211  p(1..2)=partial_molien(M,1);         // the intermediate result -
     3212  poly v1=var(1);                      // we need v1 to split off coefficients
     3213                                       // in the partial expansion of M (which
     3214                                       // is in terms of the first variable) -
     3215  int j,d,cd,newdim,dif;               // d: current degree, cd: dimension of
     3216                                       // space of invariants of degree d,
     3217                                       // newdim: dimension the ideal generated
     3218                                       // the primary invariants plus basis
     3219                                       // elements, dif=n-i-newdim, i.e. the
     3220                                       // number of new primary invairants that
     3221                                       // should be added in this degree -
     3222  ideal P,Pplus,CI,B;                  // P: will contain primary invariants,
     3223                                       // Pplus: P+B,CI: a complete
     3224                                       // intersection with the same Hilbert
     3225                                       // function as P -
     3226  dB=1;                                // used as degree bound
     3227  int i=0;
     3228 //-------------- loop that searches for primary invariants  ------------------
     3229  while(1)                             // repeat until n primary invariants are
     3230  {                                    // found -
     3231    p(1..2)=partial_molien(M,1,p(2));  // next term of the partial expansion -
     3232    d=deg(p(1));                       // degree where we'll search -
     3233    cd=int(coef(p(1),v1)[2,1]);        // dimension of the homogeneous space of
     3234                                       // inviarants of degree d
     3235    if (v)
     3236    { "  Computing primary invariants in degree "+string(d)+":";
     3237    }
     3238    B=invariant_basis_reynolds(REY,d,intvec(cd,6)); // basis of invariants of
     3239                                       // degree d
     3240    if (B[1]<>0)
     3241    { Pplus=P+B;
     3242      newdim=dim(std(Pplus));
     3243      dif=n-i-newdim;
     3244    }
     3245    else
     3246    { dif=0;
     3247    }
     3248    if (dif<>0)                        // we have to find dif new primary
     3249    {                                  // invariants
     3250      if (cd<>dif)
     3251      { P,CI,dB=search_random(n,d,B,cd,P,i,dif,dB,CI,max); // searching for
     3252      }                                // dif invariants -
     3253      else                             // i.e. we can take all of B
     3254      { for(j=i+1;j>i+dif;j=j+1)
     3255        { CI=CI+ideal(var(j)^d);
     3256        }
     3257        dB=dB+dif*(d-1);
     3258        P=Pplus;
     3259      }
     3260      if (ncols(P)==i)
     3261      { "WARNING: The return value is not a set of primary invariants, but";
     3262        "         polynomials qualifying as the first "+string(i)+" primary invariants.";
     3263        return(matrix(P));
     3264      }
     3265      if (v)
     3266      { for (j=1;j<=dif;j=j+1)
     3267        { "  We find: "+string(P[i+j]);
     3268        }
     3269      }
     3270      i=i+dif;
     3271      if (i==n)                        // found all primary invariants
     3272      { if (v)
     3273        { "";
     3274          "  We found all primary invariants.";
     3275          "";
     3276        }
     3277        return(matrix(P));
     3278      }
     3279    }                                  // done with degree d
     3280  }
     3281}
     3282example
     3283{ "EXAMPLE: Sturmfels: Algorithms in Invariant Theory 2.3.7:";
     3284  echo=2;
     3285         ring R=0,(x,y,z),dp;
     3286         matrix A[3][3]=0,1,0,-1,0,0,0,0,-1;
     3287         matrix REY,M=reynolds_molien(A);
     3288         matrix P=primary_char0_random(REY,M,1);
     3289         print(P);
     3290}
     3291
     3292proc primary_charp_random (matrix REY,string ring_name,int max,list #)
     3293USAGE:   primary_charp_random(REY,ringname,r[,v]);
     3294         REY: a <matrix> representing the Reynolds operator, ringname: a
     3295         <string> giving the name of a ring where the Molien series is stored,
     3296         r: an <int> where -|r| to |r| is the range of coefficients of the
     3297         random combinations of bases elements, v: an optional <int>
     3298ASSUME:  REY is the first return value of group_reynolds or reynolds_molien and
     3299         ringname gives the name of a ring of characteristic 0 that has been
     3300         created by molien or reynolds_molien
     3301DISPLAY: information about the various stages of the programme if v does not
     3302         equal 0
     3303RETURN:  primary invariants (type <matrix>) of the invariant ring
     3304EXAMPLE: example primary_charp_random; shows an example
     3305THEORY:  Bases of homogeneous invariants are generated successively and random
     3306         linear combinations are chosen as primary invariants that lower the
     3307         dimension of the ideal generated by the previously found invariants
     3308         (see paper "Generating a Noetherian Normalization of the Invariant Ring
     3309         of a Finite Group" by Decker, Heydtmann, Schreyer (1997) to appear in
     3310         JSC).
     3311{ degBound=0;
     3312 // ---------------- checking input and setting verbose mode ------------------
     3313  if (char(basering)==0)
     3314  { "ERROR:   primary_charp_random should only be used with rings of";
     3315    "         characteristic p>0.";
     3316    return();
     3317  }
     3318  if (size(#)>1)
     3319  { "ERROR:   primary_charp_random can only have four parameters.";
     3320    return();
     3321  }
     3322  if (size(#)==1)
     3323  { if (typeof(#[1])<>"int")
     3324    { "ERROR:   The fourth parameter should be of type <int>.";
     3325      return();
     3326    }
     3327    else
     3328    { int v=#[1];
     3329    }
     3330  }
     3331  else
     3332  { int v=0;
     3333  }
     3334  def br=basering;
     3335  int n=nvars(br);                     // n is the number of variables, as well
     3336                                       // as the size of the matrices, as well
     3337                                       // as the number of primary invariants,
     3338                                       // we should get
     3339  if (ncols(REY)<>n)
     3340  { "ERROR:   First parameter ought to be the Reynolds operator."
     3341    return();
     3342  }
     3343  if (typeof(`ring_name`)<>"ring")
     3344  { "ERROR:   Second parameter ought to the name of a ring where the Molien";
     3345    "         is stored.";
     3346    return();
     3347  }
     3348 //----------------------------------------------------------------------------
     3349  if (v && voice<>2)
     3350  { "  We can start looking for primary invariants...";
     3351    "";
     3352  }
     3353  if (v && voice==2)
     3354  { "";
     3355  }
     3356 //----------------------- initializing variables -----------------------------
     3357  int dB;
     3358  setring `ring_name`;                 // the Molien series is stores here -
     3359  poly p(1..2);                        // p(1) will be used for single terms of
     3360                                       // the partial expansion, p(2) to store
     3361  p(1..2)=partial_molien(M,1);         // the intermediate result -
     3362  poly v1=var(1);                      // we need v1 to split off coefficients
     3363                                       // in the partial expansion of M (which
     3364                                       // is in terms of the first variable)
     3365  setring br;
     3366  int j,d,cd,newdim,dif;               // d: current degree, cd: dimension of
     3367                                       // space of invariants of degree d,
     3368                                       // newdim: dimension the ideal generated
     3369                                       // the primary invariants plus basis
     3370                                       // elements, dif=n-i-newdim, i.e. the
     3371                                       // number of new primary invairants that
     3372                                       // should be added in this degree -
     3373  ideal P,Pplus,CI,B;                  // P: will contain primary invariants,
     3374                                       // Pplus: P+B, CI: a complete
     3375                                       // intersection with the same Hilbert
     3376                                       // function as P -
     3377  dB=1;                                // used as degree bound
     3378  int i=0;
     3379 //---------------- loop that searches for primary invariants -----------------
     3380  while(1)                             // repeat until n primary invariants are
     3381  {                                    // found
     3382    setring `ring_name`;
     3383    p(1..2)=partial_molien(M,1,p(2));  // next term of the partial expansion -
     3384    d=deg(p(1));                       // degree where we'll search -
     3385    cd=int(coef(p(1),v1)[2,1]);        // dimension of the homogeneous space of
     3386                                       // inviarants of degree d
     3387    setring br;
     3388    if (v)
     3389    { "  Computing primary invariants in degree "+string(d)+":";
     3390    }
     3391    B=invariant_basis_reynolds(REY,d,intvec(cd,6)); // basis of invariants of
     3392                                       // degree d
     3393    if (B[1]<>0)
     3394    { Pplus=P+B;
     3395      newdim=dim(std(Pplus));
     3396      dif=n-i-newdim;
     3397    }
     3398    else
     3399    { dif=0;
     3400    }
     3401    if (dif<>0)                        // we have to find dif new primary
     3402    {                                  // invariants
     3403      if (cd<>dif)
     3404      { P,CI,dB=p_search_random(n,d,B,cd,P,i,dif,dB,CI,max);
     3405      }
     3406      else                             // i.e. we can take all of B
     3407      { for(j=i+1;j>i+dif;j=j+1)
     3408        { CI=CI+ideal(var(j)^d);
     3409        }
     3410        dB=dB+dif*(d-1);
     3411        P=Pplus;
     3412      }
     3413      if (ncols(P)==n+1)
     3414      { "WARNING: The first return value is not a set of primary invariants,";
     3415        "         but polynomials qualifying as the first "+string(i)+" primary invariants.";
     3416        return(matrix(P));
     3417      }
     3418      if (v)
     3419      { for (j=1;j<=size(P)-i;j=j+1)
     3420        { "  We find: "+string(P[i+j]);
     3421        }
     3422      }
     3423      i=size(P);
     3424      if (i==n)                        // found all primary invariants
     3425      { if (v)
     3426        { "";
     3427          "  We found all primary invariants.";
     3428          "";
     3429        }
     3430        return(matrix(P));
     3431      }
     3432    }                                  // done with degree d
     3433  }
     3434}
     3435example
     3436{ "EXAMPLE: Sturmfels: Algorithms in Invariant Theory 2.3.7 (changed into";
     3437  "         characteristic 3)";
     3438  echo=2;
     3439         ring R=3,(x,y,z),dp;
     3440         matrix A[3][3]=0,1,0,-1,0,0,0,0,-1;
     3441         list L=group_reynolds(A);
     3442         string newring="alskdfj";
     3443         molien(L[2..size(L)],newring);
     3444         matrix P=primary_charp_random(L[1],newring,1);
     3445         kill `newring`;
     3446         print(P);
     3447}
     3448
     3449proc primary_char0_no_molien_random (matrix REY, int max, list #)
     3450USAGE:   primary_char0_no_molien_random(REY,r[,v]);
     3451         REY: a <matrix> representing the Reynolds operator, r: an <int> where
     3452         -|r| to |r| is the range of coefficients of the random combinations of
     3453         bases elements, v: an optional <int>
     3454ASSUME:  REY is the first return value of group_reynolds or reynolds_molien
     3455DISPLAY: information about the various stages of the programme if v does not
     3456         equal 0
     3457RETURN:  primary invariants (type <matrix>) of the invariant ring  and an
     3458         <intvec> listing some of the degrees where no non-trivial homogeneous
     3459         invariants are to be found
     3460EXAMPLE: example primary_char0_no_molien_random; shows an example
     3461THEORY:  Bases of homogeneous invariants are generated successively and random
     3462         linear combinations are chosen as primary invariants that lower the
     3463         dimension of the ideal generated by the previously found invariants
     3464         (see paper "Generating a Noetherian Normalization of the Invariant Ring
     3465         of a Finite Group" by Decker, Heydtmann, Schreyer (1997) to appear in
     3466         JSC).
     3467{ degBound=0;
     3468 //-------------- checking input and setting verbose mode ---------------------
     3469  if (char(basering)<>0)
     3470  { "ERROR:   primary_char0_no_molien_random should only be used with rings of";
     3471    "         characteristic 0.";
     3472    return();
     3473  }
     3474  if (size(#)>1)
     3475  { "ERROR:   primary_char0_no_molien_random can only have three parameters.";
     3476    return();
     3477  }
     3478  if (size(#)==1)
     3479  { if (typeof(#[1])<>"int")
     3480    { "ERROR:   The third parameter should be of type <int>.";
     3481      return();
     3482    }
     3483    else
     3484    { int v=#[1];
     3485    }
     3486  }
     3487  else
     3488  { int v=0;
     3489  }
     3490  int n=nvars(basering);               // n is the number of variables, as well
     3491                                       // as the size of the matrices, as well
     3492                                       // as the number of primary invariants,
     3493                                       // we should get
     3494  if (ncols(REY)<>n)
     3495  { "ERROR:   First parameter ought to be the Reynolds operator."
     3496    return();
     3497  }
     3498 //----------------------------------------------------------------------------
     3499  if (v && voice<>2)
     3500  { "  We can start looking for primary invariants...";
     3501    "";
     3502  }
     3503  if (v && voice==2)
     3504  { "";
     3505  }
     3506 //----------------------- initializing variables -----------------------------
     3507  int dB;
     3508  int j,d,cd,newdim,dif;               // d: current degree, cd: dimension of
     3509                                       // space of invariants of degree d,
     3510                                       // newdim: dimension the ideal generated
     3511                                       // the primary invariants plus basis
     3512                                       // elements, dif=n-i-newdim, i.e. the
     3513                                       // number of new primary invairants that
     3514                                       // should be added in this degree -
     3515  ideal P,Pplus,CI,B;                  // P: will contain primary invariants,
     3516                                       // Pplus: P+B, CI: a complete
     3517                                       // intersection with the same Hilbert
     3518                                       // function as P -
     3519  dB=1;                                // used as degree bound -
     3520  d=0;                                 // initializing
     3521  int i=0;
     3522  intvec deg_vector;
     3523 //------------------ loop that searches for primary invariants ---------------
     3524  while(1)                             // repeat until n primary invariants are
     3525  {                                    // found -
     3526    d=d+1;                             // degree where we'll search
     3527    if (v)
     3528    { "  Computing primary invariants in degree "+string(d)+":";
     3529    }
     3530    B=invariant_basis_reynolds(REY,d,intvec(-1,6)); // basis of invariants of
     3531                                       // degree d
     3532    if (B[1]<>0)
     3533    { Pplus=P+B;
     3534      newdim=dim(std(Pplus));
     3535      dif=n-i-newdim;
     3536    }
     3537    else
     3538    { dif=0;
     3539      deg_vector=deg_vector,d;
     3540    }
     3541    if (dif<>0)                        // we have to find dif new primary
     3542    {                                  // invariants
     3543      cd=size(B);
     3544      if (cd<>dif)
     3545      { P,CI,dB=search_random(n,d,B,cd,P,i,dif,dB,CI,max);
     3546      }
     3547      else                             // i.e. we can take all of B
     3548      { for(j=i+1;j<=i+dif;j=j+1)
     3549        { CI=CI+ideal(var(j)^d);
     3550        }
     3551        dB=dB+dif*(d-1);
     3552        P=Pplus;
     3553      }
     3554      if (ncols(P)==i)
     3555      { "WARNING: The first return value is not a set of primary invariants,";
     3556        "         but polynomials qualifying as the first "+string(i)+" primary invariants.";
     3557        return(matrix(P));
     3558      }
     3559      if (v)
     3560      { for (j=1;j<=dif;j=j+1)
     3561        { "  We find: "+string(P[i+j]);
     3562        }
     3563      }
     3564      i=i+dif;
     3565      if (i==n)                        // found all primary invariants
     3566      { if (v)
     3567        { "";
     3568          "  We found all primary invariants.";
     3569          "";
     3570        }
     3571        if (deg_vector==0)
     3572        { return(matrix(P));
     3573        }
     3574        else
     3575        { return(matrix(P),compress(deg_vector));
     3576        }
     3577      }
     3578    }                                  // done with degree d
     3579    else
     3580    { if (v)
     3581      { "  None here...";
     3582      }
     3583    }
     3584  }
     3585}
     3586example
     3587{ "EXAMPLE: Sturmfels: Algorithms in Invariant Theory 2.3.7:";
     3588  echo=2;
     3589         ring R=0,(x,y,z),dp;
     3590         matrix A[3][3]=0,1,0,-1,0,0,0,0,-1;
     3591         list L=group_reynolds(A);
     3592         list l=primary_char0_no_molien_random(L[1],1);
     3593         print(l[1]);
     3594}
     3595
     3596proc primary_charp_no_molien_random (matrix REY, int max, list #)
     3597USAGE:   primary_charp_no_molien_random(REY,r[,v]);
     3598         REY: a <matrix> representing the Reynolds operator, r: an <int> where
     3599         -|r| to |r| is the range of coefficients of the random combinations of
     3600         bases elements, v: an optional <int>
     3601ASSUME:  REY is the first return value of group_reynolds or reynolds_molien
     3602DISPLAY: information about the various stages of the programme if v does not
     3603         equal 0
     3604RETURN:  primary invariants (type <matrix>) of the invariant ring  and an
     3605         <intvec> listing some of the degrees where no non-trivial homogeneous
     3606         invariants are to be found
     3607EXAMPLE: example primary_charp_no_molien_random; shows an example
     3608THEORY:  Bases of homogeneous invariants are generated successively and random
     3609         linear combinations are chosen as primary invariants that lower the
     3610         dimension of the ideal generated by the previously found invariants
     3611         (see paper "Generating a Noetherian Normalization of the Invariant Ring
     3612         of a Finite Group" by Decker, Heydtmann, Schreyer (1997) to appear in
     3613         JSC).
     3614{ degBound=0;
     3615 //----------------- checking input and setting verbose mode ------------------
     3616  if (char(basering)==0)
     3617  { "ERROR:   primary_charp_no_molien_random should only be used with rings of";
     3618    "         characteristic p>0.";
     3619    return();
     3620  }
     3621  if (size(#)>1)
     3622  { "ERROR:   primary_charp_no_molien_random can only have three parameters.";
     3623    return();
     3624  }
     3625  if (size(#)==1)
     3626  { if (typeof(#[1])<>"int")
     3627    { "ERROR:   The third parameter should be of type <int>.";
     3628      return();
     3629    }
     3630    else
     3631    { int v=#[1];
     3632    }
     3633  }
     3634  else
     3635  { int v=0;
     3636  }
     3637  int n=nvars(basering);               // n is the number of variables, as well
     3638                                       // as the size of the matrices, as well
     3639                                       // as the number of primary invariants,
     3640                                       // we should get
     3641  if (ncols(REY)<>n)
     3642  { "ERROR:   First parameter ought to be the Reynolds operator."
     3643    return();
     3644  }
     3645 //----------------------------------------------------------------------------
     3646  if (v && voice<>2)
     3647  { "  We can start looking for primary invariants...";
     3648    "";
     3649  }
     3650  if (v && voice==2)
     3651  { "";
     3652  }
     3653 //-------------------- initializing variables --------------------------------
     3654  int dB;
     3655  int j,d,cd,newdim,dif;               // d: current degree, cd: dimension of
     3656                                       // space of invariants of degree d,
     3657                                       // newdim: dimension the ideal generated
     3658                                       // the primary invariants plus basis
     3659                                       // elements, dif=n-i-newdim, i.e. the
     3660                                       // number of new primary invairants that
     3661                                       // should be added in this degree -
     3662  ideal P,Pplus,CI,B;                  // P: will contain primary invariants,
     3663                                       // Pplus: P+B, CI: a complete
     3664                                       // intersection with the same Hilbert
     3665                                       // function as P -
     3666  dB=1;                                // used as degree bound -
     3667  d=0;                                 // initializing
     3668  int i=0;
     3669  intvec deg_vector;
     3670 //------------------ loop that searches for primary invariants ---------------
     3671  while(1)                             // repeat until n primary invariants are
     3672  {                                    // found -
     3673    d=d+1;                             // degree where we'll search
     3674    if (v)
     3675    { "  Computing primary invariants in degree "+string(d)+":";
     3676    }
     3677    B=invariant_basis_reynolds(REY,d,intvec(-1,6)); // basis of invariants of
     3678                                       // degree d
     3679    if (B[1]<>0)
     3680    { Pplus=P+B;
     3681      newdim=dim(std(Pplus));
     3682      dif=n-i-newdim;
     3683    }
     3684    else
     3685    { dif=0;
     3686      deg_vector=deg_vector,d;
     3687    }
     3688    if (dif<>0)                        // we have to find dif new primary
     3689    {                                  // invariants
     3690      cd=size(B);
     3691      if (cd<>dif)
     3692      { P,CI,dB=p_search_random(n,d,B,cd,P,i,dif,dB,CI,max);
     3693      }
     3694      else                             // i.e. we can take all of B
     3695      { for(j=i+1;j<=i+dif;j=j+1)
     3696        { CI=CI+ideal(var(j)^d);
     3697        }
     3698        dB=dB+dif*(d-1);
     3699        P=Pplus;
     3700      }
     3701      if (ncols(P)==n+1)
     3702      { "WARNING: The first return value is not a set of primary invariants,";
     3703        "         but polynomials qualifying as the first "+string(i)+" primary invariants.";
     3704        return(matrix(P));
     3705      }
     3706      if (v)
     3707      { for (j=1;j<=size(P)-i;j=j+1)
     3708        { "  We find: "+string(P[i+j]);
     3709        }
     3710      }
     3711      i=size(P);
     3712      if (i==n)                        // found all primary invariants
     3713      { if (v)
     3714        { "";
     3715          "  We found all primary invariants.";
     3716          "";
     3717        }
     3718        if (deg_vector==0)
     3719        { return(matrix(P));
     3720        }
     3721        else
     3722        { return(matrix(P),compress(deg_vector));
     3723        }
     3724      }
     3725    }                                  // done with degree d
     3726    else
     3727    { if (v)
     3728      { "  None here...";
     3729      }
     3730    }
     3731  }
     3732}
     3733example
     3734{ "EXAMPLE: Sturmfels: Algorithms in Invariant Theory 2.3.7 (changed into";
     3735  "         characteristic 3)";
     3736  echo=2;
     3737         ring R=3,(x,y,z),dp;
     3738         matrix A[3][3]=0,1,0,-1,0,0,0,0,-1;
     3739         list L=group_reynolds(A);
     3740         list l=primary_charp_no_molien_random(L[1],1);
     3741         print(l[1]);
     3742}
     3743
     3744proc primary_charp_without_random (list #)
     3745USAGE:   primary_charp_without_random(G1,G2,...,r[,v]);
     3746         G1,G2,...: <matrices> generating a finite matrix group, r: an <int>
     3747         where -|r| to |r| is the range of coefficients of the random
     3748         combinations of bases elements, v: an optional <int>
     3749DISPLAY: information about the various stages of the programme if v does not
     3750         equal 0
     3751RETURN:  primary invariants (type <matrix>) of the invariant ring
     3752EXAMPLE: example primary_charp_without_random; shows an example
     3753THEORY:  Bases of homogeneous invariants are generated successively and random
     3754         linear combinations are chosen as primary invariants that lower the
     3755         dimension of the ideal generated by the previously found invariants
     3756         (see paper "Generating a Noetherian Normalization of the Invariant Ring
     3757         of a Finite Group" by Decker, Heydtmann, Schreyer (1997) to appear in
     3758         JSC). No Reynolds operator or Molien series is used.
     3759{ degBound=0;
     3760 //--------------------- checking input and setting verbose mode --------------
     3761  if (char(basering)==0)
     3762  { "ERROR:   primary_charp_without_random should only be used with rings of";
     3763    "         characteristic 0.";
     3764    return();
     3765  }
     3766  if (size(#)<2)
     3767  { "ERROR:   There are too few parameters.";
     3768    return();
     3769  }
     3770  if (typeof(#[size(#)])=="int" && typeof(#[size(#)-1])=="int")
     3771  { int v=#[size(#)];
     3772    int max=#[size(#)-1];
     3773    int gen_num=size(#)-2;
     3774    if (gen_num==0)
     3775    { "ERROR:   There are no generators of a finite matrix group given.";
     3776      return();
     3777    }
     3778  }
     3779  else
     3780  { if (typeof(#[size(#)])=="int")
     3781    { int max=#[size(#)];
     3782      int v=0;
     3783      int gen_num=size(#)-1;
     3784    }
     3785    else
     3786    { "ERROR:   The last parameter should be an <int>.";
     3787      return();
     3788    }
     3789  }
     3790  int n=nvars(basering);               // n is the number of variables, as well
     3791                                       // as the size of the matrices, as well
     3792                                       // as the number of primary invariants,
     3793                                       // we should get
     3794  for (int i=1;i<=gen_num;i=i+1)
     3795  { if (typeof(#[i])=="matrix")
     3796    { if (nrows(#[i])<>n or ncols(#[i])<>n)
     3797      { "ERROR:   The number of variables of the base ring needs to be the same";
     3798        "         as the dimension of the square matrices";
     3799        return();
     3800      }
     3801    }
     3802    else
     3803    { "ERROR:   The first parameters should be a list of matrices";
     3804      return();
     3805    }
     3806  }
     3807 //----------------------------------------------------------------------------
     3808  if (v && voice==2)
     3809  { "";
     3810  }
     3811 //---------------------------- initializing variables ------------------------
     3812  int dB;
     3813  int j,d,cd,newdim,dif;               // d: current degree, cd: dimension of
     3814                                       // space of invariants of degree d,
     3815                                       // newdim: dimension the ideal generated
     3816                                       // the primary invariants plus basis
     3817                                       // elements, dif=n-i-newdim, i.e. the
     3818                                       // number of new primary invairants that
     3819                                       // should be added in this degree -
     3820  ideal P,Pplus,CI,B;                  // P: will contain primary invariants,
     3821                                       // Pplus: P+B, CI: a complete
     3822                                       // intersection with the same Hilbert
     3823                                       // function as P -
     3824  dB=1;                                // used as degree bound -
     3825  d=0;                                 // initializing
     3826  i=0;
     3827  intvec deg_vector;
     3828 //-------------------- loop that searches for primary invariants -------------
     3829  while(1)                             // repeat until n primary invariants are
     3830  {                                    // found -
     3831    d=d+1;                             // degree where we'll search
     3832    if (v)
     3833    { "  Computing primary invariants in degree "+string(d)+":";
     3834    }
     3835    B=invariant_basis(d,#[1..gen_num]); // basis of invariants of degree d
     3836    if (B[1]<>0)
     3837    { Pplus=P+B;
     3838      newdim=dim(std(Pplus));
     3839      dif=n-i-newdim;
     3840    }
     3841    else
     3842    { dif=0;
     3843      deg_vector=deg_vector,d;
     3844    }
     3845    if (dif<>0)                        // we have to find dif new primary
     3846    {                                  // invariants
     3847      cd=size(B);
     3848      if (cd<>dif)
     3849      { P,CI,dB=p_search_random(n,d,B,cd,P,i,dif,dB,CI,max);
     3850      }
     3851      else                             // i.e. we can take all of B
     3852      { for(j=i+1;j<=i+dif;j=j+1)
     3853        { CI=CI+ideal(var(j)^d);
     3854        }
     3855        dB=dB+dif*(d-1);
     3856        P=Pplus;
     3857      }
     3858      if (ncols(P)==n+1)
     3859      { "WARNING: The first return value is not a set of primary invariants,";
     3860        "         but polynomials qualifying as the first "+string(i)+" primary invariants.";
     3861        return(matrix(P));
     3862      }
     3863      if (v)
     3864      { for (j=1;j<=size(P)-i;j=j+1)
     3865        { "  We find: "+string(P[i+j]);
     3866        }
     3867      }
     3868      i=size(P);
     3869      if (i==n)                        // found all primary invariants
     3870      { if (v)
     3871        { "";
     3872          "  We found all primary invariants.";
     3873          "";
     3874        }
     3875        return(matrix(P));
     3876      }
     3877    }                                  // done with degree d
     3878    else
     3879    { if (v)
     3880      { "  None here...";
     3881      }
     3882    }
     3883  }
     3884}
     3885example
     3886{ echo=2;
     3887         ring R=2,(x,y,z),dp;
     3888         matrix A[3][3]=0,1,0,-1,0,0,0,0,-1;
     3889         matrix P=primary_charp_without_random(A,1);
     3890         print(P);
     3891}
     3892
     3893proc primary_invariants_random (list #)
     3894USAGE:   primary_invariants_random(G1,G2,...,r[,flags]);
     3895         G1,G2,...: <matrices> generating a finite matrix group, r: an <int>
     3896         where -|r| to |r| is the range of coefficients of the random
     3897         combinations of bases elements, flags: an optional <intvec> with three
     3898         entries, if the first one equals 0 (also the default), the programme
     3899         attempts to compute the Molien series and Reynolds operator, if it
     3900         equals 1, the programme is told that the Molien series should not be
     3901         computed, if it equals -1 characteristic 0 is simulated, i.e. the
     3902         Molien series is computed as if the base field were characteristic 0
     3903         (the user must choose a field of large prime characteristic, e.g.
     3904         32003) and if the first one is anything else, it means that the
     3905         characteristic of the base field divides the group order, the second
     3906         component should give the size of intervals between canceling common
     3907         factors in the expansion of the Molien series, 0 (the default) means
     3908         only once after generating all terms, in prime characteristic also a
     3909         negative number can be given to indicate that common factors should
     3910         always be canceled when the expansion is simple (the root of the
     3911         extension field does not occur among the coefficients)
     3912DISPLAY: information about the various stages of the programme if the third
     3913         flag does not equal 0
     3914RETURN:  primary invariants (type <matrix>) of the invariant ring and if
     3915         computable Reynolds operator (type <matrix>) and Molien series (type
     3916         <matrix>), if the first flag is 1 and we are in the non-modular case
     3917         then an <intvec> is returned giving some of the degrees where no
     3918         non-trivial homogeneous invariants can be found
     3919EXAMPLE: example primary_invariants_random; shows an example
     3920THEORY:  Bases of homogeneous invariants are generated successively and random
     3921         linear combinations are chosen as primary invariants that lower the
     3922         dimension of the ideal generated by the previously found invariants
     3923         (see paper "Generating a Noetherian Normalization of the Invariant Ring
     3924         of a Finite Group" by Decker, Heydtmann, Schreyer (1997) to appear in
     3925         JSC).
     3926{
     3927 // ----------------- checking input and setting flags ------------------------
     3928  if (size(#)<2)
     3929  { "ERROR:   There are too few parameters.";
     3930    return();
     3931  }
     3932  int ch=char(basering);               // the algorithms depend very much on the
     3933                                       // characteristic of the ground field
     3934  int n=nvars(basering);               // n is the number of variables, as well
     3935                                       // as the size of the matrices, as well
     3936                                       // as the number of primary invariants,
     3937                                       // we should get
     3938  int gen_num;
     3939  int mol_flag,v;
     3940  if (typeof(#[size(#)])=="intvec" && typeof(#[size(#)-1])=="int")
     3941  { if (size(#[size(#)])<>3)
     3942    { "ERROR:   <intvec> should have three entries.";
     3943      return();
     3944    }
     3945    gen_num=size(#)-2;
     3946    mol_flag=#[size(#)][1];
     3947    if (#[size(#)][2]<0 && (ch==0 or (ch<>0 && mol_flag<>0)))
     3948    { "ERROR:   the second component of <intvec> should be >=0";
     3949      return();
     3950    }
     3951    int interval=#[size(#)][2];
     3952    v=#[size(#)][3];
     3953    int max=#[size(#)-1];
     3954    if (gen_num==0)
     3955    { "ERROR:   There are no generators of a finite matrix group given.";
     3956      return();
     3957    }
     3958  }
     3959  else
     3960  { if (typeof(#[size(#)])=="int")
     3961    { gen_num=size(#)-1;
     3962      mol_flag=0;
     3963      int interval=0;
     3964      v=0;
     3965      int max=#[size(#)];
     3966    }
     3967    else
     3968    { "ERROR:   If the two last parameters are not <int> and <intvec>, the last";
     3969      "         parameter should be an <int>.";
     3970      return();
     3971    }
     3972  }
     3973  for (int i=1;i<=gen_num;i=i+1)
     3974  { if (typeof(#[i])=="matrix")
     3975    { if (nrows(#[i])<>n or ncols(#[i])<>n)
     3976      { "ERROR:   The number of variables of the base ring needs to be the same";
     3977        "         as the dimension of the square matrices";
     3978        return();
     3979      }
     3980    }
     3981    else
     3982    { "ERROR:   The first parameters should be a list of matrices";
     3983      return();
     3984    }
     3985  }
     3986 //----------------------------------------------------------------------------
     3987  if (mol_flag==0)
     3988  { if (ch==0)
     3989    { matrix REY,M=reynolds_molien(#[1..gen_num],intvec(0,interval,v));
     3990                                       // one will contain Reynolds operator and
     3991                                       // the other enumerator and denominator
     3992                                       // of Molien series
     3993      matrix P=primary_char0_random(REY,M,max,v);
     3994      return(P,REY,M);
     3995    }
     3996    else
     3997    { list L=group_reynolds(#[1..gen_num],v);
     3998      if (L[1]<>0)                     // testing whether we are in the modular
     3999      { string newring="aksldfalkdsflkj"; // case
     4000        if (minpoly==0)
     4001        { if (v)
     4002          { "  We are dealing with the non-modular case.";
     4003          }
     4004          molien(L[2..size(L)],newring,intvec(0,interval,v));
     4005          matrix P=primary_charp_random(L[1],newring,max,v);
     4006          return(P,L[1],newring);
     4007        }
     4008        else
     4009        { if (v)
     4010          { "  Since it is impossible for this programme to calculate the Molien series for";
     4011            "  invariant rings over extension fields of prime characteristic, we have to";
     4012            "  continue without it.";
     4013            "";
     4014
     4015          }
     4016          list l=primary_charp_no_molien_random(L[1],max,v);
     4017          if (size(l)==2)
     4018          { return(l[1],L[1],l[2]);
     4019          }
     4020          else
     4021          { return(l[1],L[1]);
     4022          }
     4023        }
     4024      }
     4025      else                             // the modular case
     4026      { if (v)
     4027        { "  There is also no Molien series, we can make use of...";
     4028          "";
     4029          "  We can start looking for primary invariants...";
     4030          "";
     4031        }
     4032        return(primary_charp_without_random(#[1..gen_num],max,v));
     4033      }
     4034    }
     4035  }
     4036  if (mol_flag==1)                     // the user wants no calculation of the
     4037  { list L=group_reynolds(#[1..gen_num],v); // Molien series
     4038    if (ch==0)
     4039    { list l=primary_char0_no_molien_random(L[1],max,v);
     4040      if (size(l)==2)
     4041      { return(l[1],L[1],l[2]);
     4042      }
     4043      else
     4044      { return(l[1],L[1]);
     4045      }
     4046    }
     4047    else
     4048    { if (L[1]<>0)                     // testing whether we are in the modular
     4049      { list l=primary_charp_no_molien_random(L[1],max,v); // case
     4050        if (size(l)==2)
     4051        { return(l[1],L[1],l[2]);
     4052        }
     4053        else
     4054        { return(l[1],L[1]);
     4055        }
     4056      }
     4057      else                             // the modular case
     4058      { if (v)
     4059        { "  We can start looking for primary invariants...";
     4060          "";
     4061        }
     4062        return(primary_charp_without_random(#[1..gen_num],max,v));
     4063      }
     4064    }
     4065  }
     4066  if (mol_flag==-1)
     4067  { if (ch==0)
     4068    { "ERROR:   Characteristic 0 can only be simulated in characteristic p>>0.";
     4069      return();
     4070    }
     4071    list L=group_reynolds(#[1..gen_num],v);
     4072    string newring="aksldfalkdsflkj";
     4073    molien(L[2..size(L)],newring,intvec(1,interval,v));
     4074    matrix P=primary_charp_random(L[1],newring,max,v);
     4075    return(P,L[1],newring);
     4076  }
     4077  else                                 // the user specified that the
     4078  { if (ch==0)                         // characteristic divides the group order
     4079    { "ERROR:   The characteristic cannot divide the group order when it is 0.";
     4080      return();
     4081    }
     4082    if (v)
     4083    { "";
     4084    }
     4085    return(primary_charp_without_random(#[1..gen_num],max,v));
     4086  }
     4087}
     4088example
     4089{ "EXAMPLE: Sturmfels: Algorithms in Invariant Theory 2.3.7:";
     4090  echo=2;
     4091         ring R=0,(x,y,z),dp;
     4092         matrix A[3][3]=0,1,0,-1,0,0,0,0,-1;
     4093         list L=primary_invariants_random(A,1);
     4094         print(L[1]);
     4095}
     4096
     4097proc concat_intmat(intmat A,intmat B)
     4098{ int n=nrows(A);
     4099  int m1=ncols(A);
     4100  int m2=ncols(B);
     4101  intmat C[n][m1+m2];
     4102  C[1..n,1..m1]=A[1..n,1..m1];
     4103  C[1..n,m1+1..m1+m2]=B[1..n,1..m2];
     4104  return(C);
     4105}
     4106
     4107proc power_products(intvec deg_vec,int d)
     4108USAGE:   power_products(dv,d);
     4109         dv: an <intvec> giving the degrees of homogeneous polynomials, d: the
     4110         degree of the desired power products
     4111RETURN:  a size(dv)*m <intmat> where each column ought to be interpreted as
     4112         containing the exponents of the corresponding polynomials. The product
     4113         of the powers is then homogeneous of degree d.
     4114EXAMPLE: example power_products; gives an example
     4115{ if (d<=0)
     4116  { "ERROR:   The <int> may not be <= 0";
     4117    return();
     4118  }
     4119  int d_neu,j,nc;
     4120  int s=size(deg_vec);
     4121  intmat PP[s][1];
     4122  intmat TEST[s][1];
     4123  for (int i=1;i<=s;i=i+1)
     4124  { if (i<0)
     4125    { "ERROR:   The entries of <intvec> may not be <= 0";
     4126      return();
     4127    }
     4128    d_neu=d-deg_vec[i];
     4129    if (d_neu>0)
     4130    { intmat PPd_neu=power_products(intvec(deg_vec[i..s]),d_neu);
     4131      if (size(ideal(PPd_neu))<>0)
     4132      { nc=ncols(PPd_neu);
     4133        intmat PPd_neu_gross[s][nc];
     4134        PPd_neu_gross[i..s,1..nc]=PPd_neu[1..s-i+1,1..nc];
     4135        for (j=1;j<=nc;j=j+1)
     4136        { PPd_neu_gross[i,j]=PPd_neu_gross[i,j]+1;
     4137        }
     4138        PP=concat_intmat(PP,PPd_neu_gross);
     4139        kill PPd_neu_gross;
     4140      }
     4141      kill PPd_neu;
     4142    }
     4143    if (d_neu==0)
     4144    { intmat PPd_neu[s][1];
     4145      PPd_neu[i,1]=1;
     4146      PP=concat_intmat(PP,PPd_neu);
     4147      kill PPd_neu;
     4148    }
     4149  }
     4150  if (matrix(PP)<>matrix(TEST))
     4151  { PP=compress(PP);
     4152  }
     4153  return(PP);
     4154}
     4155example
     4156{ echo=2;
     4157         intvec dv=5,5,5,10,10;
     4158         print(power_products(dv,10));
     4159         print(power_products(dv,7));
     4160}
     4161
     4162proc secondary_char0 (matrix P, matrix REY, matrix M, list #)
     4163USAGE:   secondary_char0(P,REY,M[,v]);
     4164         P: a 1xn <matrix> with primary invariants, REY: a gxn <matrix>
     4165         representing the Reynolds operator, M: a 1x2 <matrix> giving enumerator
     4166         and denominator of the Molien series, v: an optional <int>
     4167ASSUME:  n is the number of variables of the basering, g the size of the group,
     4168         REY is the 1st return value of group_reynolds(), reynolds_molien() or
     4169         the second one of primary_invariants(), M the return value of molien()
     4170         or the second one of reynolds_molien() or the third one of
     4171         primary_invariants()
     4172RETURN:  secondary invariants of the invariant ring (type <matrix>) and
     4173         irreducible secondary invariants (type <matrix>)
     4174DISPLAY: information if v does not equal 0
     4175EXAMPLE: example secondary_char0; shows an example
     4176THEORY:  The secondary invariants are calculated by finding a basis (in terms of
     4177         monomials) of the basering modulo the primary invariants, mapping those
     4178         to invariants with the Reynolds operator and using these images or
     4179         their power products such that they are linearly independent modulo the
     4180         primary invariants (see paper "Some Algorithms in Invariant Theory of
     4181         Finite Groups" by Kemper and Steel (1997)).
    11354182{ def br=basering;
    1136   int n=nvars(br);
    1137   int d=1;
    1138   int r=size(#)-#[size(#)]-1;
    1139   for (int i=r+1;i<size(#);i=i+1)
    1140   { ideal B(i-r)=#[i];                 // rewriting the bases
    1141   }
    1142   for (i=1;i<=n;i=i+1)
    1143   { d=d*deg(P[i]);                     // building the product of the degrees of
    1144   }                                    // primary invariants -
    1145   int bound=d div g;                   // number of secondary invariants
     4183  degBound=0;
     4184 //----------------- checking input and setting verbose mode ------------------
     4185  if (char(br)<>0)
     4186  { "ERROR:   secondary_char0 should only be used with rings of characteristic 0.";
     4187    return();
     4188  }
     4189  int i;
     4190  if (size(#)>0)
     4191  { if (typeof(#[size(#)])=="int")
     4192    { int v=#[size(#)];
     4193    }
     4194    else
     4195    { int v=0;
     4196    }
     4197  }
     4198  else
     4199  { int v=0;
     4200  }
     4201  int n=nvars(br);                     // n is the number of variables, as well
     4202                                       // as the size of the matrices, as well
     4203                                       // as the number of primary invariants,
     4204                                       // we should get
     4205  if (ncols(P)<>n)
     4206  { "ERROR:   The first parameter ought to be the matrix of the primary";
     4207    "         invariants."
     4208    return();
     4209  }
     4210  if (ncols(REY)<>n)
     4211  { "ERROR:   The second parameter ought to be the Reynolds operator."
     4212    return();
     4213  }
     4214  if (ncols(M)<>2 or nrows(M)<>1)
     4215  { "ERROR:   The third parameter ought to be the Molien series."
     4216    return();
     4217  }
     4218  if (v && voice==2)
     4219  { "";
     4220  }
     4221  int j, m, counter;
     4222 //- finding the polynomial giving number and degrees of secondary invariants -
     4223  poly p=1;
     4224  for (j=1;j<=n;j=j+1)                 // calculating the denominator of the
     4225  { p=p*(1-var(1)^deg(P[j]));          // Hilbert series of the ring generated
     4226  }                                    // by the primary invariants -
     4227  matrix s[1][2]=M[1,1]*p,M[1,2];      // s is used for canceling
     4228  s=matrix(syz(ideal(s)));
     4229  p=s[2,1];                            // the polynomial telling us where to
     4230                                       // search for secondary invariants
     4231  map slead=br,ideal(0);
     4232  p=1/slead(p)*p;                      // smallest term of p needs to be 1
    11464233  if (v)
    1147   { "  The invariant ring is Cohen-Macaulay.";
    1148     "  We need to find "+string(d)+" div "+string(g)+"="+string(bound)+" secondary invariants.";
     4234  { "  Polynomial telling us where to look for secondary invariants:";
     4235    "   "+string(p);
    11494236    "";
    11504237  }
    1151   if (bound==1)                        // in this case, it is quick
    1152   { if (v)
    1153     { "  In degree 0 we have: 1";
    1154       "";
    1155       "  We're done!";
    1156       "";
    1157     }
    1158     return(matrix(1));
    1159   }
    1160   qring Qring=sP;                      // secondary invariants are linearly
    1161                                        // independent modulo the ideal generated
    1162                                        // by primary invariants -
    1163   ideal Smod;                          // stores secondary invariants modulo sP
    1164                                        // that are homogeneous of the same
    1165                                        // degree -
    1166   ideal Bmod;                          // basis of homogeneous invariants modulo
    1167                                        // sP -
    1168   ideal sSmod;                         // standard basis of Smod modulo sP
    1169   setring br;
    1170   matrix S[1][bound]=1;                // stores all secondary invariants
     4238  matrix dimmat=coeffs(p,var(1));      // dimmat will contain the number of
     4239                                       // secondary invariants, we need to find
     4240                                       // of a certain degree -
     4241  m=nrows(dimmat);                     // m-1 is the highest degree
    11714242  if (v)
    11724243  { "  In degree 0 we have: 1";
    11734244    "";
    11744245  }
    1175   int counter=1;                       // counts secondary invariants -
    1176   d=1;                                 // the degree of homogeneous invariants
    1177   int degcounter=0;                    // counts secondary invariants of degree
    1178                                        // d -
    1179   int bool=1;                          // decides when std needs to be computed
    1180   while (counter<>bound)
    1181   { if (v)
    1182     { "  Searching in degree "+string(d)+"...";
    1183     }
    1184     if (d>#[size(#)])                  // we need to compute basis of degree d
    1185     {                                  // in this case -
    1186       if (#[r])                        // in this case, we have the Reynolds
    1187       { ideal B(d)=inv_basis_rey(#[r-1],d); // operator
    1188       }
    1189       else
    1190       { ideal B(d)=inv_basis(d,#[1..r-1]);
    1191       }
    1192     }
    1193     if (B(d)[1]<>0)                    // we only need to look for secondary
    1194     { setring Qring;                   // invariants in this degre if B is not
    1195       Smod=0;                          // the zero ideal
    1196       Bmod=fetch(br,B(d));
    1197       for (i=1;i<=ncols(Bmod);i=i+1)
    1198       { if (degcounter<>0)
    1199         { if (reduce(Bmod[i],std(ideal(0)))<>0) // in this case B[i] might be
    1200           {                            // qualify as secondary invariant -
    1201             if (bool)                  // compute a standard basis only if a new
    1202             { sSmod=std(Smod);         // secondary invariant has been found in
    1203             }                          // the last run -
    1204             if (reduce(Bmod[i],sSmod)<>0) // if Bmod[i] is not contained in Smod
    1205             { counter=counter+1;       // B[i] qualifies as secondary invariant
    1206               degcounter=degcounter+1;
    1207               Smod[degcounter]=Bmod[i];
    1208               setring br;
    1209               S[1,counter]=B(d)[i];
    1210               if (v)
    1211               { "           "+string(B(d)[i]);
    1212               }
    1213               bool=1;                  // we have to compute std next time
    1214               setring Qring;
    1215               if (counter==bound)      // in this case, we're done
    1216               { break;
    1217               }
     4246 //-------------------------- initializing variables --------------------------
     4247  intmat PP;
     4248  poly pp;
     4249  int k;
     4250  intvec deg_vec;
     4251  ideal sP=std(ideal(P));
     4252  ideal TEST,B,IS;
     4253  ideal S=1;                           // 1 is the first secondary invariant -
     4254 //--------------------- generating secondary invariants ----------------------
     4255  for (i=2;i<=m;i=i+1)                 // going through dimmat -
     4256  { if (int(dimmat[i,1])<>0)           // when it is == 0 we need to find 0
     4257    {                                  // elements in the current degree (i-1)
     4258      if (v)
     4259      { "  Searching in degree "+string(i-1)+", we need to find "+string(int(dimmat[i,1]))+" invariant(s)...";
     4260      }
     4261      TEST=sP;
     4262      counter=0;                       // we'll count up to degvec[i]
     4263      if (IS[1]<>0)
     4264      { PP=power_products(deg_vec,i-1); // finding power products of irreducible
     4265      }                                // secondary invariants
     4266      if (size(ideal(PP))<>0)
     4267      { for (j=1;j<=ncols(PP);j=j+1)   // going through all the power products
     4268        { pp=1;
     4269          for (k=1;k<=nrows(PP);k=k+1)
     4270          { pp=pp*IS[1,k]^PP[k,j];
     4271          }
     4272          if (reduce(pp,TEST)<>0)
     4273          { S=S,pp;
     4274            counter=counter+1;
     4275            if (v)
     4276            { "  We find: "+string(pp);
    12184277            }
    1219             else                       // next time, we don't need to compute
    1220             { bool=0;                  // standard basis
     4278            if (int(dimmat[i,1])<>counter)
     4279            { TEST=std(TEST+ideal(NF(pp,TEST))); // should be replaced by next
     4280                                                 // line soon
     4281            // TEST=std(TEST,NF(pp,TEST));
    12214282            }
    1222           }
    1223         }
    1224         else
    1225         { if (reduce(Bmod[i],std(ideal(0)))<>0)
    1226           { Smod[1]=Bmod[i];           // here we just add Bmod[i] without
    1227             setring br;                // having to check linear independence
    1228             counter=counter+1;
    1229             degcounter=degcounter+1;
    1230             S[1,counter]=B(d)[i];
    1231             if (v)
    1232             { "  We find: "+string(B(d)[i]);
    1233             }
    1234             setring Qring;
    1235             bool=1;                    // next time, we have to compute std
    1236             if (counter==bound)
     4283            else
    12374284            { break;
    12384285            }
    … …  
    12404287        }
    12414288      }
    1242     }
    1243     if (v and degcounter<>0)
    1244     { "";
    1245     }
    1246     degcounter=0;
    1247     setring br;
    1248     d=d+1;                             // go to next degree
     4289      if (int(dimmat[i,1])<>counter)
     4290      { B=sort_of_invariant_basis(sP,REY,i-1,int(dimmat[i,1])*6); // B contains
     4291                                       // images of kbase(sP,i-1) under the
     4292                                       // Reynolds operator that are linearly
     4293                                       // independent and that don't reduce to
     4294                                       // 0 modulo sP -
     4295        if (counter==0 && ncols(B)==int(dimmat[i,1])) // then we can take all of
     4296        { S=S,B;                       // B
     4297          IS=IS+B;
     4298          if (deg_vec[1]==0)
     4299          { deg_vec=i-1;
     4300            if (v)
     4301            { "  We find: "+string(B[1]);
     4302            }
     4303            for (j=2;j<=int(dimmat[i,1]);j=j+1)
     4304            { deg_vec=deg_vec,i-1;
     4305              if (v)
     4306              { "  We find: "+string(B[j]);
     4307              }
     4308            }
     4309          }
     4310          else
     4311          { for (j=1;j<=int(dimmat[i,1]);j=j+1)
     4312            { deg_vec=deg_vec,i-1;
     4313              if (v)
     4314              { "  We find: "+string(B[j]);
     4315              }
     4316            }
     4317          }
     4318        }
     4319        else
     4320        { j=0;                         // j goes through all of B -
     4321          while (int(dimmat[i,1])<>counter) // need to find dimmat[i,1]
     4322          {                            // invariants that are linearly
     4323                                       // independent modulo TEST
     4324            j=j+1;
     4325            if (reduce(B[j],TEST)<>0)  // B[j] should be added
     4326            { S=S,B[j];
     4327              IS=IS+ideal(B[j]);
     4328              if (deg_vec[1]==0)
     4329              { deg_vec[1]=i-1;
     4330              }
     4331              else
     4332              { deg_vec=deg_vec,i-1;
     4333              }
     4334              counter=counter+1;
     4335              if (v)
     4336              { "  We find: "+string(B[j]);
     4337              }
     4338              if (int(dimmat[i,1])<>counter)
     4339              { TEST=std(TEST+ideal(NF(B[j],TEST))); // should be replaced by
     4340                                                     // next line
     4341              // TEST=std(TEST,NF(B[j],TEST));
     4342              }
     4343            }
     4344          }
     4345        }
     4346      }
     4347      if (v)
     4348      { "";
     4349      }
     4350    }
    12494351  }
    12504352  if (v)
    12514353  { "  We're done!";
    1252   }
    1253   return(S);
     4354    "";
     4355  }
     4356  return(matrix(S),matrix(IS));
     4357}
     4358example
     4359{ "EXAMPLE: Sturmfels: Algorithms in Invariant Theory 2.3.7:";
     4360  echo=2;
     4361         ring R=0,(x,y,z),dp;
     4362         matrix A[3][3]=0,1,0,-1,0,0,0,0,-1;
     4363         list L=primary_invariants(A);
     4364         matrix S,IS=secondary_char0(L[1..3]);
     4365         print(S);
     4366         print(IS);
    12544367}
    12554368
    1256 ////////////////////////////////////////////////////////////////////////////////
    1257 // inv_ring_s calculates the primary and secondary invariants of the invariant
    1258 // ring with respect to a finite matrix group G. The primary invariants generate
    1259 // an invariant subring, lets say R, and the secondary invariants generate the
    1260 // invariant ring as an R-module. If the characteristic of the base field is
    1261 // zero or prime not dividing the group order, the secondary invariants are free
    1262 // generators and we have the Hironaka decomposition of the invariant ring.
    1263 // Otherwise the secondary invariants are possible not free generators.
    1264 // The procedure is based on the algorithms given by Sturmfels in "Algorithms
    1265 // in Invariant Theory" except for the one computing secondary invariants when
    1266 // the characteristic divides the group order which is based on Kemper's
    1267 // "Calculating Invariants Rings of Finite Groups over Arbitrary Fields".
    1268 ////////////////////////////////////////////////////////////////////////////////
    1269 proc inv_ring_s (list #)
    1270   USAGE:   inv_ring_s(<generators of a finite matrix group>[,<intvec>]);
    1271            <intvec> has to contain 2 flags; if the first one equals 0, the
    1272            program attempts to compute the Molien series and Reynolds operator,
    1273            if it equals 1, the program is told that the characteristic of the
    1274            base field divides the group order, if it is anything else the Molien
    1275            series and Reynolds operator will not be computed; if the second flag
    1276            does not equal 0, information about the various stages of the program
    1277            will be printed while running
    1278   RETURNS: generators of the invariant ring with respect to the matrix group
    1279            generated by the matrices in the input; there are two return values
    1280            of type <matrix>, the first containing primary invariants and the
    1281            second secondary invariants, i.e. module generators over a Noetherian
    1282            normalization
    1283   EXAMPLE: example inv_ring_s; shows an example
     4369proc secondary_charp (matrix P, matrix REY, string ring_name, list #)
     4370USAGE:   secondary_charp(P,REY,ringname[,v]);
     4371         P: a 1xn <matrix> with primary invariants, REY: a gxn <matrix>
     4372         representing the Reynolds operator, ringname: a <string> giving the
     4373         name of a ring of characteristic 0 where the Molien series is stored,
     4374         v: an optional <int>
     4375ASSUME:  n is the number of variables of the basering, g the size of the group,
     4376         REY is the 1st return value of group_reynolds(), reynolds_molien() or
     4377         the second one of primary_invariants(), `ringname` is ring of
     4378         characteristic 0 that has been created by molien() or reynolds_molien()
     4379         or primary_invariants()
     4380RETURN:  secondary invariants of the invariant ring (type <matrix>) and
     4381         irreducible secondary invariants (type <matrix>)
     4382DISPLAY: information if v does not equal 0
     4383EXAMPLE: example secondary_charp; shows an example
     4384THEORY:  The secondary invariants are calculated by finding a basis (in terms of
     4385         monomials) of the basering modulo the primary invariants, mapping those
     4386         to invariants with the Reynolds operator and using these images or
     4387         their power products such that they are linearly independent modulo the
     4388         primary invariants (see paper "Some Algorithms in Invariant Theory of
     4389         Finite Groups" by Kemper and Steel (1997)).
    12844390{ def br=basering;
    1285   int ch=char(br);                     // the algorithms depend very much on the
    1286                                        // characteristic of the ground field
    1287   int dB=degBound;
    12884391  degBound=0;
     4392 //---------------- checking input and setting verbose mode -------------------
     4393  if (char(br)==0)
     4394  { "ERROR:   secondary_charp should only be used with rings of characteristic p>0.";
     4395    return();
     4396  }
     4397  int i;
     4398  if (size(#)>0)
     4399  { if (typeof(#[size(#)])=="int")
     4400    { int v=#[size(#)];
     4401    }
     4402    else
     4403    { int v=0;
     4404    }
     4405  }
     4406  else
     4407  { int v=0;
     4408  }
    12894409  int n=nvars(br);                     // n is the number of variables, as well
    12904410                                       // as the size of the matrices, as well
    12914411                                       // as the number of primary invariants,
    1292                                        // we have to find
    1293   if (typeof(#[size(#)])=="intvec")
    1294   { if (size(#[size(#)])<>2)
    1295     { "  ERROR:   <intvec> must have exactly two entires";
    1296       return();
    1297     }
    1298     intvec flagvec=#[size(#)];
    1299     if (flagvec[1]==0)
    1300     { if (ch==0)
    1301       { matrix R(1..2);                // one will contain Reynolds operator and
    1302                                        // the other enumerator and denominator
    1303                                        // of Molien series
    1304         R(1..2)=rey_mol(#[1..size(#)-1],flagvec[2]);
    1305       }
    1306       else
    1307       { string newring="Qa";
    1308         matrix R(1)=rey_mol(#[1..size(#)-1],newring,flagvec[2]); // will contain
    1309                                        // Reynolds operator, if Molien series
    1310       }                                // can be computed, it will be stored in
    1311                                        // the new ring Qa
    1312     }
    1313     else
    1314     { for (int i=1;i<=size(#)-1;i=i+1) // checking whether the input is ok
    1315       { if (not(typeof(#[i])=="matrix"))
    1316         { "  ERROR:   the parameters must be a list of matrices and optionally";
    1317           "           an <intvec>";
    1318           return();
    1319         }
    1320         if (n<>ncols(#[i]) || n<>nrows(#[i]))
    1321         { "  ERROR:   matrices need to be square and of the same dimensions as";
    1322           "           the number of variables of the basering";
    1323           return();
    1324         }
    1325       }
    1326       kill i;
    1327     }
    1328   }
    1329   else
    1330   { if (typeof(#[size(#)])<>"matrix")
    1331     { "  ERROR:   the parameters must be a list of matrices and optionally";
    1332       "           an <intvec>";
    1333       return();
    1334     }
    1335     if (ch==0)
    1336     { matrix R(1..2);                  // will contain Reynolds operator and
    1337                                        // enumerator and denominator of Molien
    1338                                        // series
    1339       R(1..2)=rey_mol(#[1..size(#)]);
    1340     }
    1341     else
    1342     { string newring="Qa";             // we might need as a new ring of
    1343                                        // characteristic 0 where we store the
    1344                                        // Molien series -
    1345       matrix R(1)=rey_mol(#[1..size(#)],newring); // will contain
    1346                                        // Reynolds operator
    1347     }
    1348     intvec flagvec=0,0;                // default flags, no info
    1349   }
    1350   ideal Q=0;                           // will contain the candidates for
    1351                                        // primary invariants -
    1352   if (flagvec[1]==0 && flagvec[2])
    1353   { "  We can start looking for primary invariants...";
     4412                                       // we should get
     4413  if (ncols(P)<>n)
     4414  { "ERROR:   The first parameter ought to be the matrix of the primary";
     4415    "         invariants."
     4416    return();
     4417  }
     4418  if (ncols(REY)<>n)
     4419  { "ERROR:   The second parameter ought to be the Reynolds operator."
     4420    return();
     4421  }
     4422  if (typeof(`ring_name`)<>"ring")
     4423  { "ERROR:   The <string> should give the name of the ring where the Molien."
     4424    "         series is stored.";
     4425    return();
     4426  }
     4427  if (v && voice==2)
     4428  { "";
     4429  }
     4430  int j, m, counter, d;
     4431  intvec deg_dim_vec;
     4432 //- finding the polynomial giving number and degrees of secondary invariants -
     4433  for (j=1;j<=n;j=j+1)
     4434  { deg_dim_vec[j]=deg(P[j]);
     4435  }
     4436  setring `ring_name`;
     4437  poly p=1;
     4438  for (j=1;j<=n;j=j+1)                 // calculating the denominator of the
     4439  { p=p*(1-var(1)^deg_dim_vec[j]);     // Hilbert series of the ring generated
     4440  }                                    // by the primary invariants -
     4441  matrix s[1][2]=M[1,1]*p,M[1,2];      // s is used for canceling
     4442  s=matrix(syz(ideal(s)));
     4443  p=s[2,1];                            // the polynomial telling us where to
     4444                                       // search for secondary invariants
     4445  map slead=basering,ideal(0);
     4446  p=1/slead(p)*p;                      // smallest term of p needs to be 1
     4447  if (v)
     4448  { "  Polynomial telling us where to look for secondary invariants:";
     4449    "   "+string(p);
    13544450    "";
    13554451  }
    1356   else
    1357   { if (flagvec[1] && flagvec[2])
    1358     { "";
    1359       "  We start by looking for primary invariants...";
    1360       "";
    1361     }
    1362   }
    1363   if ((ch==0 || defined(Qa)) && flagvec[1]==0) // i.e. we can use Molien series
    1364   { if (ch==0)
    1365     { poly p(1..2);                    // p(1) will be used for single terms of
    1366                                        // the partial expansion, p(2) to store
    1367       p(1..2)=part_mol(R(2),1);        // the intermediate result -
    1368       poly v1=var(1);                  // we need v1 to split off coefficients
    1369                                        // in the partial expansion of M (which
    1370                                        // is in terms of the first variable) -
    1371       poly d;                          // for splitting off the coefficient in
    1372                                        // in one term of the partial expansion,
    1373                                        // i.e. it stores the dimension of the
    1374                                        // current homogeneous subspace
    1375     }
    1376     else
    1377     { setring Qa;                      // Qa is where the Molien series is
    1378                                        // stored -
    1379       poly p(1..2);                    // p(1) will be used for single terms of
    1380                                        // the partial expansion, p(2) to store
    1381       p(1..2)=part_mol(M,1);           // the intermediate result -
    1382       poly d;                          // stores the dimension of the current
    1383                                        // homogeneous subspace
    1384       setring br;
    1385     }
    1386     int g, di, counter, i, j, bool;    // g: current degree, di: d as integer,
    1387                                        // counter: counts candidates in degree
    1388                                        // g, i,j: going through monomials of
    1389                                        // degree g, bool: indicating when the
    1390                                        // ideal generated by the candidates
    1391                                        // has dimension 0 -
    1392     ideal mon;                         // will contain monomials of degree g -
    1393     poly imRO;                         // the image of the Reynolds operator -
    1394     while(1)                           // repeat until we reach dimension 0
    1395     { if (ch==0)
    1396       { p(1..2)=part_mol(R(2),1,p(2)); // 1 term of the partial expansion -
    1397         g=deg(p(1));                   // current degree -
    1398         d=coef(p(1),v1)[2,1];          // dimension of invariant space of degree
    1399                                        // g -
    1400         di=int(d);                     // just a type cast
    1401       }
    1402       else
    1403       { setring Qa;
    1404         p(1..2)=part_mol(M,1,p(2));    // 1 term of the partial expansion -
    1405         g=deg(p(1));                   // current degree -
    1406         d=coef(p(1),x)[2,1];           // dimension of invariant space of degree
    1407                                        // g -
    1408         di=int(d);                     // just a type cast
    1409         setring br;
    1410       }
    1411       if (flagvec[2])
    1412       { "  Searching for candidates in degree "+string(g)+":";
    1413         "  There is/are "+string(di)+" linearly independent invariant(s) to choose from...";
    1414       }
    1415       mon=sort(maxideal(g))[1];        // all monomials of degree g -
    1416       j=ncols(mon);
    1417       counter=0;                       // we have 0 candidates of degree g so
    1418                                        // far
    1419       for (i=j;i>=1;i=i-1)
    1420       { imRO=eval_rey(R(1),mon[i]);
    1421         if (imRO<>0)
    1422         { if (Q[1]==0)                 // if imRO is the first non-zero
    1423           { counter=1;                 // invariant we find, the rad_con
    1424             Q[1]=imRO/leadcoef(imRO);  // question is trivial and we just
    1425             if (flagvec[2])            // include imRO
    1426             { "  Found: "+string(Q[1]);
     4452  matrix dimmat=coeffs(p,var(1));      // dimmat will contain the number of
     4453                                       // secondary invariants, we need to find
     4454                                       // of a certain degree -
     4455  m=nrows(dimmat);                     // m-1 is the highest degree
     4456  deg_dim_vec=1;
     4457  for (j=2;j<=m;j=j+1)
     4458  { deg_dim_vec=deg_dim_vec,int(dimmat[j,1]);
     4459  }
     4460  if (v)
     4461  { "  In degree 0 we have: 1";
     4462    "";
     4463  }
     4464 //------------------------ initializing variables ----------------------------
     4465  setring br;
     4466  intmat PP;
     4467  poly pp;
     4468  int k;
     4469  intvec deg_vec;
     4470  ideal sP=std(ideal(P));
     4471  ideal TEST,B,IS;
     4472  ideal S=1;                           // 1 is the first secondary invariant
     4473 //------------------- generating secondary invariants ------------------------
     4474  for (i=2;i<=m;i=i+1)                 // going through deg_dim_vec -
     4475  { if (deg_dim_vec[i]<>0)             // when it is == 0 we need to find 0
     4476    {                                  // elements in the current degree (i-1)
     4477      if (v)
     4478      { "  Searching in degree "+string(i-1)+", we need to find "+string(deg_dim_vec[i])+" invariant(s)...";
     4479      }
     4480      TEST=sP;
     4481      counter=0;                       // we'll count up to degvec[i]
     4482      if (IS[1]<>0)
     4483      { PP=power_products(deg_vec,i-1); // generating power products of
     4484      }                                // irreducible secondary invariants
     4485      if (size(ideal(PP))<>0)
     4486      { for (j=1;j<=ncols(PP);j=j+1)   // going through all of those
     4487        { pp=1;
     4488          for (k=1;k<=nrows(PP);k=k+1)
     4489          { pp=pp*IS[1,k]^PP[k,j];
     4490          }
     4491          if (reduce(pp,TEST)<>0)
     4492          { S=S,pp;
     4493            counter=counter+1;
     4494            if (v)
     4495            { "  We find: "+string(pp);
    14274496            }
    1428             if (counter==di)           // if counter is up to di==d, we can
    1429             { break;                   // leave the for-loop
     4497            if (deg_dim_vec[i]<>counter)
     4498            { TEST=std(TEST+ideal(NF(pp,TEST))); // should be soon replaced by
     4499                                                 // next line
     4500            // TEST=std(TEST,NF(pp,TEST));
     4501            }
     4502            else
     4503            { break;
     4504            }
     4505          }
     4506        }
     4507      }
     4508      if (deg_dim_vec[i]<>counter)
     4509      { B=sort_of_invariant_basis(sP,REY,i-1,deg_dim_vec[i]*6); // B contains
     4510                                       // images of kbase(sP,i-1) under the
     4511                                       // Reynolds operator that are linearly
     4512                                       // independent and that don't reduce to
     4513                                       // 0 modulo sP -
     4514        if (counter==0 && ncols(B)==deg_dim_vec[i]) // then we can add all of B
     4515        { S=S,B;
     4516          IS=IS+B;
     4517          if (deg_vec[1]==0)
     4518          { deg_vec=i-1;
     4519            if (v)
     4520            { "  We find: "+string(B[1]);
     4521            }
     4522            for (j=2;j<=deg_dim_vec[i];j=j+1)
     4523            { deg_vec=deg_vec,i-1;
     4524              if (v)
     4525              { "  We find: "+string(B[j]);
     4526              }
    14304527            }
    14314528          }
    14324529          else
    1433           { if (not(rad_con(imRO,Q)))  // if imRO is not contained in the
    1434             { counter=counter+1;       // radical of Q, we add it to the
    1435               Q=Q,imRO/leadcoef(imRO); // generators of Q
    1436               if (flagvec[2])
    1437               { "  Found: "+string(Q[ncols(Q)]);
    1438               }
    1439             }
    1440               if (ncols(Q)>=n)         // when we have n or more candidates, we
    1441               { attrib(Q,"isSB",1);    // test if dim(Q)==0, Singular might
    1442               if (dim(Q)==0)           // recognize this property even if Q is
    1443               { bool=1;                // no standard basis, but that is not
    1444                 break;                 // guaranteed -
    1445               }                        // if dim(Q) is 0, we can construct a
    1446               else                     // set of primary invariants from the
    1447               { if (dim(std(Q))==0)    // generators of Q and we can leave both
    1448                 { bool=1;              // the for- and the while-loop
    1449                   break;
    1450                 }
    1451               }
    1452               }
    1453             if (counter==di)           // if counter is up to di, we can leave
    1454             { break;                   // the for-loop
    1455             }
    1456           }
    1457         }
    1458       }
    1459       if (n==1 or bool)                // if n=1, we're done when we've found
    1460       { break;                         // the first
    1461       }
    1462     }
    1463     if (flagvec[2])
    1464     { "";
    1465     }
    1466     int m=ncols(Q);                    // m tells us if we found too many
    1467                                        // candidates -
    1468     ideal P=Q;                         // will eventually contain the primary
    1469                                        // invariants -
    1470     if (n<m)                           // the number of primary invariants
    1471     { counter=m;                       // should be the same as the number of
    1472       for (i=m-1;i>=1;i=i-1)           // variables in the basering; we are
    1473       {                                // checking whether we can leave out some
    1474         Q[i]=0;                        // candidates and still have full
    1475                                        // radical -
    1476         attrib(Q,"isSB",1);
    1477         if (dim(Q)==0)                 // we're going backwards through the
    1478         { P[i]=0;                      // candidates to throw out large degrees
    1479           counter=counter-1;
    1480         }
    1481         else
    1482         { if (dim(std(Q))==0)
    1483           { P[i]=0;
    1484             counter=counter-1;
    1485           }
    1486         }
    1487         if (counter==n)
    1488         { break;
    1489         }
    1490         Q=P;
    1491       }
    1492       P=compress(P);
    1493       m=counter;
    1494       if (m==n)
    1495       { Q=std(P);                      // standard basis for computing secondary
    1496                                        // invariants
    1497       }
    1498     }
    1499     else                               // we need the standard basis of P to be
    1500     { Q=std(P);                        // able to do calculations modulo primary
    1501     }                                  // invariants
    1502     intvec degvec;
    1503     if (n<m)
    1504     { if (flagvec[2] and ch==0)
    1505       { "  We have too many candidates for primary invariants and have to find a";
    1506         "  Noetherian normalization.";
    1507         "";
    1508       }
    1509       if (ch<>0)
    1510       { "  We have too many candidates for primary invariants and have to attempt";
    1511         "  to construct a Noetherian normalization as linear combinations of powers";
    1512         "  of the candidates. Careful! Termination is not guaranteed!";
    1513         "";
    1514       }
    1515       P,p(1)=noethernorm(P);           // p(1) is the denominator of the Hilbert
    1516                                        // series with respect to primary
    1517                                        // invariants from P -
    1518       Q=std(P);                        // we need to do calculations modulo
    1519                                        // primary invariants -
    1520       for (j=1;j<=n;j=j+1)             // we set the leading coefficients of the
    1521       { P[j]=P[j]/leadcoef(P[j]);      // primary invariants to 1
    1522       }
    1523     }
    1524     else                               // this is when m==n without Noetherian
    1525     {                                  // normalization
    1526       if (ch==0)
    1527       { p(1)=1;
    1528         for (j=1;j<=n;j=j+1)           // calculating the denominator of the
    1529         { p(1)=p(1)*(1-v1^deg(P[j]));  // Hilbert series of the ring generated
    1530         }                              // by the primary invariants
    1531       }
    1532       else
    1533       { for (j=1;j<=n;j=j+1)           // degrees have to be taken in a ring
    1534         { degvec[j]=deg(P[j]);         // of characteristic 0
    1535           }
    1536         setring Qa;
    1537         p(1)=1;
    1538           for (j=1;j<=n;j=j+1)         // calculating the denominator of the
    1539           { p(1)=p(1)*(1-x^degvec[j]); // Hilbert series of the ring
    1540           }                            // generated by the primary invariants
    1541           setring br;
    1542       }
    1543     }
    1544     if (flagvec[2])
    1545     { "  These are the primary invariants: ";
    1546       for (i=1;i<=n;i=i+1)
    1547       { "   "+string(P[i]);
    1548       }
    1549       "";
    1550     }
    1551     if (ch==0)
    1552     { matrix s[1][2]=R(2)[1,1]*p(1),R(2)[1,2]; // used for canceling
    1553       s=matrix(syz(ideal(s)));
    1554       p(1)=s[2,1];                     // the polynomial telling us where to
    1555                                        // search for secondary invariants
    1556       map slead=br,ideal(0);
    1557       p(1)=1/slead(p(1))*p(1);         // smallest term of p(1) needs to be 1
    1558       if (flagvec[2])
    1559       { "  Polynomial telling us where to look for secondary invariants:";
    1560         "   "+string(p(1));
    1561         "";
    1562       }
    1563       matrix dimmat=coeffs(p(1),v1);   // dimmat will contain the number of
    1564                                        // secondary invariants, we need to find
    1565                                        // of a certain degree -
    1566       m=nrows(dimmat);                 // m-1 is the highest degree
    1567       degvec=0;
    1568       for (j=1;j<=m;j=j+1)
    1569       { if (dimmat[j,1]<>0)
    1570         { degvec[j]=int(dimmat[j,1]);  // degvec contains the degrees of
    1571         }                              // secondary invariants
    1572       }
    1573     }
    1574     else
    1575     { setring Qa;
    1576       matrix s[1][2]=M[1,1]*p(1),M[1,2]; // used for canceling
    1577       s=matrix(syz(ideal(s)));
    1578       p(1)=s[2,1];                     // the polynomial telling us where to
    1579                                        // search for secondary invariants
    1580       map slead=Qa,ideal(0);
    1581       p(1)=1/slead(p(1))*p(1);         // smallest term of p(1) needs to be 1
    1582       if (flagvec[2])
    1583       { "  Polynomial telling us where to look for secondary invariants:";
    1584         "   "+string(p(1));
    1585         "";
    1586       }
    1587       matrix dimmat=coeffs(p(1),x);    // dimmat will contain the number
    1588                                        // of secondary invariants, we need
    1589                                        // to find of a certain degree -
    1590       m=nrows(dimmat);                 // m-1 is the highest
    1591       degvec=0;
    1592       for (j=1;j<=m;j=j+1)
    1593       { if (dimmat[j,1]<>0)
    1594         { degvec[j]=int(dimmat[j,1]);  // degvec[j] contains the number of
    1595         }                              // secondary invariants of degree j-1
    1596       }
    1597       setring br;
    1598       kill Qa;                         // all the information needed from Qa is
    1599     }                                  // stored in dimmat -
    1600     qring Qring=Q;                     // we need to do calculations modulo the
    1601                                        // ideal generated by the primary
    1602                                        // invariants, its standard basis is
    1603                                        // stored in Q -
    1604     poly imROmod;                      // imRO reduced -
    1605     ideal Smod, sSmod;                 // secondary invariants of one degree
    1606                                        // reduced and their standard basis
    1607     setring br;
    1608     kill Q;                            // Q might be big and isn't needed
    1609                                        // anymore -
    1610     ideal S=1;                         // secondary invariants, 1 definitely is
    1611                                        // one
    1612     if (flagvec[2])
    1613     { "  Proceeding to look for secondary invariants...";
    1614       "";
    1615       "  In degree 0 we have: 1";
    1616       "";
    1617     }
    1618     bool=0;                            // indicates when std-calculation is
    1619                                        // necessary -
    1620     for (i=2;i<=m;i=i+1)               // walking through degvec -
    1621     { if (degvec[i]<>0)                // when it is == 0 we need to find 0
    1622       {                                // elements of the degree i-1
    1623         if (flagvec[2])
    1624         { "  Searching in degree "+string(i-1)+", we need to find "+string(degvec[i])+" invariant(s)...";
    1625         }
    1626         mon=sort(maxideal(i-1))[1];    // all monomials of degree i-1 -
    1627         counter=0;                     // we'll count up to degvec[i] -
    1628         j=ncols(mon);                  // we'll go through mon from the end
    1629         setring Qring;
    1630         Smod=0;
    1631         setring br;
    1632         while (degvec[i]<>counter)     // we need to find degvec[i] linearly
    1633         {                              // independent (in Qring) invariants -
    1634           imRO=eval_rey(R(1),mon[j]);  // generating invariants
    1635           setring Qring;
    1636           imROmod=fetch(br,imRO);      // reducing the invariants
    1637           if (reduce(imROmod,std(ideal(0)))<>poly(0) and counter<>0)
    1638           {                            // if the first one is true and the
    1639                                        // second false, imRO is the first
    1640                                        // secondary invariant of that degree
    1641                                        // that we want to add and we need not
    1642                                        // check linear independence
    1643             if (bool)
    1644             { sSmod=std(Smod);
    1645             }
    1646             if (reduce(imROmod,sSmod)<>0)
    1647             { Smod=Smod,imROmod;
    1648               setring br;              // we make its leading coefficient to be
    1649               imRO=imRO/leadcoef(imRO); // 1
    1650               S=S,imRO;
    1651               counter=counter+1;
    1652               if (flagvec[2])
    1653               { "           "+string(imRO);
    1654               }
    1655               bool=1;                  // next time we need to recalculate std
    1656             }
    1657             else
    1658             { bool=0;                  // std-calculation is unnecessary
    1659               setring br;
    1660             }
    1661           }
    1662           else
    1663           { if (reduce(imROmod,std(ideal(0)))<>poly(0) and counter==0)
    1664             { Smod[1]=imROmod;         // here we just add imRO(mod) without
    1665               setring br;              // having to check linear independence
    1666               imRO=imRO/leadcoef(imRO);
    1667               S=S,imRO;
    1668               counter=counter+1;
    1669               bool=1;                  // next time we need to calculate std
    1670               if (flagvec[2])
    1671               { "  We find: "+string(imRO);
    1672               }
    1673             }
    1674             else
    1675             { setring br;
    1676             }
    1677           }
    1678           j=j-1;                       // going to next monomial
    1679         }
    1680         if (flagvec[2])
    1681         { "";
    1682         }
    1683       }
    1684     }
    1685     degBound=dB;
    1686     if (flagvec[2])
    1687     { "  We're done!";
    1688       "";
    1689     }
    1690     matrix FI(1)=matrix(P);
    1691     matrix FI(2)=matrix(S);
    1692     return(FI(1..2));
    1693   }
    1694                                        // this case is entered when either the
    1695                                        // characteristic<>0 divides the group
    1696                                        // order or when the Molien series could
    1697                                        // not or has not been computed -
    1698   if (flagvec[1]==0)                   // indicates that it has been attempted
    1699   {                                    // to compute the Reynolds operator
    1700                                        // etc. -
    1701     int g=nrows(R(1));                 // order of the group -
    1702     int flag=((g%ch)==0);              // flag is 1 if the characteristic
    1703                                        // divides the order, it is 0 if it does
    1704                                        // not -
    1705     if (typeof(#[size(#)])=="intvec")  // getting a hold of the generators of
    1706     { int gennum=size(#)-1;            // the group
    1707     }
    1708     else
    1709     { int gennum=size(#);
    1710     }
    1711   }
    1712   else
    1713   { int flag=2;                        // flag is 2 if we don't know yet whether
    1714     int gennum=size(#)-1;              // the group order is divisible by the
    1715   }                                    // characteristic -
    1716   int d=1;                             // d is set to the current degree, since
    1717                                        // we know nothing about the finite
    1718                                        // matrix group (via Molien series) we
    1719                                        // have to start with degree 1 -
    1720   int counter;                         // counts candidates for primary
    1721                                        // invariants -
    1722   int i, di, bool;
    1723   while (1)
    1724   { if (flagvec[2])
    1725     { "  Searching for candidates in degree "+string(d)+":";
    1726     }
    1727     if (flag)                          // in this case we can not make use of
    1728     {                                  // the Reynolds operator -
    1729       ideal B(d)=inv_basis(d,#[1..gennum]); // we create a basis of the vector
    1730                                        // space of all invariant polynomials of
    1731     }                                  // degree d
    1732     else
    1733     {                                  // here the characteristic<>0 does not
    1734       ideal B(d)=inv_basis_rey(R(1),d); // divide the group order, i.e. the
    1735     }                                  // Reynolds operator can be used to
    1736                                        // calculate a basis of the vector space
    1737                                        // of all invariant polynomials of degree
    1738                                        // d -
    1739     di=ncols(B(d));                    // dimension of the homogeneous space -
    1740     if (B(d)[1]<>0)                    // otherwise the space is empty
    1741     { if (flagvec[2])
    1742       { "  There is/are "+string(di)+" linearly independent invariant(s) to choose from...";
    1743       }
    1744       if (counter==0)                  // we have no candidates for primary
    1745       {                                // invariants yet, i.e. don't have to
    1746         Q[1]=B(d)[1];                  // check for radical containment
    1747         if (flagvec[2])
    1748         { "  Found: "+string(Q[1]);
    1749         }
    1750         i=2;                           // proceed with the second element of
    1751         counter=1;                     // B(d)
    1752         if (n==1)
    1753         { break;
    1754         }
    1755       }
    1756       else
    1757       { i=1;                           // proceed with the first element of B(d)
    1758       }
    1759       while (i<=di)                    // goes through all polynomials in B(d) -
    1760       { if (not(rad_con(B(d)[i],Q)))   // B(d)[i] is not in the radical of Q
    1761         { counter=counter+1;
    1762           Q=Q,B(d)[i];                 // including candidate
    1763           if (flagvec[2])
    1764           { "  Found: "+string(Q[counter]);
    1765           }
    1766           if (counter>=n)
    1767           { attrib(Q,"isSB",1);
    1768             if (dim(Q)==0)
    1769             { bool=1;                  // when the dimension is 0, we're done
    1770               break;                   // but this can only be when counter>=n
    1771             }
    1772             else
    1773             { if (dim(std(Q))==0)
    1774               { bool=1;                // bool indicates whether we are done
    1775                 break;
     4530          { for (j=1;j<=deg_dim_vec[i];j=j+1)
     4531            { deg_vec=deg_vec,i-1;
     4532              if (v)
     4533              { "  We find: "+string(B[j]);
    17764534              }
    17774535            }
    17784536          }
    17794537        }
    1780         i=i+1;                         // going to next element in basis
    1781       }
    1782       if (bool)
    1783       { break;
    1784       }
    1785     }
    1786     else
    1787     { if (flagvec[2])
    1788       { "  The space is 0-dimensional.";
    1789       }
    1790     }
    1791     d=d+1;                             // up to the next degree
    1792   }
    1793   if (flagvec[2])
     4538        else
     4539        { j=0;                         // j goes through all of B -
     4540          while (deg_dim_vec[i]<>counter) // need to find deg_dim_vec[i]
     4541          {                            // invariants that are linearly
     4542                                       // independent modulo TEST
     4543            j=j+1;
     4544            if (reduce(B[j],TEST)<>0)   // B[j] should be added
     4545            { S=S,B[j];
     4546              IS=IS+ideal(B[j]);
     4547              if (deg_vec[1]==0)
     4548              { deg_vec[1]=i-1;
     4549              }
     4550              else
     4551              { deg_vec=deg_vec,i-1;
     4552              }
     4553              counter=counter+1;
     4554              if (v)
     4555              { "  We find: "+string(B[j]);
     4556              }
     4557              if (deg_dim_vec[i]<>counter)
     4558              { TEST=std(TEST+ideal(NF(B[j],TEST))); // should be soon replaced
     4559                                                     // by next line
     4560              // TEST=std(TEST,NF(B[j],TEST));
     4561              }
     4562            }
     4563          }
     4564        }
     4565      }
     4566      if (v)
     4567      { "";
     4568      }
     4569    }
     4570  }
     4571  if (v)
     4572  { "  We're done!";
     4573    "";
     4574  }
     4575  if (ring_name=="aksldfalkdsflkj")
     4576  { kill `ring_name`;
     4577  }
     4578  return(matrix(S),matrix(IS));
     4579}
     4580example
     4581{ "EXAMPLE: Sturmfels: Algorithms in Invariant Theory 2.3.7 (changed into";
     4582  "         characteristic 3)";
     4583  echo=2;
     4584         ring R=3,(x,y,z),dp;
     4585         matrix A[3][3]=0,1,0,-1,0,0,0,0,-1;
     4586         list L=primary_invariants(A);
     4587         matrix S,IS=secondary_charp(L[1..size(L)]);
     4588         print(S);
     4589         print(IS);
     4590}
     4591
     4592proc secondary_no_molien (matrix P, matrix REY, list #)
     4593USAGE:   secondary_no_molien(P,REY[,deg_vec,v]);
     4594         P: a 1xn <matrix> with primary invariants, REY: a gxn <matrix>
     4595         representing the Reynolds operator, deg_vec: an optional <intvec>
     4596         listing some degrees where no non-trivial homogeneous invariants can be
     4597         found, v: an optional <int>
     4598ASSUME:  n is the number of variables of the basering, g the size of the group,
     4599         REY is the 1st return value of group_reynolds(), reynolds_molien() or
     4600         the second one of primary_invariants(), deg_vec is the second return
     4601         value of primary_char0_no_molien(), primary_charp_no_molien(),
     4602         primary_char0_no_molien_random() or primary_charp_no_molien_random()
     4603RETURN:  secondary invariants of the invariant ring (type <matrix>)
     4604DISPLAY: information if v does not equal 0
     4605EXAMPLE: example secondary_no_molien; shows an example
     4606THEORY:  The secondary invariants are calculated by finding a basis (in terms of
     4607         monomials) of the basering modulo the primary invariants, mapping those
     4608         to invariants with the Reynolds operator and using these images as
     4609         candidates for secondary invariants.
     4610{ int i;
     4611  degBound=0;
     4612 //------------------ checking input and setting verbose ----------------------
     4613  if (size(#)==1 or size(#)==2)
     4614  { if (typeof(#[size(#)])=="int")
     4615    { if (size(#)==2)
     4616      { if (typeof(#[size(#)-1])=="intvec")
     4617        { intvec deg_vec=#[size(#)-1];
     4618        }
     4619        else
     4620        { "ERROR:   the third parameter should be an <intvec>";
     4621          return();
     4622        }
     4623      }
     4624      int v=#[size(#)];
     4625    }
     4626    else
     4627    { if (size(#)==1)
     4628      { if (typeof(#[size(#)])=="intvec")
     4629        { intvec deg_vec=#[size(#)];
     4630          int v=0;
     4631        }
     4632        else
     4633        { "ERROR:   the third parameter should be an <intvec>";
     4634          return();
     4635        }
     4636      }
     4637      else
     4638      { "ERROR:   wrong list of parameters";
     4639        return();
     4640      }
     4641    }
     4642  }
     4643  else
     4644  { if (size(#)>2)
     4645    { "ERROR:   there are too many parameters";
     4646      return();
     4647    }
     4648    int v=0;
     4649  }
     4650  int n=nvars(basering);               // n is the number of variables, as well
     4651                                       // as the size of the matrices, as well
     4652                                       // as the number of primary invariants,
     4653                                       // we should get
     4654  if (ncols(P)<>n)
     4655  { "ERROR:   The first parameter ought to be the matrix of the primary";
     4656    "         invariants."
     4657    return();
     4658  }
     4659  if (ncols(REY)<>n)
     4660  { "ERROR:   The second parameter ought to be the Reynolds operator."
     4661    return();
     4662  }
     4663  if (v && voice==2)
    17944664  { "";
    17954665  }
    1796   int j;
    1797   ideal P=Q;                           // P will contain primary invariants -
    1798   if (n<counter)                       // we have too many candidates -
    1799   { for (i=counter-1;i>=1;i=i-1)       // we take a look whether we can leave
    1800     { Q[i]=0;                          // out some candidates, but have full
    1801                                        // radical
    1802       attrib(Q,"isSB",1);
    1803       if (dim(Q)==0)                   // we're going backwards through the
    1804       { P[i]=0;                        // candidates to throw out large degrees
    1805         counter=counter-1;
     4666  int j, m, d;
     4667  int max=1;
     4668  for (j=1;j<=n;j=j+1)
     4669  { max=max*deg(P[j]);
     4670  }
     4671  max=max/nrows(REY);
     4672  if (v)
     4673  { "  We need to find "+string(max)+" secondary invariants.";
     4674    "";
     4675    "  In degree 0 we have: 1";
     4676    "";
     4677  }
     4678 //------------------------- initializing variables ---------------------------
     4679  ideal sP=std(ideal(P));
     4680  ideal B, TEST;
     4681  ideal S=1;                           // 1 is the first secondary invariant
     4682  int counter=1;
     4683  i=0;
     4684  if (defined(deg_vec)<>voice)
     4685  { intvec deg_vec;
     4686  }
     4687  int k=1;
     4688 //--------------------- generating secondary invariants ----------------------
     4689  while (counter<>max)
     4690  { i=i+1;
     4691    if (deg_vec[k]<>i)
     4692    { if (v)
     4693      { "  Searching in degree "+string(i)+"...";
     4694      }
     4695      B=sort_of_invariant_basis(sP,REY,i,max); // B contains images of
     4696                                       // kbase(sP,i) under the Reynolds
     4697                                       // operator that are linearly independent
     4698                                       // and that don't reduce to 0 modulo sP
     4699      TEST=sP;
     4700      for (j=1;j<=ncols(B);j=j+1)
     4701      {                                // that are linearly independent modulo
     4702                                       // TEST
     4703        if (reduce(B[j],TEST)<>0)      // B[j] should be added
     4704        { S=S,B[j];
     4705          counter=counter+1;
     4706          if (v)
     4707          { "  We find: "+string(B[j]);
     4708          }
     4709          if (counter==max)
     4710          { break;
     4711          }
     4712          else
     4713          { if (j<>ncols(B))
     4714            { TEST=std(TEST+ideal(NF(B[j],TEST))); // should soon be replaced by
     4715                                                   // next line
     4716            // TEST=std(TEST,NF(B[j],TEST));
     4717            }
     4718          }
     4719        }
     4720      }
     4721    }
     4722    else
     4723    { if (size(deg_vec)==k)
     4724      { k=1;
    18064725      }
    18074726      else
    1808       { if (dim(std(Q))==0)
    1809         { P[i]=0;
    1810           counter=counter-1;
    1811         }
    1812       }
    1813       if (counter==n)
    1814       { break;
    1815       }
    1816       Q=P;
    1817     }
    1818     P=compress(P);
    1819     if (counter==n)
    1820     { Q=std(P);
     4727      { k=k+1;
     4728      }
     4729    }
     4730  }
     4731  if (v)
     4732  { "";
     4733  }
     4734  if (v)
     4735  { "  We're done!";
     4736    "";
     4737  }
     4738  return(matrix(S));
     4739}
     4740example
     4741{ "EXAMPLE: Sturmfels: Algorithms in Invariant Theory 2.3.7:";
     4742  echo=2;
     4743         ring R=0,(x,y,z),dp;
     4744         matrix A[3][3]=0,1,0,-1,0,0,0,0,-1;
     4745         list L=primary_invariants(A,intvec(1,1,0));
     4746         matrix S=secondary_no_molien(L[1..3]);
     4747         print(S);
     4748}
     4749
     4750proc secondary_with_irreducible_ones_no_molien (matrix P, matrix REY, list #)
     4751USAGE:   secondary_with_irreducible_ones_no_molien(P,REY[,v]);
     4752         P: a 1xn <matrix> with primary invariants, REY: a gxn <matrix>
     4753         representing the Reynolds operator, v: an optional <int>
     4754ASSUME:  n is the number of variables of the basering, g the size of the group,
     4755         REY is the 1st return value of group_reynolds(), reynolds_molien() or
     4756         the second one of primary_invariants()
     4757RETURN:  secondary invariants of the invariant ring (type <matrix>) and
     4758         irreducible secondary invariants (type <matrix>)
     4759DISPLAY: information if v does not equal 0
     4760EXAMPLE: example secondary_with_irreducible_ones_no_molien; shows an example
     4761THEORY:  The secondary invariants are calculated by finding a basis (in terms of
     4762         monomials) of the basering modulo the primary invariants, mapping those
     4763         to invariants with the Reynolds operator and using these images or
     4764         their power products such that they are linearly independent modulo the
     4765         primary invariants (see paper "Some Algorithms in Invariant Theory of
     4766         Finite Groups" by Kemper and Steel (1997)).
     4767{ int i;
     4768  degBound=0;
     4769 //--------------------- checking input and setting verbose mode --------------
     4770  if (size(#)==1 or size(#)==2)
     4771  { if (typeof(#[size(#)])=="int")
     4772    { if (size(#)==2)
     4773      { if (typeof(#[size(#)-1])=="intvec")
     4774        { intvec deg_vec=#[size(#)-1];
     4775        }
     4776        else
     4777        { "ERROR:   the third parameter should be an <intvec>";
     4778          return();
     4779        }
     4780      }
     4781      int v=#[size(#)];
     4782    }
     4783    else
     4784    { if (size(#)==1)
     4785      { if (typeof(#[size(#)])=="intvec")
     4786        { intvec deg_vec=#[size(#)];
     4787          int v=0;
     4788        }
     4789        else
     4790        { "ERROR:   the third parameter should be an <intvec>";
     4791          return();
     4792        }
     4793      }
     4794      else
     4795      { "ERROR:   wrong list of parameters";
     4796        return();
     4797      }
    18214798    }
    18224799  }
    18234800  else
    1824   { Q=std(P);                          // we need to do calculations modulo
    1825   }                                    // primary invariants
    1826   if (n<counter)
    1827   { if (flagvec[2] and ch==0)
    1828     { "  We have too many candidates for primary invariants and have to find a";
    1829       "  Noetherian normalization.";
    1830       "";
    1831     }
    1832     if (ch<>0)
    1833     { "  We have too many candidates for primary invariants and have to attempt";
    1834       "  to construct a Noetherian normalization as linear combinations of powers";
    1835       "  of the candidates. Careful! Termination is not guaranteed!";
    1836       "";
    1837     }
    1838     P=noethernorm(P);
    1839     for (j=1;j<=n;j=j+1)               // we set the lead coefficients of the
    1840     { P[j]=P[j]/leadcoef(P[j]);        // primary invariants to be 1
    1841     }
    1842     Q=std(P);
    1843   }
    1844   if (flagvec[2])
    1845   { "  These are the primary invariants: ";
    1846     for (i=1;i<=n;i=i+1)
    1847     { "   "+string(P[i]);
    1848     }
     4801  { if (size(#)>2)
     4802    { "ERROR:   there are too many parameters";
     4803      return();
     4804    }
     4805    int v=0;
     4806  }
     4807  int n=nvars(basering);               // n is the number of variables, as well
     4808                                       // as the size of the matrices, as well
     4809                                       // as the number of primary invariants,
     4810                                       // we should get
     4811  if (ncols(P)<>n)
     4812  { "ERROR:   The first parameter ought to be the matrix of the primary";
     4813    "         invariants."
     4814    return();
     4815  }
     4816  if (ncols(REY)<>n)
     4817  { "ERROR:   The second parameter ought to be the Reynolds operator."
     4818    return();
     4819  }
     4820  if (v && voice==2)
     4821  { "";
     4822  }
     4823  int j, m, d;
     4824  int max=1;
     4825  for (j=1;j<=n;j=j+1)
     4826  { max=max*deg(P[j]);
     4827  }
     4828  max=max/nrows(REY);
     4829  if (v)
     4830  { "  We need to find "+string(max)+" secondary invariants.";
    18494831    "";
    1850     "  Proceeding to look for secondary invariants...";
    1851   }
    1852   // we can now proceed to calculate secondary invariants, we face the fact
    1853   // that we can make no use of a Molien series - however, if the
    1854   // characteristic does not divide the group order, we can make use of the
    1855   // fact that the secondary invariants are free module generators and that we
    1856   // need deg(P[1])*...*deg(P[n])/(cardinality of the group) of them
    1857   if (flagvec[1]<>0 and flagvec[1]<>1)
    1858   { int g=group(#[1..size(#)-1]);      // computing group order
    1859     if (ch==0)
    1860     { matrix FI(2)=sec_minus_mol(P,Q,g,flagvec[2],#[1..size(#)-1],0,B(1..d),d);
    1861       matrix FI(1)=matrix(P);
    1862       return(FI(1..2));
    1863     }
    1864     if (g%ch<>0)
    1865     { matrix FI(2)=sec_minus_mol(P,Q,g,flagvec[2],#[1..size(#)-1],0,B(1..d),d);
    1866       matrix FI(1)=matrix(P);
    1867       return(FI(1..2));
     4832    "  In degree 0 we have: 1";
     4833    "";
     4834  }
     4835 //------------------------ initializing variables ----------------------------
     4836  intmat PP;
     4837  poly pp;
     4838  int k;
     4839  intvec irreducible_deg_vec;
     4840  ideal sP=std(ideal(P));
     4841  ideal B,TEST,IS;
     4842  ideal S=1;                           // 1 is the first secondary invariant
     4843  int counter=1;
     4844  i=0;
     4845  if (defined(deg_vec)<>voice)
     4846  { intvec deg_vec;
     4847  }
     4848  int l=1;
     4849 //------------------- generating secondary invariants ------------------------
     4850  while (counter<>max)
     4851  { i=i+1;
     4852    if (deg_vec[l]<>i)
     4853    { if (v)
     4854      { "  Searching in degree "+string(i)+"...";
     4855      }
     4856      TEST=sP;
     4857      if (IS[1]<>0)
     4858      { PP=power_products(irreducible_deg_vec,i);  // generating all power
     4859      }                                // products of irreducible secondary
     4860                                       // invariants
     4861      if (size(ideal(PP))<>0)
     4862      { for (j=1;j<=ncols(PP);j=j+1)   // going through all those power products
     4863        { pp=1;
     4864          for (k=1;k<=nrows(PP);k=k+1)
     4865          { pp=pp*IS[1,k]^PP[k,j];
     4866          }
     4867          if (reduce(pp,TEST)<>0)
     4868          { S=S,pp;
     4869            counter=counter+1;
     4870            if (v)
     4871            { "  We find: "+string(pp);
     4872            }
     4873            if (counter<>max)
     4874            { TEST=std(TEST+ideal(NF(pp,TEST))); // should soon be replaced by
     4875                                                 // next line
     4876            // TEST=std(TEST,NF(pp,TEST));
     4877            }
     4878            else
     4879            { break;
     4880            }
     4881          }
     4882        }
     4883      }
     4884      if (max<>counter)
     4885      { B=sort_of_invariant_basis(sP,REY,i,max); // B contains images of
     4886                                       // kbase(sP,i) under the Reynolds
     4887                                       // operator that are linearly independent
     4888                                       // and that don't reduce to 0 modulo sP
     4889        for (j=1;j<=ncols(B);j=j+1)
     4890        { if (reduce(B[j],TEST)<>0)    // B[j] should be added
     4891          { S=S,B[j];
     4892            IS=IS+ideal(B[j]);
     4893            if (irreducible_deg_vec[1]==0)
     4894            { irreducible_deg_vec[1]=i;
     4895            }
     4896            else
     4897            { irreducible_deg_vec=irreducible_deg_vec,i;
     4898            }
     4899            counter=counter+1;
     4900            if (v)
     4901            { "  We find: "+string(B[j]);
     4902            }
     4903            if (counter==max)
     4904            { break;
     4905            }
     4906            else
     4907            { if (j<>ncols(B))
     4908              { TEST=std(TEST+ideal(NF(B[j],TEST))); // should soon be replaced
     4909                                                     // by next line
     4910              // TEST=std(TEST,NF(B[j],TEST));
     4911              }
     4912            }
     4913          }
     4914        }
     4915      }
     4916    }
     4917    else
     4918    { if (size(deg_vec)==l)
     4919      { l=1;
     4920      }
     4921      else
     4922      { l=l+1;
     4923      }
     4924    }
     4925  }
     4926  if (v)
     4927  { "";
     4928  }
     4929  if (v)
     4930  { "  We're done!";
     4931    "";
     4932  }
     4933  return(matrix(S),matrix(IS));
     4934}
     4935example
     4936{ "EXAMPLE: Sturmfels: Algorithms in Invariant Theory 2.3.7:";
     4937  echo=2;
     4938         ring R=0,(x,y,z),dp;
     4939         matrix A[3][3]=0,1,0,-1,0,0,0,0,-1;
     4940         list L=primary_invariants(A,intvec(1,1,0));
     4941         matrix S,IS=secondary_with_irreducible_ones_no_molien(L[1..2]);
     4942         print(S);
     4943         print(IS);
     4944}
     4945
     4946proc secondary_not_cohen_macaulay (matrix P, list #)
     4947USAGE:   secondary_not_cohen_macaulay(P,G1,G2,...[,v]);
     4948         P: a 1xn <matrix> with primary invariants, G1,G2,...: nxn <matrices>
     4949         generating a finite matrix group, v: an optional <int>
     4950ASSUME:  n is the number of variables of the basering
     4951RETURN:  secondary invariants of the invariant ring (type <matrix>)
     4952DISPLAY: information if v does not equal 0
     4953EXAMPLE: example secondary_not_cohen_macaulay; shows an example
     4954THEORY:  The secondary invariants are generated following "Generating Invariant
     4955         Rings of Finite Groups over Arbitrary Fields" by Kemper (1996, to
     4956         appear in JSC).
     4957{ int i, j;
     4958  degBound=0;
     4959  def br=basering;
     4960  int n=nvars(br);                     // n is the number of variables, as well
     4961                                       // as the size of the matrices, as well
     4962                                       // as the number of primary invariants,
     4963                                       // we should get -
     4964  if (size(#)>0)                       // checking input and setting verbose
     4965  { if (typeof(#[size(#)])=="int")
     4966    { int gen_num=size(#)-1;
     4967      if (gen_num==0)
     4968      { "ERROR:   There are no generators of the finite matrix group given.";
     4969        return();
     4970      }
     4971      int v=#[size(#)];
     4972      for (i=1;i<=gen_num;i=i+1)
     4973      { if (typeof(#[i])<>"matrix")
     4974        { "ERROR:   These parameters should be generators of the finite matrix group.";
     4975          return();
     4976        }
     4977        if ((n<>nrows(#[i])) or (n<>ncols(#[i])))
     4978        { "ERROR:   matrices need to be square and of the same dimensions";
     4979          return();
     4980        }
     4981      }
     4982    }
     4983    else
     4984    { int v=0;
     4985      int gen_num=size(#);
     4986      for (i=1;i<=gen_num;i=i+1)
     4987      { if (typeof(#[i])<>"matrix")
     4988        { "ERROR:   These parameters should be generators of the finite matrix group.";
     4989          return();
     4990        }
     4991        if ((n<>nrows(#[i])) or (n<>ncols(#[i])))
     4992        { "ERROR:   matrices need to be square and of the same dimensions";
     4993          return();
     4994        }
     4995      }
    18684996    }
    18694997  }
    18704998  else
    1871   { if (flag==0)                       // this is the case where we have a
    1872     {                                  // nonzero minpoly, but the
    1873                                        // characteristic does not divide the
    1874                                        // group order
    1875       matrix FI(2)=sec_minus_mol(P,Q,g,flagvec[2],R(1),1,B(1..d),d);
    1876       matrix FI(1)=matrix(P);
    1877       return(FI(1..2));
    1878     }
    1879   }
    1880   if (flagvec[2])
    1881   { "  Since the characteristic of the base field divides the group order, we do not";
    1882     "  know whether the invariant ring is Cohen-Macaulay. We have to use Kemper's";
    1883     "  algorithm and compute secondary invariants with respect to the trivial";
    1884     "  subgroup of the given group.";
    1885     "";
    1886 
    1887   }
    1888   // we are using Kemper's algorithm with the trivial subgroup
    1889   ring QQ=0,x,ds;                      // we lock at our primary invariants as
    1890   ideal M=(1-x)^n;                     // such of the subgroup that only
    1891                                        // contains the identity, this means that
     4999  { "ERROR:   There are no generators of the finite matrix group given.";
     5000    return();
     5001  }
     5002  if (ncols(P)<>n)
     5003  { "ERROR:   The first parameter ought to be the matrix of the primary";
     5004    "         invariants."
     5005    return();
     5006  }
     5007  if (v && voice==2)
     5008  { "";
     5009  }
     5010  ring alskdfalkdsj=0,x,dp;
     5011  matrix M[1][2]=1,(1-x)^n;            // we look at our primary invariants as
     5012  export alskdfalkdsj;
     5013  export M;
     5014  setring br;                          // such of the subgroup that only
     5015  matrix REY=matrix(maxideal(1));      // contains the identity, this means that
    18925016                                       // ch does not divide the order anymore,
    18935017                                       // this means that we can make use of the
    1894                                        // Molien series again - 1/M[1] is the
    1895                                        // Molien series of that group, we now
    1896                                        // calculate the secondary invariants of
    1897                                        // this subgroup in the usual fashion
     5018                                       // Molien series again - M[1,1]/M[1,2] is
     5019                                       // the Molien series of that group, we
     5020                                       // now calculate the secondary invariants
     5021                                       // of this subgroup in the usual fashion
    18985022                                       // where the primary invariants are the
    18995023                                       // ones from the bigger group
    1900   setring br;
    1901   intvec degvec;                       // for the degrees of the primary
    1902                                        // invariants -
    1903   for (i=1;i<=n;i=i+1)                 // finding the degrees of these
    1904   { degvec[i]=deg(P[i]);
    1905   }
    1906   setring QQ;                          // calculating the polynomial indicating
    1907   M[2]=1;                              // where to search for secondary
    1908   for (i=1;i<=n;i=i+1)                 // invariants (of the trivial subgroup)
    1909   { M[2]=M[2]*(1-x^degvec[i]);
    1910   }
    1911   M=matrix(syz(M))[1,1];
    1912   M[1]=M[1]/leadcoef(M[1]);
    1913   if (flagvec[2])
    1914   { "  Polynomial telling us where to look for these secondary invariants:";
    1915     "   "+string(M[1]);
     5024  if (v)
     5025  { "  The procedure secondary_charp() is called to calculate secondary invariants";
     5026    "  of the invariant ring of the trivial group with respect to the primary";
     5027    "  invariants found previously.";
    19165028    "";
    19175029  }
    1918   matrix dimmat=coeffs(M[1],x);        // storing the number of secondary
    1919                                        // invariants we need in a certain
    1920                                        // degree -
    1921   int m=nrows(dimmat);                 // m-1 is the highest degree where we
    1922                                        // need to search
    1923   degvec=0;
    1924   for (i=1;i<=m;i=i+1)                 // degvec will contain all the
    1925   { if (dimmat[i,1]<>0)                // information about where to find
    1926     { degvec[i]=int(dimmat[i,1]);      // secondary invariants, it is filled
    1927     }                                  // with integers and therefore visible in
    1928   }                                    // all rings
    1929   kill QQ;
    1930   setring br;
    1931   ideal S=1;                           // 1 is a secondary invariant always -
    1932   if (flagvec[2])
    1933   { "  In degree 0 we have: 1";
    1934     "";
    1935   }
    1936   ideal B;                             // basis of homogeneous invariants of a
    1937                                        // certain degree with respect to the
    1938                                        // trivial subgroup - i.e. all monomials
    1939                                        // of that degree -
    1940   qring Qring=Q;                       // need to do computations modulo primary
    1941                                        // invariants -
    1942   ideal Smod, sSmod, Bmod;             // Smod: secondary invariants of one
    1943                                        // degree modulo Q, sSmod: standard basis
    1944                                        // of the latter, Bmod: B modulo Q
    1945   setring br;
    1946   kill Q;                              // might be large
    1947   int k;
    1948   bool=0;                              // indicates when we need to do standard
    1949                                        // basis computation -
    1950   for (i=2;i<=m;i=i+1)                 // going through all entries of degvec
    1951   { if (degvec[i]<>0)
    1952     { B=sort(maxideal(i-1))[1];        // basis of the space of invariants (with
    1953                                        // respect to the matrix subgroup
    1954                                        // containing only the identity) of
    1955                                        // degree i-1 -
    1956       if (flagvec[2])
    1957       { "  Searching in degree "+string(i-1)+", we need to find "+string(degvec[i])+" invariant(s)...";
    1958       }
    1959       counter=0;                       // we have 0 secondary invariants of
    1960                                        // degree i-1
    1961       setring Qring;
    1962       Bmod=fetch(br,B);                // basis modulo primary invariants
    1963       Smod=0;
    1964       j=ncols(Bmod);                   // going backwards through Bmod
    1965       while (degvec[i]<>counter)
    1966       { if (reduce(Bmod[j],std(ideal(0)))<>0 && counter<>0)
    1967         { if (bool)
    1968           { sSmod=std(Smod);
    1969           }
    1970           if (reduce(Bmod[j],sSmod)<>0) // Bmod[j] qualifies as secondary
    1971           { Smod=Smod,Bmod[j];         // invariant
    1972             setring br;
    1973             S=S,B[j];
    1974             counter=counter+1;
    1975             if (flagvec[2])
    1976             { "           "+string(B[j]);
    1977             }
    1978             setring Qring;
    1979             bool=1;                    // need to calculate std of Smod next
    1980           }                            // time
    1981           else
    1982           { bool=0;                    // no std calculation necessary
    1983           }
    1984         }
    1985         else
    1986         { if (reduce(Bmod[j],std(ideal(0)))<>0 && counter==0)
    1987           { Smod[1]=Bmod[j];           // in this case, we may just add B[j]
    1988             setring br;
    1989             S=S,B[j];
    1990             if (flagvec[2])
    1991             { "  We find: "+string(B[j]);
    1992             }
    1993             counter=counter+1;
    1994             bool=1;                    // need to calculate std of Smod next
    1995             setring Qring;             // time
    1996           }
    1997         }
    1998         j=j-1;                         // next basis element
    1999       }
    2000       setring br;
    2001     }
    2002   }
     5030  matrix trivialS=secondary_charp(P,REY,"alskdfalkdsj",v);
     5031  kill alskdfalkdsj;
    20035032  // now we have those secondary invariants
    2004   k=ncols(S);                          // k: number of the secondary invariants,
    2005                                        // we just calculated
    2006   if (flagvec[2])
    2007   { "";
    2008     "  We calculate secondary invariants from the ones found for the trivial";
     5033  int k=ncols(trivialS);               // k is the number of the secondary
     5034                                       // invariants, we just calculated
     5035  if (v)
     5036  { "  We calculate secondary invariants from the ones found for the trivial";
    20095037    "  subgroup.";
    20105038    "";
    … …  
    20135041                                       // secondary invariants with respect to
    20145042                                       // the trivial group -
    2015   matrix M(1)[gennum][k];              // M(1) will contain a module
    2016   for (i=1;i<=gennum;i=i+1)
    2017   { B=ideal(matrix(maxideal(1))*transpose(#[i])); // image of the various
     5043  matrix M(1)[gen_num][k];             // M(1) will contain a module
     5044  ideal B;
     5045  for (i=1;i<=gen_num;i=i+1)
     5046  { B=ideal(matrix(maxideal(1))*transpose(#[i]));   // image of the various
    20185047                                       // variables under the i-th generator -
    20195048    f=br,B;                            // the corresponding mapping -
    2020     B=f(S)-S;                          // these relations should be 0 -
     5049    B=f(trivialS)-trivialS;            // these relations should be 0 -
    20215050    M(1)[i,1..k]=B[1..k];              // we will look for the syzygies of M(1)
    20225051  }
    20235052  module M(2)=res(M(1),2)[2];
    2024   m=ncols(M(2));                       // number of generators of the module
     5053  int m=ncols(M(2));                   // number of generators of the module
    20255054                                       // M(2) -
    2026   // the following steps calculates the intersection of the module M(2) with the
    2027   // algebra A^k where A denote the subalgebra of the usual polynomial ring,
    2028   // generated by the primary invariants
     5055  // the following steps calculates the intersection of the module M(2) with
     5056  // the algebra A^k where A denote the subalgebra of the usual polynomial
     5057  // ring, generated by the primary invariants
    20295058  string mp=string(minpoly);           // generating a ring where we can do
    20305059                                       // elimination
    2031   execute "ring R=("+charstr(br)+"),(x(1..n),y(1..n),h),dp";
     5060  execute "ring R=("+charstr(br)+"),(x(1..n),y(1..n),h),dp;";
    20325061  execute "minpoly=number("+mp+");";
    20335062  map f=br,maxideal(1);                // canonical mapping
    20345063  matrix M[k][m+k*n];
    20355064  M[1..k,1..m]=matrix(f(M(2)));        // will contain a module -
    2036   ideal P=f(P);                        // primary invariants in the new ring -
    2037   for (i=1;i<=n;i=i+1)                 // constructing a module
     5065  matrix P=f(P);                       // primary invariants in the new ring
     5066  for (i=1;i<=n;i=i+1)
    20385067  { for (j=1;j<=k;j=j+1)
    2039     { M[j,m+(i-1)*k+j]=y(i)-P[i];
     5068    { M[j,m+(i-1)*k+j]=y(i)-P[1,i];
    20405069    }
    20415070  }
    20425071  M=elim(module(M),1,n);               // eliminating x(1..n), std-calculation
    2043                                        // is done internally
     5072                                       // is done internally -
    20445073  M=homog(module(M),h);                // homogenize for 'minbase'
    20455074  M=minbase(module(M));
    20465075  setring br;
    2047   //execute "ideal v="+varstr(br)+",P,1"; // dehomogenizing -
    2048   ideal v=maxideal(1),P,1;
    2049   f=R,v;                               // replacing y(1..n) by primary
     5076  ideal substitute=maxideal(1),ideal(P),1;
     5077  f=R,substitute;                      // replacing y(1..n) by primary
    20505078                                       // invariants -
    2051   M(2)=f(M);                           // M(2) is the new module -
    2052   matrix FI(1)=matrix(P);              // getting primary invariants ready for
    2053                                        // output
     5079  M(2)=f(M);                           // M(2) is the new module
    20545080  m=ncols(M(2));
    2055   matrix FI(2)[1][m];
    2056   FI(2)=matrix(S)*matrix(M(2));        // FI(2) contains the real secondary
     5081  matrix S[1][m];
     5082  S=matrix(trivialS)*matrix(M(2));     // S now contains the secondary
    20575083                                       // invariants
    20585084  for (i=1; i<=m;i=i+1)
    2059   { FI(2)[1,i]=FI(2)[1,i]/leadcoef(FI(2)[1,i]); // making elements nice
    2060   }
    2061   FI(2)=sort(ideal(FI(2)))[1];
    2062   if (flagvec[2])
     5085  { S[1,i]=S[1,i]/leadcoef(S[1,i]); // making elements nice
     5086  }
     5087  S=sort(ideal(S))[1];
     5088  if (v)
    20635089  { "  These are the secondary invariants: ";
    20645090    for (i=1;i<=m;i=i+1)
    2065     { "   "+string(FI(2)[1,i]);
     5091    { "   "+string(S[1,i]);
    20665092    }
    20675093    "";
    … …  
    20695095    "";
    20705096  }
    2071   if ((flagvec[2] or (voice==2)) && flagvec[1]==1 && (m>1))
     5097  if ((v or (voice==2)) && (m>1))
    20725098  { "  WARNING: The invariant ring might not have a Hironaka decomposition";
    20735099    "           if the characteristic of the coefficient field divides the";
    20745100    "           group order.";
    20755101  }
    2076   else
    2077   { if ((flagvec[2] or (voice==2)) and (m>1))
    2078     { "  WARNING: The invariant ring might not have a Hironaka decomposition!";
    2079       "           This is because the characteristic of the coefficient field";
    2080       "           divides the group order.";
    2081     }
    2082   }
    2083   degBound=dB;
    2084   return(FI(1..2));
     5102  return(S);
    20855103}
    20865104example
    2087 { "  EXAMPLE: Sturmfels: Algorithms in Invariant Theory 2.3.7:";
    2088   echo=2;
    2089            ring R=0,(x,y,z),dp;
     5105{ echo=2;
     5106           ring R=2,(x,y,z),dp;
    20905107           matrix A[3][3]=0,1,0,-1,0,0,0,0,-1;
    2091            matrix B(1..2);
    2092            B(1..2)=inv_ring_s(A);
    2093            print(B(1..2));
     5108           list L=primary_invariants(A);
     5109           matrix S=secondary_not_cohen_macaulay(L[1],A);
     5110           print(S);
    20945111}
    20955112
    2096 ////////////////////////////////////////////////////////////////////////////////
    2097 // This procedure finds a linear combination of the generators in B such that it
    2098 // lowers the dimension of the ideal generated by the primary invariants found
    2099 // so far when added to the ideal. The coefficients lie in a field of
    2100 // characteristic 0.
    2101 ////////////////////////////////////////////////////////////////////////////////
    2102 proc combi (ideal B,int b,ideal P,int d)
    2103 {
    2104   intmat vec[1][b];                    // the zero vector -
    2105   matrix t[1][1];                      // the linear combination
    2106   while(1)
    2107   { vec=nextvec(vec);                  // next vector
    2108     t=vec*transpose(matrix(B));
    2109     if (d-1==dim(std(P+ideal(t[1,1])))) // indicates that it was not necessary
    2110     { return(t[1,1]);                  // to break out of the for-loop
    2111     }
    2112   }
    2113 }
    2114 
    2115 ////////////////////////////////////////////////////////////////////////////////
    2116 // This procedure trys to find a linear combination of the generators in B such
    2117 // that it lowers the dimension of the ideal generated by the primary invariants
    2118 // found so far when added to the ideal. The coefficients lie in a finite field.
    2119 // It is not clear whether such a combination exists. In the worst case, all
    2120 // possibilities are tried.
    2121 ////////////////////////////////////////////////////////////////////////////////
    2122 proc p_combi (ideal B, int b, ideal P, int di)
    2123 { def br=basering;
    2124   matrix vec(1)[1][b];                 // starting with 0-vector -
    2125   intmat new[1][b];                    // new vector in characteristic 0 -
    2126   matrix pnew[1][b];                   // new needs to be mapped into br -
    2127   int counter=1;                       // we count how many vectors we try
    2128   int i;
    2129   int p=char(br);
    2130   if (minpoly<>0)
    2131   { int d=pardeg(minpoly);             // field has p^d elements
    2132   }
    2133   else
    2134   { int d=1;                           // field has p^d elements
    2135   }
    2136   matrix t[1][1];                      // the linear combination
    2137   ring R=0,x,dp;
    2138   int bound=int((number(p)^(d*b)-1)/(number(p)^d-1)+1); // this is how many
    2139                                        // linearly independent vectors of size
    2140                                        // b exist having entries in the base
    2141                                        // field of br
    2142   setring br;
    2143   while (counter<>bound)               // otherwise, we are done
    2144   { new=nextvec(new);
    2145     for (i=1;i<=b;i=i+1)
    2146     { pnew[1,i]=intnumap(new[1,i]);    // mapping an integer into br
    2147     }
    2148     if (unique(vec(1..counter),pnew))  // checking whether we tried pnew before
    2149     { counter=counter+1;
    2150       matrix vec(counter)=pnew;        // keeping track of the ones we tried -
    2151       t=vec(counter)*transpose(matrix(B)); // linear combination -
    2152       if (di-1==dim(std(P+ideal(t[1,1])))) // indicates that it was not
    2153       { return(t[1,1]);                // necessary to break out of the for-loop
    2154       }
    2155     }
    2156   }
    2157   return(0);
    2158 }
    2159 
    2160 ////////////////////////////////////////////////////////////////////////////////
    2161 // Finds out whether any basis element of the space of homogenous invariants of
    2162 // degree g (of dimension di) is not contained in the radical of P (of the ideal
    2163 // generated by the primary invariants found so far). It uses the Reynolds
    2164 // operator. It is used to indicate when we need to check whether nontrivial
    2165 // linear combinations of basis elements exists that lower the dimension of P
    2166 // when added.
    2167 ////////////////////////////////////////////////////////////////////////////////
    2168 proc search (matrix RO, ideal P, int g, int di)
    2169 { ideal B=inv_basis_rey(RO,g,di);      // basis of homogeneous invariants of
    2170                                        // degree g
    2171   int mdi=ncols(B);
    2172   int bool=0;
    2173   for (int i=1;i<=mdi;i=i+1)
    2174   { if (not(rad_con(B[i],P)))          // indicating that we need to try and
    2175     { bool=1;                          // find a linear combination of basis
    2176     }                                  // elements in B
    2177     else
    2178     { B[i]=0;                          // getting rid of the ones that are fully
    2179     }                                  // contained in the radical anyway
    2180   }
    2181   return(bool,compress(B));            // recycle B
    2182 }
    2183 
    2184 ////////////////////////////////////////////////////////////////////////////////
    2185 // Finds out whether any generator in B of some space of homogenous invariants
    2186 // is not contained in the radical of P (of the ideal generated by the primary
    2187 // invariants found so far). It is used to indicate when we need to check
    2188 // whether nontrivial linear combinations of basis elements exists that lower
    2189 // the dimension of P when added.
    2190 ////////////////////////////////////////////////////////////////////////////////
    2191 proc searchalt (ideal B, ideal P)
    2192 { int mdi=ncols(B);
    2193   int bool=0;
    2194   for (int i=1;i<=mdi;i=i+1)
    2195   { if (not(rad_con(B[i],P)))          // indicating that we need to try and
    2196     { bool=1;                          // find a linear combination of basis
    2197     }                                  // elements in B
    2198     else
    2199     { B[i]=0;                          // getting rid of the ones that are fully
    2200     }                                  // contained in the radical anyway
    2201   }
    2202   return(bool,compress(B));
    2203 }
    2204 
    2205 ////////////////////////////////////////////////////////////////////////////////
    2206 // 'inv_ring_k' and 'inv_ring_s' only differ in the way they are calculating the
    2207 // primary invariants. 'inv_ring_k' tries to find a set of primary invariants of
    2208 // possibly low degree. It does this by checking whether there is a linear
    2209 // combination of basis elements of a space of homogeneous invariants in a
    2210 // certain degree, such that the dimension of the variety generated by the
    2211 // primary invariant falls each time a new primary invariant is added. And this
    2212 // way we are done looking for primary invariants precisely when n (the number
    2213 // of variables of the basering) invariants are generated.
    2214 ////////////////////////////////////////////////////////////////////////////////
    2215 proc inv_ring_k (list #)
    2216   USAGE:   inv_ring_k(<generators of a finite matrix group>[,<intvec>]);
    2217            <intvec> has to contain 2 flags; if the first one equals 0, the
    2218            program attempts to compute the Molien series and Reynolds operator,
    2219            if it equals 1, the program is told that the characteristic of the
    2220            base field divides the group order, if it is anything else the Molien
    2221            series and Reynolds operator will not be computed; if the second flag
    2222            does not equal 0, information about the various stages of the program
    2223            will be printed while running
    2224   RETURNS: generators of the invariant ring with respect to the matrix group
    2225            generated by the matrices in the input; there are two return values
    2226            of type <matrix>, the first containing primary invariants and the
    2227            second secondary invariants, i.e. module generators over a Noetherian
    2228            normalization
    2229   EXAMPLE: example inv_ring_k; shows an example
    2230 { def br=basering;
    2231   int ch=char(br);                     // the algorithms depend very much on the
    2232                                        // characteristic of the ground field
    2233   int dB=degBound;
    2234   degBound=0;
    2235   int n=nvars(br);                     // n is the number of variables, as well
     5113proc invariant_ring (list #)
     5114USAGE:   invariant_ring(G1,G2,...[,flags]);
     5115         G1,G2,...: <matrices> generating a finite matrix group, flags: an
     5116         optional <intvec> with three entries: if the first one equals 0, the
     5117         program attempts to compute the Molien series and Reynolds operator,
     5118         if it equals 1, the program is told that the Molien series should not
     5119         be computed, if it equals -1 characteristic 0 is simulated, i.e. the
     5120         Molien series is computed as if the base field were characteristic 0
     5121         (the user must choose a field of large prime characteristic, e.g.
     5122         32003) and if the first one is anything else, it means that the
     5123         characteristic of the base field divides the group order (i.e. it will
     5124         not even be attempted to compute the Reynolds operator or Molien
     5125         series), the second component should give the size of intervals
     5126         between canceling common factors in the expansion of the Molien series,
     5127         0 (the default) means only once after generating all terms, in prime
     5128         characteristic also a negative number can be given to indicate that
     5129         common factors should always be canceled when the expansion is simple
     5130         (the root of the extension field does not occur among the coefficients)
     5131RETURN:  primary and secondary invariants (both of type <matrix>) generating the
     5132         invariant ring with respect to the matrix group generated by the
     5133         matrices in the input and irreducible secondary invariants (type
     5134         <matrix>) if the Molien series was available
     5135DISPLAY: information about the various stages of the program if the third flag
     5136         does not equal 0
     5137EXAMPLE: example invariant_ring; shows an example
     5138THEORY:  Bases of homogeneous invariants are generated successively and those
     5139         are chosen as primary invariants that lower the dimension of the ideal
     5140         generated by the previously found invariants (see paper "Generating a
     5141         Noetherian Normalization of the Invariant Ring of a Finite Group" by
     5142         Decker, Heydtmann, Schreyer (1997) to appear in JSC). In the
     5143         non-modular case secondary invariants are calculated by finding a
     5144         basis (in terms of monomials) of the basering modulo the primary
     5145         invariants, mapping to invariants with the Reynolds operator and using
     5146         those or their power products such that they are linearly independent
     5147         modulo the primary invariants (see paper "Some Algorithms in Invariant
     5148         Theory of Finite Groups" by Kemper and Steel (1997)). In the modular
     5149         case they are generated according to "Generating Invariant Rings of
     5150         Finite Groups over Arbitrary Fields" by Kemper (1996, to appear in
     5151         JSC).
     5152{ if (size(#)==0)
     5153  { "ERROR:   There are no generators given.";
     5154    return();
     5155  }
     5156  int ch=char(basering);               // the algorithms depend very much on the
     5157                                       // characteristic of the ground field -
     5158  int n=nvars(basering);               // n is the number of variables, as well
    22365159                                       // as the size of the matrices, as well
    22375160                                       // as the number of primary invariants,
    22385161                                       // we should get
     5162  int gen_num;
     5163  int mol_flag, v;
     5164 //------------------- checking input and setting flags -----------------------
    22395165  if (typeof(#[size(#)])=="intvec")
    2240   { if (size(#[size(#)])<>2)
    2241     { "  ERROR:   <intvec> must have exactly two entires";
     5166  { if (size(#[size(#)])<>3)
     5167    { "ERROR:   The <intvec> should have three entries.";
    22425168      return();
    22435169    }
    2244     intvec flagvec=#[size(#)];
    2245     if (flagvec[1]==0)
    2246     { if (ch==0)
    2247       { matrix R(1..2);                // one will contain Reynolds operator and
    2248                                        // the other enumerator and denominator
    2249                                        // of Molien series
    2250         R(1..2)=rey_mol(#[1..size(#)-1],flagvec[2]);
    2251       }
    2252       else
    2253       { string newring="Qa";
    2254         matrix R(1)=rey_mol(#[1..size(#)-1],newring,flagvec[2]); // will contain
    2255       }                                // Reynolds operator, if Molien series
    2256     }                                  // can be computed, it will be stored in
    2257                                        // the new ring Qa
    2258     else
    2259     { for (int i=1;i<=size(#)-1;i=i+1)
    2260       { if (not(typeof(#[i])=="matrix"))
    2261         { "  ERROR:   the parameters must be a list of matrices and optionally";
    2262           "           an <intvec>";
    2263           return();
    2264         }
    2265         if (n<>ncols(#[i]) || n<>nrows(#[i]))
    2266         { "  ERROR:   matrices need to be square and of the same dimensions as";
    2267           "           the number of variables of the basering";
    2268           return();
    2269         }
    2270       }
    2271       kill i;
    2272     }
     5170    gen_num=size(#)-1;
     5171    mol_flag=#[size(#)][1];
     5172    if (#[size(#)][2]<0 && (ch==0 or (ch<>0 && mol_flag<>0)))
     5173    { "ERROR:   the second component of <intvec> should be >=0";
     5174      return();
     5175    }
     5176    int interval=#[size(#)][2];
     5177    v=#[size(#)][3];
    22735178  }
    22745179  else
    2275   { if (typeof(#[size(#)])<>"matrix")
    2276     { "  ERROR:   the parameters must be a list of matrices and optionally";
    2277       "           an <intvec>";
    2278       return();
    2279     }
    2280     if (ch==0)
    2281     { matrix R(1..2);                  // will contain Reynolds operator and
    2282                                        // enumerator and denominator of Molien
    2283                                        // series
    2284       R(1..2)=rey_mol(#[1..size(#)]);
    2285     }
    2286     else
    2287     { string newring="Qa";             // we might need as a new ring of
    2288                                        // characteristic 0 where we store the
    2289                                        // Molien series -
    2290       matrix R(1)=rey_mol(#[1..size(#)],newring); // will contain
    2291                                        // Reynolds operator
    2292     }
    2293     intvec flagvec=0,0;
    2294   }
    2295   ideal P=0;                           // will contain primary invariants
    2296   if (flagvec[1]==0 && flagvec[2])
    2297   { "  We can start looking for primary invariants...";
    2298     "";
    2299   }
    2300   else
    2301   { if (flagvec[1] && flagvec[2])
    2302     { "";
    2303       "  We start by looking for primary invariants...";
    2304       "";
    2305     }
    2306   }
    2307   if ((ch==0 || defined(Qa)) && flagvec[1]==0) // i.e. we can use Molien series
    2308   { if (ch==0)
    2309     { poly p(1..2);                    // p(1) will be used for single terms of
    2310                                        // the partial expansion, p(2) to store
    2311       p(1..2)=part_mol(R(2),1);        // the intermediate result -
    2312       poly v1=var(1);                  // we need v1 to split off coefficients
    2313                                        // in the partial expansion of M (which
    2314                                        // is in terms of the first variable) -
    2315       poly d;                          // for splitting off the coefficient in
    2316                                        // in one term of the partial expansion,
    2317                                        // i.e. it stores the dimension of the
    2318                                        // current homogeneous subspace
    2319     }
    2320     else
    2321     { setring Qa;                      // Qa is where the Molien series is
    2322                                        // stored -
    2323       poly p(1..2);                    // p(1) will be used for single terms of
    2324                                        // the partial expansion, p(2) to store
    2325       p(1..2)=part_mol(M,1);           // the intermediate result -
    2326       poly d;                          // stores the dimension of the current
    2327                                        // homogeneous subspace
    2328       setring br;
    2329     }
    2330     int g, di, counter, i, j, m, bool; // g: current degree, di: d as integer,
    2331                                        // counter: counts primary invariants in
    2332                                        // degree g, i,j: going through monomials
    2333                                        // of degree g, m: counting primary
    2334                                        // invariants, bool: indicates whether
    2335                                        // the case occurred that a new
    2336                                        // polynomial did not lower the
    2337                                        // dimension of the ideal generated by
    2338                                        // previously found invariants -
    2339     poly imRO;                         // the image of the Reynolds operator -
    2340     ideal mon;                         // will contain monomials of degree g -
    2341     while(1)                           // repeat until n polynomials are found
    2342     { if (ch==0)
    2343       { p(1..2)=part_mol(R(2),1,p(2)); // 1 term of the partial expansion -
    2344         g=deg(p(1));                   // current degree -
    2345         d=coef(p(1),v1)[2,1];          // dimension of invariant space of degree
    2346                                        // g -
    2347         di=int(d);                     // just a type cast
    2348       }
    2349       else
    2350       {  setring Qa;
    2351          p(1..2)=part_mol(M,1,p(2));   // 1 term of the partial expansion -
    2352          g=deg(p(1));                  // current degree -
    2353          d=coef(p(1),x)[2,1];          // dimension of invariant space of degree
    2354                                        // g -
    2355          di=int(d);                    // just a type cast
    2356          setring br;
    2357       }
    2358       if (flagvec[2])
    2359       { "  Searching for primary invariants in degree "+string(g)+":";
    2360         "  There is/are "+string(di)+" linearly independent invariant(s) to choose from...";
    2361       }
    2362       mon=sort(maxideal(g))[1];        // all monomials of degree g -
    2363       j=ncols(mon);
    2364       counter=0;                       // we have 0 candidates of degree g so
    2365                                        // far
    2366       for (i=j;i>=1;i=i-1)
    2367       { imRO=eval_rey(R(1),mon[i]);
    2368         if (reduce(imRO,std(P))<>0)
    2369         { if (P[1]==0)                 // if imRO is the first non-zero
    2370           { counter=1;                 // invariant we find, the dim question is
    2371             m=1;                       // trivial and we just include imRO
    2372             P[1]=imRO/leadcoef(imRO);
    2373             if (flagvec[2])
    2374             { "  We find: "+string(P[1]);
    2375             }
    2376             if (counter==di)           // if counter is up to di==d, we can
    2377             { break;                   // leave the for-loop
    2378             }
     5180  { gen_num=size(#);
     5181    mol_flag=0;
     5182    int interval=0;
     5183    v=0;
     5184  }
     5185 //----------------------------------------------------------------------------
     5186  if (mol_flag==0)                     // calculation Molien series will be
     5187  { if (ch==0)                         // attempted -
     5188    { matrix REY,M=reynolds_molien(#[1..gen_num],intvec(0,interval,v)); // one
     5189                                       // will contain Reynolds operator and the
     5190                                       // other enumerator and denominator of
     5191                                       // Molien series
     5192      matrix P=primary_char0(REY,M,v);
     5193      matrix S,IS=secondary_char0(P,REY,M,v);
     5194      return(P,S,IS);
     5195    }
     5196    else
     5197    { list L=group_reynolds(#[1..gen_num],v);
     5198      if (L[1]<>0)                     // testing whether we are in the modular
     5199      { string newring="aksldfalkdsflkj"; // case
     5200        if (minpoly==0)
     5201        { if (v)
     5202          { "  We are dealing with the non-modular case.";
     5203          }
     5204          molien(L[3..size(L)],newring,L[2],intvec(0,interval,v));
     5205          matrix P=primary_charp(L[1],newring,v);
     5206          matrix S,IS=secondary_charp(P,L[1],newring,v];
     5207          if (voice==2)
     5208          { kill aksldfalkdsflkj;
     5209          }
     5210          return(P,S,IS);
     5211        }
     5212        else
     5213        { if (v)
     5214          { "  Since it is impossible for this programme to calculate the Molien
     5215 series for";
     5216            "  invariant rings over extension fields of prime characteristic, we
     5217 have to";
     5218            "  continue without it.";
     5219            "";
     5220
     5221          }
     5222          list l=primary_charp_no_molien(L[1],v);
     5223          if (size(l)==2)
     5224          { matix S=secondary_no_molien(l[1],L[1],l[2],v);
    23795225          }
    23805226          else
    2381           { P=P,imRO;                  // we add imRO to the generators of P
    2382             attrib(P,"isSB",1);
    2383             if (n-m-1<dim(P))          // here we are checking whether the
    2384             { if (n-m-1<dim(std(P)))   // dimension is really going down with
    2385               { P[m+1]=0;              // the new polynomial -
    2386                 P=compress(P);         // if the dimension does not go down
    2387                                        // we get rid of imRO again -
    2388                 bool=1;                // we will have to go into the procedure
    2389                                        // search later
    2390               }
    2391               else                     // we can keep imRO -
    2392               { counter=counter+1;
    2393                 m=m+1;
    2394                 P[m]=P[m]/leadcoef(P[m]); // making m-th primary invariant
    2395                 if (flagvec[2])        // nice
    2396                 { if (counter<>1)
    2397                   { "           "+string(P[m]);
    2398                   }
    2399                   else
    2400                   { "  We find: "+string(P[m]);
    2401                   }
    2402                 }
    2403               }
    2404             }
    2405             else                       // we can keep imRO -
    2406             { counter=counter+1;
    2407               m=m+1;
    2408               P[m]=P[m]/leadcoef(P[m]); // making m-th primary invariant
    2409               if (flagvec[2])
    2410               { if (counter<>1)
    2411                 { "           "+string(P[m]);
    2412                 }
    2413                 else
    2414                 { "  We find: "+string(P[m]);
    2415                 }
    2416               }
    2417             }
    2418             if (n==m or (counter==di)) // if counter==di, we can leave the for
    2419             { break;                   // loop; if n==m, we can leave both loops
    2420             }
     5227          { matix S=secondary_no_molien(l[1],L[1],v);
    24215228          }
    2422         }
    2423       }
    2424       if (n==1 or n==m)
    2425       { break;
    2426       }
    2427       if (bool)
    2428       { if (not(defined(B)==voice))
    2429         { ideal B;                     // will contain a subset of a basis of
    2430           int T;                       // homogeneous invariants of degree g
    2431           ideal Palt;                  // such that none is contained in the
    2432           poly lin;                    // radical of P -
    2433         }
    2434         bool,B=search(R(1),P,g,di);    // checking whether we need to consider
    2435                                        // nontrivial linear combinations of
    2436                                        // basis elements of degree g
    2437         di=ncols(B);
    2438         counter=0;
    2439       }
    2440       if (bool && (di>1))              // indicates that some invariants are not
    2441       {                                // in the radical, but don't lower the
    2442                                        // dimension, if there is one element in
    2443                                        // B, then there exists no linear
    2444                                        // combination that lowers the dimension
    2445         Palt=P,B;
    2446         T=n-m-dim(std(Palt));
    2447         while ((counter<>T) && (m<>n)) // runs until we are sure that there are
    2448         {                              // no more primary invariant of this
    2449                                        // degree -
    2450                                        // otherwise we have to try and build a
    2451                                        // sum of the basis elements of this
    2452                                        // degree -
    2453           if (ch==0)                   // we have to distinguish prime and non
    2454           {                            // prime characteristic, in infinite
    2455                                        // fields a (non-)solution is guaranteed
    2456                                        // and here a systematic way of finding
    2457                                        // such a solution is implemented -
    2458             lin=combi(B,di,P,n-m);     // combi finds a combination
     5229          return(l[1],S);
     5230        }
     5231      }
     5232      else                             // the modular case
     5233      { if (v)
     5234        { "  There is also no Molien series or Reynolds operator, we can make use of...";
     5235          "";
     5236          "  We can start looking for primary invariants...";
     5237          "";
     5238        }
     5239        matrix P=primary_charp_without(#[1..gen_num],v);
     5240        matrix S=secondary_not_cohen_macaulay(P,#[1..gen_num],v);
     5241        return(P,S);
     5242      }
     5243    }
     5244  }
     5245  if (mol_flag==1)                     // the user wants no calculation of the
     5246  { list L=group_reynolds(#[1..gen_num],v); // Molien series
     5247    if (ch==0)
     5248    { list l=primary_char0_no_molien(L[1],v);
     5249      if (size(l)==2)
     5250      { matix S=secondary_no_molien(l[1],L[1],l[2],v);
     5251      }
     5252      else
     5253      { matix S=secondary_no_molien(l[1],L[1],v);
     5254      }
     5255      return(l[1],S);
     5256    }
     5257    else
     5258    { if (L[1]<>0)                     // testing whether we are in the modular
     5259      { list l=primary_charp_no_molien(L[1],v); // case
     5260        if (size(l)==2)
     5261        { matix S=secondary_no_molien(l[1],L[1],l[2],v);
     5262        }
     5263        else
     5264        { matix S=secondary_no_molien(l[1],L[1],v);
     5265        }
     5266        return(l[1],S);
     5267      }
     5268      else                             // the modular case
     5269      { if (v)
     5270        { "  We can start looking for primary invariants...";
     5271          "";
     5272        }
     5273        matrix P=primary_charp_without(#[1..gen_num],v);
     5274        matrix S=secondary_not_cohen_macaulay(P,#[1..gen_num],v);
     5275        return(L[1],S);
     5276      }
     5277    }
     5278  }
     5279  if (mol_flag==-1)
     5280  { if (ch==0)
     5281    { "ERROR:   Characteristic 0 can only be simulated in characteristic p>>0.
     5282";
     5283      return();
     5284    }
     5285    list L=group_reynolds(#[1..gen_num],v);
     5286    string newring="aksldfalkdsflkj";
     5287    molien(L[2..size(L)],newring,intvec(1,interval,v));
     5288    matrix P=primary_charp(L[1],newring,v);
     5289    matrix S,IS=secondary_charp(P,L[1],newring,v);
     5290    kill aksldfalkdsflkj;
     5291    return(P,S,IS);
     5292  }
     5293  else                                 // the user specified that the
     5294  { if (ch==0)                         // characteristic divides the group order
     5295    { "ERROR:   The characteristic cannot divide the group order when it is 0.
     5296";
     5297      return();
     5298    }
     5299    if (v)
     5300    { "";
     5301    }
     5302    matrix P=primary_charp_without(#[1..gen_num],v);
     5303    matrix S=secondary_not_cohen_macaulay(P,#[1..gen_num],v);
     5304    return(L[1],S);
     5305  }
     5306}
     5307example
     5308{ "EXAMPLE: Sturmfels: Algorithms in Invariant Theory 2.3.7:";
     5309  echo=2;
     5310         ring R=0,(x,y,z),dp;
     5311         matrix A[3][3]=0,1,0,-1,0,0,0,0,-1;
     5312         matrix P,S,IS=invariant_ring(A);
     5313         print(P);
     5314         print(S);
     5315         print(IS);
     5316}
     5317
     5318proc invariant_ring_random (list #)
     5319USAGE:   invariant_ring_random(G1,G2,...,r[,flags]);
     5320         G1,G2,...: <matrices> generating a finite matrix group, r: an <int>
     5321         where -|r| to |r| is the range of coefficients of random
     5322         combinations of bases elements that serve as primary invariants,
     5323         flags: an optional <intvec> with three entries: if the first one equals
     5324         0, the program attempts to compute the Molien series and Reynolds
     5325         operator, if it equals 1, the program is told that the Molien series
     5326         should not be computed, if it equals -1 characteristic 0 is simulated,
     5327         i.e. the Molien series is computed as if the base field were
     5328         characteristic 0 (the user must choose a field of large prime
     5329         characteristic, e.g.  32003) and if the first one is anything else, it
     5330         means that the characteristic of the base field divides the group order
     5331         (i.e. it will not even be attempted to compute the Reynolds operator or
     5332         Molien series), the second component should give the size of intervals
     5333         between canceling common factors in the expansion of the Molien series,
     5334         0 (the default) means only once after generating all terms, in prime
     5335         characteristic also a negative number can be given to indicate that
     5336         common factors should always be canceled when the expansion is simple
     5337         (the root of the extension field does not occur among the coefficients)
     5338RETURN:  primary and secondary invariants (both of type <matrix>) generating the
     5339         invariant ring with respect to the matrix group generated by the
     5340         matrices in the input and irreducible secondary invariants (type
     5341         <matrix>) if the Molien series was available
     5342DISPLAY: information about the various stages of the program if the third flag
     5343         does not equal 0
     5344EXAMPLE: example invariant_ring_random; shows an example
     5345THEORY:  is the same as for invariant_ring except that random combinations of
     5346         basis elements are chosen as candidates for primary invariants and
     5347         hopefully they lower the dimension of the previously found primary
     5348         invariants by the right amount.
     5349{ if (size(#)<2)
     5350  { "ERROR:   There are too few parameters.";
     5351    return();
     5352  }
     5353  int ch=char(basering);               // the algorithms depend very much on the
     5354                                       // characteristic of the ground field
     5355  int n=nvars(basering);               // n is the number of variables, as well
     5356                                       // as the size of the matrices, as well
     5357                                       // as the number of primary invariants,
     5358                                       // we should get
     5359  int gen_num;
     5360  int mol_flag, v;
     5361 //------------------- checking input and setting flags -----------------------
     5362  if (typeof(#[size(#)])=="intvec" && typeof(#[size(#)-1])=="int")
     5363  { if (size(#[size(#)])<>3)
     5364    { "ERROR:   <intvec> should have three entries.";
     5365      return();
     5366    }
     5367    gen_num=size(#)-2;
     5368    mol_flag=#[size(#)][1];
     5369    if (#[size(#)][2]<0 && (ch==0 or (ch<>0 && mol_flag<>0)))
     5370    { "ERROR:   the second component of <intvec> should be >=0";
     5371      return();
     5372    }
     5373    int interval=#[size(#)][2];
     5374    v=#[size(#)][3];
     5375    int max=#[size(#)-1];
     5376    if (gen_num==0)
     5377    { "ERROR:   There are no generators of a finite matrix group given.";
     5378      return();
     5379    }
     5380  }
     5381  else
     5382  { if (typeof(#[size(#)])=="int")
     5383    { gen_num=size(#)-1;
     5384      mol_flag=0;
     5385      int interval=0;
     5386      v=0;
     5387      int max=#[size(#)];
     5388    }
     5389   else
     5390    { "ERROR:   If the two last parameters are not <int> and <intvec>, the last";
     5391      "         parameter should be an <int>.";
     5392      return();
     5393    }
     5394  }
     5395  for (int i=1;i<=gen_num;i=i+1)
     5396  { if (typeof(#[i])=="matrix")
     5397    { if (nrows(#[i])<>n or ncols(#[i])<>n)
     5398      { "ERROR:   The number of variables of the base ring needs to be the same";
     5399        "         as the dimension of the square matrices";
     5400        return();
     5401      }
     5402    }
     5403    else
     5404    { "ERROR:   The first parameters should be a list of matrices";
     5405      return();
     5406    }
     5407  }
     5408 //----------------------------------------------------------------------------
     5409  if (mol_flag==0)
     5410  { if (ch==0)
     5411    { matrix REY,M=reynolds_molien(#[1..gen_num],intvec(0,interval,v)); // one
     5412                                       // will contain Reynolds operator and the
     5413                                       // other enumerator and denominator of
     5414                                       // Molien series
     5415      matrix P=primary_char0_random(REY,M,max,v);
     5416      matrix S,IS=secondary_char0(P,REY,M,v);
     5417      return(P,S,IS);
     5418    }
     5419    else
     5420    { list L=group_reynolds(#[1..gen_num],v);
     5421      if (L[1]<>0)                     // testing whether we are in the modular
     5422      { string newring="aksldfalkdsflkj"; // case
     5423        if (minpoly==0)
     5424        { if (v)
     5425          { "  We are dealing with the non-modular case.";
     5426          }
     5427          molien(L[3..size(L)],newring,L[2],intvec(0,interval,v));
     5428          matrix P=primary_charp_random(L[1],newring,max,v);
     5429          matrix S,IS=secondary_charp(P,L[1],newring,v);
     5430          if (voice==2)
     5431          { kill aksldfalkdsflkj;
     5432          }
     5433          return(P,S,IS);
     5434        }
     5435        else
     5436        { if (v)
     5437          { "  Since it is impossible for this programme to calculate the Molien
     5438 series for";
     5439            "  invariant rings over extension fields of prime characteristic, we
     5440 have to";
     5441            "  continue without it.";
     5442            "";
     5443
     5444          }
     5445          list l=primary_charp_no_molien_random(L[1],max,v);
     5446          if (size(l)==2)
     5447          { matix S=secondary_no_molien(l[1],L[1],l[2],v);
    24595448          }
    24605449          else
    2461           { lin=p_combi(B,di,P,n-m);   // the subroutine p_combi finds out
    2462                                        // whether there is a combination of the
    2463                                        // basis elements at all such that it
    2464                                        // lowers the dimension of P when added -
    2465             if (lin==0)                // if the 0-polynomial is returned, it
    2466             { break;                   // means that there was no combination -
    2467             }
     5450          { matix S=secondary_no_molien(l[1],L[1],v);
    24685451          }
    2469           m=m+1;
    2470           P[m]=lin;                    // we did find the combination lin
    2471           if (flagvec[2])
    2472           { "  We find: "+string(P[m]);
    2473           }
    2474           counter=counter+1;
    2475         }
    2476       }
    2477       bool=0;
    2478       if (m==n)                        // found all primary invariants
    2479       { break;
    2480       }
    2481       if (flagvec[2])
    2482       { "";
    2483       }
    2484     }
    2485   }
    2486   else
    2487   {                                    // this case is entered when either the
    2488                                        // characteristic<>0 divides the group
    2489                                        // order or when the Molien series could
    2490                                        // not or has not been computed -
    2491     if (flagvec[1]==0)                 // indicates that the group order is
    2492     { int g=nrows(R(1));               // known, here it is set to g -
    2493       int flag=((g%ch)==0);            // flag is 1 if the characteristic
    2494                                        // divides the order, it is 0 if it does
    2495                                        // not -
    2496       if (typeof(#[size(#)])=="intvec") // getting ahold of the generators of
    2497       { int gennum=size(#)-1;          // the generators of the group
     5452          return(l[1],S);
     5453        }
     5454      }
     5455      else                             // the modular case
     5456      { if (v)
     5457        { "  There is also no Molien series, we can make use of...";
     5458          "";
     5459          "  We can start looking for primary invariants...";
     5460          "";
     5461        }
     5462        matrix P=primary_charp_without_random(#[1..gen_num],max,v);
     5463        matrix S=secondary_not_cohen_macaulay(P,#[1..gen_num],v);
     5464        return(L[1],S);
     5465      }
     5466    }
     5467  }
     5468  if (mol_flag==1)                     // the user wants no calculation of the
     5469  { list L=group_reynolds(#[1..gen_num],v); // Molien series
     5470    if (ch==0)
     5471    { list l=primary_char0_no_molien_random(L[1],max,v);
     5472      if (size(l)==2)
     5473      { matix S=secondary_no_molien(l[1],L[1],l[2],v);
    24985474      }
    24995475      else
    2500       { int gennum=size(#);
    2501       }
    2502     }
    2503     else
    2504     { int flag=2;                      // flag is 2 if we don't know yet whether
    2505       int gennum=size(#)-1;            // the group order is divisible by the
    2506     }                                  // characteristic -
    2507     int d=1;                           // d is set to the current degree, since
    2508                                        // we know nothing about the finite
    2509                                        // matrix group (via Molien series) we
    2510                                        // have to start with degree 1
    2511     int j, counter, i, di, bool;       // counter: counts primary invariants,
    2512                                        // i: goes through basis elements, di:
    2513                                        // dimension of current space, bool:
    2514                                        // indicates that the case occurred that
    2515                                        // a basis element did not lower the
    2516                                        // dimension, but was not in the radical
    2517     while (1)
    2518     { if (flagvec[2])
    2519       { "  Searching for primary invariants in degree "+string(d)+":";
    2520       }
    2521       if (flag)                        // in this case we can not make use of
    2522       {                                // the Reynolds operator -
    2523         ideal B(d)=inv_basis(d,#[1..gennum]); // we create a basis of the vector
    2524       }                                // space of all invariant polynomials of
    2525                                        // degree d
    2526       else
    2527       {                                // here the characteristic<>0 does not
    2528         ideal B(d)=inv_basis_rey(R(1),d); // divide the group order, i.e. the
    2529       }                                // Reynolds operator can be used to
    2530                                        // calculate a basis of the vector space
    2531                                        // of all invariant polynomials of degree
    2532                                        // d -
    2533       di=ncols(B(d));
    2534       if (B(d)[1]<>0)                  // otherwise the space is empty -
    2535       { if (flagvec[2])
    2536         { "  There is/are "+string(di)+" linearly independent invariant(s) to choose from...";
    2537         }
    2538         if (counter==0)                // we have no candidates for primary
    2539         {                              // invariants yet, i.e. don't have to
    2540           P[1]=B(d)[1];                // check for radical containment
    2541           if (flagvec[2])
    2542           { "  We find: "+string(P[1]);
    2543           }
    2544           i=2;                         // go to second basis element
    2545           counter=1;
     5476      { matix S=secondary_no_molien(l[1],L[1],v);
     5477      }
     5478      return(l[1],S);
     5479    }
     5480    else
     5481    { if (L[1]<>0)                     // testing whether we are in the modular
     5482      { list l=primary_charp_no_molien_random(L[1],max,v); // case
     5483        if (size(l)==2)
     5484        { matix S=secondary_no_molien(l[1],L[1],l[2],v);
    25465485        }
    25475486        else
    2548         { i=1;                         // go to first basis element
    2549         }
    2550         while (i<=di)                  // goes through all polynomials in B(d) -
    2551         { P=P,B(d)[i];                 // adding candidate -
    2552           attrib(P,"isSB",1);          // checking dimension -
    2553           if (n-counter-1<dim(P))
    2554           { if (n-counter-1<dim(std(P))) // in this case B(d)[i] would not lower
    2555             { P[counter+1]=0;          // the dimension and we get rid of it
    2556               P=compress(P);
    2557               bool=1;
    2558             }
    2559             else                       // indicates that B(d)[i] qualifies
    2560             { counter=counter+1;
    2561               if (flagvec[2])
    2562               { "  We find: "+string(P[counter]);
    2563               }
    2564               if (counter==n)          // in that case, we're done
    2565               { break;
    2566               }
    2567             }
    2568           }
    2569           else                         // indicates that B(d)[i] qualifies
    2570           { counter=counter+1;
    2571             if (flagvec[2])
    2572             { "  We find: "+string(P[counter]);
    2573             }
    2574             if (counter==n)            // in that case, we're done
    2575             { break;
    2576             }
    2577           }
    2578           i=i+1;                       // go to next basis element
    2579         }
    2580         if (counter==n)                // we're done
    2581         { break;
    2582         }
    2583         if (bool)
    2584         { if (not(defined(Ba)==voice))
    2585           { ideal Ba;
    2586             int T;
    2587             ideal Palt;
    2588             poly lin;
    2589           }
    2590           bool,Ba=searchalt(B(d),P);   // Ba will now contain a subset of
    2591                                        // a basis of homogeneous invariants of
    2592                                        // degree d such that none is contained
    2593                                        // in the radical of P
    2594           di=ncols(Ba);
    2595         }
    2596         if (bool && (di>1))            // this meant that we have to use
    2597         {                              // Kemper's method, if there is one
    2598                                        // element in Ba then there exists no
    2599                                        // linear combination that lowers the
    2600                                        // dimension
    2601           Palt=P,Ba;
    2602           T=n-counter-dim(std(Palt));
    2603           while (counter<>n)           // runs until we are sure that there are
    2604           {                            // no more primary invariant of this
    2605                                        // degree -
    2606                                        // otherwise we have to try and build a
    2607                                        // sum of the basis elements of this
    2608                                        // degree -
    2609             if (ch==0)                 // we have to distinguish prime and non
    2610             {                          // prime characteristic, in infinite
    2611                                        // fields a (non-)solution is guaranteed
    2612                                        // and here a systematic way of finding
    2613                                        // such a solution is implemented -
    2614               lin=combi(Ba,di,P,counter); // combi finds a combination
    2615             }
    2616             else
    2617             { lin=p_combi(Ba,di,P,counter); // the subroutine p_combi finds out
    2618                                        // whether there is a combination of the
    2619                                        // basis elements at all such that it
    2620                                        // lowers the dimension of P when added -
    2621               if (lin==0)              // if the 0-polynomial is returned, it
    2622               { break;
    2623               }
    2624             }
    2625             counter=counter+1;         // otherwise, we did find a combination
    2626             P[counter]=lin;
    2627             if (flagvec[2])
    2628             { "  We find: "+string(P[counter]);
    2629             }
    2630           }
    2631         }
    2632         bool=0;
    2633         if (counter==n)                // found all primary invariants
    2634         { break;
    2635         }
    2636         if (flagvec[2])
    2637         { "";
    2638         }
    2639       }
    2640       else
    2641       { if (flagvec[2])
    2642         { "  The space is 0-dimensional.";
    2643         }
    2644       }
    2645       d=d+1;                           // up to the next degree
    2646     }
    2647   }
    2648   if ((ch==0 || defined(Qa)) && flagvec[1]==0)
    2649   { if (flagvec[2])
     5487        { matix S=secondary_no_molien(l[1],L[1],v);
     5488        }
     5489        return(l[1],S);
     5490      }
     5491      else                             // the modular case
     5492      { if (v)
     5493        { "  We can start looking for primary invariants...";
     5494          "";
     5495        }
     5496        matrix P=primary_charp_without_random(#[1..gen_num],max,v);
     5497        matrix S=secondary_not_cohen_macaulay(P,#[1..gen_num],v);
     5498        return(L[1],S);
     5499      }
     5500    }
     5501  }
     5502  if (mol_flag==-1)
     5503  { if (ch==0)
     5504    { "ERROR:   Characteristic 0 can only be simulated in characteristic p>>0.
     5505";
     5506      return();
     5507    }
     5508    list L=group_reynolds(#[1..gen_num],v);
     5509    string newring="aksldfalkdsflkj";
     5510    molien(L[2..size(L)],newring,intvec(1,v));
     5511    matrix P=primary_charp_random(L[1],newring,max,v);
     5512    matrix S,IS=secondary_charp(P,L[1],newring,v);
     5513    kill aksldfalkdsflkj;
     5514    return(P,S,IS);
     5515  }
     5516  else                                 // the user specified that the
     5517  { if (ch==0)                         // characteristic divides the group order
     5518    { "ERROR:   The characteristic cannot divide the group order when it is 0.
     5519";
     5520      return();
     5521    }
     5522    if (v)
    26505523    { "";
    26515524    }
    2652     ideal Q=std(P);                    // P contains the primary invariants -
    2653     intvec degvec;                     // will contain the degrees of secondary
    2654                                        // invariants -
    2655     if (ch==0)                         // Molien series is stored in basering
    2656     { p(1)=1;
    2657       for (j=1;j<=n;j=j+1)             // calculating the denominator of the
    2658       { p(1)=p(1)*(1-v1^deg(P[j]));    // Hilbert series of the ring generated
    2659       }                                // generated by the primary invariants -
    2660       matrix s[1][2]=R(2)[1,1]*p(1),R(2)[1,2]; // used for canceling
    2661       s=matrix(syz(ideal(s)));
    2662       p(1)=s[2,1];                     // the polynomial telling us where to
    2663                                        // search for secondary invariants
    2664       map slead=br,ideal(0);
    2665       p(1)=1/slead(p(1))*p(1);         // smallest term of p(1) needs to be 1 -
    2666       if (flagvec[2])
    2667       { "  Polynomial telling us where to look for secondary invariants:";
    2668         "   "+string(p(1));
    2669         "";
    2670       }
    2671       matrix dimmat=coeffs(p(1),v1);   // dimmat will contain the number of
    2672                                        // secondary invariants, we need to find
    2673                                        // of a certain degree -
    2674       m=nrows(dimmat);                 // m-1 is the highest degree
    2675       degvec=0;
    2676       for (j=1;j<=m;j=j+1)
    2677       { if (dimmat[j,1]<>0)
    2678         { degvec[j]=int(dimmat[j,1]);  // degvec[j] now contains the number of
    2679         }                              // secondary invariants of degree j-1
    2680       }
    2681     }
    2682     else
    2683     { for (j=1;j<=n;j=j+1)             // degrees have to be taken in a ring of
    2684       { degvec[j]=deg(P[j]);           // characteristic 0
    2685       }
    2686       setring Qa;
    2687       p(1)=1;
    2688       for (j=1;j<=n;j=j+1)             // calculating the denominator of the
    2689       { p(1)=p(1)*(1-x^degvec[j]);     // Hilbert series of the ring generated
    2690       }                                // by the primary invariants -
    2691       matrix s[1][2]=M[1,1]*p(1),M[1,2]; // used for canceling
    2692       s=matrix(syz(ideal(s)));
    2693       p(1)=s[2,1];                     // the polynomial telling us where to
    2694                                        // search for secondary invariants
    2695       map slead=Qa,ideal(0);
    2696       p(1)=1/slead(p(1))*p(1);         // smallest term of p(1) needs to be 1
    2697       if (flagvec[2])
    2698       { "  Polynomial telling us where to look for secondary invariants:";
    2699         "   "+string(p(1));
    2700         "";
    2701       }
    2702       matrix dimmat=coeffs(p(1),x);    // dimmat will contain the number of
    2703                                        // secondary invariants, we need to find
    2704                                        // find of a certain degree -
    2705       m=nrows(dimmat);                 // m-1 actually is the highest degree
    2706       degvec=0;
    2707       for (j=1;j<=m;j=j+1)
    2708       { if (dimmat[j,1]<>0)
    2709         { degvec[j]=int(dimmat[j,1]);  // degvec[j-1] contains the number of
    2710         }                              // secondary invariants of degree j-1
    2711       }
    2712       setring br;
    2713       kill Qa;                         // all the information needed for Qa is
    2714     }                                  // stored in degvec and dimmat -
    2715     qring Qring=Q;                     // we need to do calculations modulo the
    2716                                        // ideal generated by the elements of P,
    2717                                        // its standard basis is stored in Q -
    2718     poly imROmod;                      // imRO reduced -
    2719     ideal Smod, sSmod;                 // secondary invariants of one degree
    2720                                        // reduced and their standard basis
    2721     setring br;
    2722     kill Q;                            // Q might be big and isn't needed
    2723                                        // anymore
    2724     if (flagvec[2])
    2725     { "  Proceeding to look for secondary invariants...";
    2726       "";
    2727       "  In degree 0 we have: 1";
    2728       "";
    2729     }
    2730     bool=0;                            // indicates when standard basis
    2731                                        // calculation is necessary -
    2732     ideal S=1;                         // 1 definitely is a secondary invariant
    2733     for (i=2;i<=m;i=i+1)               // walking through degvec -
    2734     { if (degvec[i]<>0)                // when it is == 0 we need to find 0
    2735       {                                // elements of the current degree being
    2736                                        // i-1 -
    2737         if (flagvec[2])
    2738         { "  Searching in degree "+string(i-1)+", we need to find "+string(degvec[i,1])+" invariant(s)...";
    2739         }
    2740         mon=sort(maxideal(i-1))[1];    // all monomials of degree i-1 -
    2741         counter=0;                     // we'll count up to degvec[i] -
    2742         j=ncols(mon);                  // we'll go through mon from the end
    2743         setring Qring;
    2744         Smod=0;
    2745         setring br;
    2746         while (degvec[i]<>counter)     // need to find degvec[i] linearly
    2747         {                              // independent (in Qring) invariants -
    2748           imRO=eval_rey(R(1),mon[j]);  // generating invariants
    2749           setring Qring;
    2750           imROmod=fetch(br,imRO);      // reducing the invariants
    2751           if (reduce(imROmod,std(ideal(0)))<>poly(0) and counter<>0)
    2752           {                            // if the first condition is true and the
    2753                                        // second false, imROmod is the first
    2754                                        // secondary invariant of that degree
    2755                                        // that we want to add and we need not
    2756                                        // check linear independence
    2757             if (bool)
    2758             { sSmod=std(Smod);
    2759             }
    2760             if (reduce(imROmod,sSmod)<>0)
    2761             { Smod=Smod,imROmod;
    2762               setring br;              // we make its leading coefficient to be
    2763               imRO=imRO/leadcoef(imRO); // 1
    2764               S=S,imRO;
    2765               if (flagvec[2])
    2766               { "           "+string(imRO);
    2767               }
    2768               counter=counter+1;
    2769               bool=1;                  // next time we need to recalculate std
    2770             }
    2771             else
    2772             { bool=0;                  // std-calculation is unnecessary
    2773               setring br;
    2774             }
    2775           }
    2776           else
    2777           { if (reduce(imROmod,std(ideal(0)))<>poly(0) and counter==0)
    2778             { Smod[1]=imROmod;         // here we just add imRO(mod) without
    2779               setring br;              // having to check linear independence
    2780               imRO=imRO/leadcoef(imRO);
    2781               S=S,imRO;
    2782               counter=counter+1;
    2783               bool=1;                  // next time we need to calculate std
    2784               if (flagvec[2])
    2785               { "  We find: "+string(imRO);
    2786               }
    2787             }
    2788             else
    2789             { setring br;
    2790             }
    2791           }
    2792           j=j-1;                       // going to next monomial
    2793         }
    2794         if (flagvec[2])
    2795         { "";
    2796         }
    2797       }
    2798     }
    2799     degBound=dB;
    2800     if (flagvec[2])
    2801     { "  We're done!";
    2802       "";
    2803     }
    2804     matrix FI(1)=matrix(P);
    2805     matrix FI(2)=matrix(S);
    2806     return(FI(1..2));
    2807   }
    2808   else
    2809   { if (flagvec[2])
    2810     { "";
    2811       "  Proceeding to look for secondary invariants...";
    2812     }
    2813     // we can now proceed to calculate secondary invariants, the problem
    2814     // we face again is that we can make no use of a Molien series - however,
    2815     // if the characteristic does not divide the group order, we can still make
    2816     // use of the fact that the secondary invariants are free module generators
    2817     // and that we need deg(P[1])*...*deg(P[n])/(cardinality of the group) of
    2818     // them
    2819     matrix FI(1)=matrix(P);            // primary invariants, ready for output -
    2820     P=std(P);                          // for calculations module primary
    2821                                        // invariants
    2822     if (flagvec[1]<>0 and flagvec[1]<>1)
    2823     { int g=group(#[1..size(#)-1]);    // computing group order
    2824       if (ch==0)
    2825       { matrix FI(2)=sec_minus_mol(ideal(FI(1)),P,g,flagvec[2],#[1..size(#)-1],0,B(1..d),d);
    2826         return(FI(1..2));
    2827       }
    2828       if (g%ch<>0)
    2829       { matrix FI(2)=sec_minus_mol(ideal(FI(1)),P,g,flagvec[2],#[1..size(#)-1],0,B(1..d),d);
    2830           return(FI(1..2));
    2831       }
    2832     }
    2833     else
    2834     { if (flag==0)                     // this is the case where we have a
    2835       {                                // nonzero minpoly, but the
    2836                                        // characteristic does not divide the
    2837                                        // group order
    2838         matrix FI(2)=sec_minus_mol(ideal(FI(1)),P,g,flagvec[2],R(1),1,B(1..d),d);
    2839         return(FI(1..2));
    2840       }
    2841     }
    2842     if (flagvec[2])
    2843     { "  Since the characteristic of the base field divides the group order, we do not";
    2844       "  know whether the invariant ring is Cohen-Macaulay. We have to use Kemper's";
    2845       "  algorithm and compute secondary invariants with respect to the trivial";
    2846       "  subgroup of the given group.";
    2847       "";
     5525    matrix P=primary_charp_without_random(#[1..gen_num],max,v);
     5526    matrix S=secondary_not_cohen_macaulay(P,#[1..gen_num],v);
     5527    return(L[1],S);
     5528  }
     5529}
     5530example
     5531{ "EXAMPLE: Sturmfels: Algorithms in Invariant Theory 2.3.7:";
     5532  echo=2;
     5533         ring R=0,(x,y,z),dp;
     5534         matrix A[3][3]=0,1,0,-1,0,0,0,0,-1;
     5535         matrix P,S,IS=invariant_ring_random(A,1);
     5536         print(P);
     5537         print(S);
     5538         print(IS);
     5539}
    28485540
    2849     }
    2850     // are using Kemper's algorithm with the trivial subgroup
    2851     ring QQ=0,x,dp;
    2852     ideal M=(1-x)^n;                   // we look at our primary invariants as
    2853                                        // such of the subgroup that only
    2854                                        // contains the identity, this means that
    2855                                        // ch does not divide the order anymore,
    2856                                        // this means that we can make use of the
    2857                                        // Molien series again - 1/M[1] is the
    2858                                        // Molien series of that group, we now
    2859                                        // calculate the secondary invariants of
    2860                                        // this subgroup in the usual fashion
    2861                                        // where the primary invariants are the
    2862                                        // ones from the bigger group
    2863     setring br;
    2864     intvec degvec;                     // for the degrees of the primary
    2865                                        // invariants -
    2866     for (i=1;i<=n;i=i+1)               // finding the degrees of these
    2867     { degvec[i]=deg(FI(1)[1,i]);
    2868     }
    2869     setring QQ;                        // calculating the polynomial indicating
    2870     M[2]=1;                            // where to search for secondary
    2871     for (i=1;i<=n;i=i+1)               // invariants (of the trivial subgroup)
    2872     { M[2]=M[2]*(1-x^degvec[i]);
    2873     }
    2874     M=matrix(syz(M))[1,1];
    2875     M[1]=M[1]/leadcoef(M[1]);
    2876     if (flagvec[2])
    2877     { "  Polynomial telling us where to look for these secondary invariants:";
    2878       "   "+string(M[1]);
    2879       "";
    2880     }
    2881     matrix dimmat=coeffs(M[1],x);      // storing the number of secondary
    2882                                        // invariants we need in a certain
    2883     int m=nrows(dimmat);               // m-1 is the highest degree where we
    2884                                        // need to search
    2885     degvec=0;
    2886     for (i=1;i<=m;i=i+1)               // degvec will contain all the
    2887     { if (dimmat[i,1]<>0)              // information about where to find
    2888       { degvec[i]=int(dimmat[i,1]);    // secondary invariants, it is filled
    2889       }                                // with integers and therefore visible in
    2890     }                                  // all rings
    2891     kill QQ;
    2892     setring br;
    2893     ideal B;
    2894     ideal S=1;                         // 1 is a secondary invariant always
    2895     if (flagvec[2])
    2896     { "  In degree 0 we have: 1";
    2897       "";
    2898     }
    2899     qring Qring=P;
    2900     ideal Smod, Bmod, sSmod;           // Smod: secondary invariants of one
    2901                                        // degree modulo P, sSmod: standard basis
    2902                                        // of the latter, Bmod: B modulo P
    2903     setring br;
    2904     kill P;                            // might be large
    2905     if (flagvec[1]==1)
    2906     { int g;
    2907     }
    2908     for (i=2;i<=m;i=i+1)               // going through all entries of degvec
    2909     { if (degvec[i]<>0)
    2910       { B=sort(maxideal(i-1))[1];      // basis of the space of invariants (with
    2911                                        // respect to the matrix subgroup
    2912                                        // containing only the identity) of
    2913                                        // degree i-1 -
    2914         if (flagvec[2])
    2915         { "  Searching in degree "+string(i-1)+", we need to find "+string(degvec[i])+" invariant(s)...";
    2916         }
    2917         counter=0;                     // we have 0 secondary invariants of
    2918                                        // degree i-1 so far
    2919         setring Qring;
    2920         Bmod=fetch(br,B);              // basis modulo primary invariants
    2921         Smod=0;
    2922         j=ncols(Bmod);                 // going backwards through Bmod
    2923         while (degvec[i]<>counter)
    2924         { if (reduce(Bmod[j],std(ideal(0)))<>0 && counter<>0)
    2925           { if (bool)
    2926             { sSmod=std(Smod);
    2927             }
    2928             if (reduce(Bmod[j],sSmod)<>0) // Bmod[j] qualifies as secondary
    2929             { Smod=Smod,Bmod[j];       // invariant
    2930               setring br;
    2931               S=S,B[j];
    2932               counter=counter+1;
    2933               if (flagvec[2])
    2934               { "           "+string(B[j]);
    2935               }
    2936               setring Qring;
    2937               bool=1;                  // need to calculate std of Smod next
    2938             }                          // time
    2939             else
    2940             { bool=0;
    2941             }
    2942           }
    2943           else
    2944           { if (reduce(Bmod[j],std(ideal(0)))<>0 && counter==0)
    2945             { Smod[1]=Bmod[j];         // in this case, we may just add B[j]
    2946               setring br;
    2947               S=S,B[j];
    2948               if (flagvec[2])
    2949               { "  We find: "+string(B[j]);
    2950               }
    2951               counter=counter+1;
    2952               bool=1;                  // need to calculate std of Smod next
    2953               setring Qring;           // time
    2954             }
    2955           }
    2956           j=j-1;                       // next basis element
    2957         }
    2958         setring br;
    2959       }
    2960     }
    2961     // now we have those secondary invariants
    2962     int k=ncols(S);                    // k is the number of the secondary
    2963                                        // invariants, we just calculated
    2964     if (flagvec[2])
    2965     { "";
    2966       "  We calculate secondary invariants from the ones found for the trivial";
    2967       "  subgroup.";
    2968       "";
    2969     }
    2970     map f;                             // used to let generators act on
    2971                                        // secondary invariants with respect to
    2972                                        // the trivial group -
    2973     matrix M(1)[gennum][k];            // M(1) will contain a module
    2974     for (i=1;i<=gennum;i=i+1)
    2975     { B=ideal(matrix(maxideal(1))*transpose(#[i])); // image of the various
    2976                                        // variables under the i-th generator -
    2977       f=br,B;                          // the corresponding mapping -
    2978       B=f(S)-S;                        // these relations should be 0 -
    2979       M(1)[i,1..k]=B[1..k];            // we will look for the syzygies of M(1)
    2980     }
    2981     module M(2)=res(M(1),2)[2];
    2982     m=ncols(M(2));                     // number of generators of the module
    2983                                        // M(2) -
    2984     // the following steps calculates the intersection of the module M(2) with
    2985     // the algebra A^k where A denote the subalgebra of the usual polynomial
    2986     // ring, generated by the primary invariants
    2987     string mp=string(minpoly);         // generating a ring where we can do
    2988                                        // elimination
    2989     execute "ring R=("+charstr(br)+"),(x(1..n),y(1..n),h),dp;";
    2990     execute "minpoly=number("+mp+");";
    2991     map f=br,maxideal(1);              // canonical mapping
    2992     matrix M[k][m+k*n];
    2993     M[1..k,1..m]=matrix(f(M(2)));      // will contain a module -
    2994     matrix FI(1)=f(FI(1));             // primary invariants in the new ring
    2995     for (i=1;i<=n;i=i+1)
    2996     { for (j=1;j<=k;j=j+1)
    2997       { M[j,m+(i-1)*k+j]=y(i)-FI(1)[1,i];
    2998       }
    2999     }
    3000     M=elim(module(M),1,n);             // eliminating x(1..n), std-calculation
    3001                                        // is done internally -
    3002     M=homog(module(M),h);              // homogenize for 'minbase'
    3003     M=minbase(module(M));
    3004     setring br;
    3005     //execute "ideal v="+varstr(br)+",ideal(FI(1)),1";
    3006     ideal v=maxideal(1),ideal(FI(1)),1;
    3007     f=R,v;                             // replacing y(1..n) by primary
    3008                                        // invariants -
    3009     M(2)=f(M);                         // M(2) is the new module -
    3010     m=ncols(M(2));
    3011     matrix FI(2)[1][m];
    3012     FI(2)=matrix(S)*matrix(M(2));      // FI(2) now contains the secondary
    3013                                        // invariants
    3014     for (i=1; i<=m;i=i+1)
    3015     { FI(2)[1,i]=FI(2)[1,i]/leadcoef(FI(2)[1,i]); // making elements nice
    3016     }
    3017     FI(2)=sort(ideal(FI(2)))[1];
    3018     if (flagvec[2])
    3019     { "  These are the secondary invariants: ";
    3020       for (i=1;i<=m;i=i+1)
    3021       { "   "+string(FI(2)[1,i]);
    3022       }
    3023       "";
    3024       "  We're done!";
    3025       "";
    3026     }
    3027     if ((flagvec[2] or (voice==2)) && flagvec[1]==1 && (m>1))
    3028     { "  WARNING: The invariant ring might not have a Hironaka decomposition";
    3029       "           if the characteristic of the coefficient field divides the";
    3030       "           group order.";
    3031     }
    3032     else
    3033     { if ((flagvec[2] or (voice==2)) and (m>1))
    3034       { "  WARNING: The invariant ring might not have a Hironaka decomposition!"
    3035 ;
    3036         "           This is because the characteristic of the coefficient field"
    3037 ;
    3038         "           divides the group order.";
    3039       }
    3040     }
    3041     degBound=dB;
    3042     return(FI(1..2));
    3043   }
    3044 }
    3045 example
    3046 { "  EXAMPLE: Sturmfels: Algorithms in Invariant Theory 2.3.7:";
    3047   echo=2;
    3048            ring R=0,(x,y,z),dp;
    3049            matrix A[3][3]=0,1,0,-1,0,0,0,0,-1;
    3050            matrix B(1..2);
    3051            B(1..2)=inv_ring_k(A);
    3052            print(B(1..2));
    3053 }
    3054 
    3055 ////////////////////////////////////////////////////////////////////////////////
    3056 // The procedure introduces m new variables y(i), m being the number of
    3057 // generators {f_1,...,f_m} of the subring in the variables x(1),...,x(n).
    3058 // A Groebner basis of {f_1-y(1),...,f_m-y(m)} is computed with respect to
    3059 // the product ordering of x^a*y^b > y^d*y^e if x^a > x^d or else if y^b > y^e.
    3060 // f reduces to a polynomial only in the y(i) <=> p is contained in the subring
    3061 // generated by the polynomials in F.
    3062 ////////////////////////////////////////////////////////////////////////////////
    3063 proc algebra_con (poly p, matrix F)
    3064   USAGE:   algebra_con(<poly>,<matrix>); <poly> is arbitrary in the basering,
    3065            <matrix> defines a subring of the basering
    3066   RETURNS: if <poly> is contained in the ring, 1 (TRUE) (type <int>) is
    3067            returned as well as a comment showing a representation of <poly>
    3068            where y(i) represents the i-th element in <matrix>. 0 (type <int>)
    3069            is returned if <poly> is not contained
    3070   EXAMPLE: example algebra_con; shows an example
    3071 { if (nrows(F)==1)
     5541proc algebra_containment (poly p, matrix A)
     5542USAGE:   algebra_containment(p,A);
     5543         p: arbitrary <poly>, A: a 1xm <matrix> giving generators of a
     5544         subalgebra of the basering
     5545RETURN:  1 (TRUE) (type <int>) if p is contained in the subalgebra
     5546         0 (FALSE) (type <int>) if <poly> is not contained
     5547DISPLAY: a representation of p in terms of algebra generators A[1,i]=y(i) if p
     5548         is contained in the subalgebra
     5549EXAMPLE: example algebra_containment; shows an example
     5550THEORY:  The ideal of algebraic relations of the algebra generators f1,...,fm
     5551         given by A is computed introducing new variables y(i) and the product
     5552         order: x^a*y^b > y^d*y^e if x^a > x^d or else if y^b > y^e. p reduces
     5553         to a polynomial only in the y(i) <=> p is contained in the subring
     5554         generated by the polynomials in A.
     5555{ degBound=0;
     5556  if (nrows(A)==1)
    30725557  { def br=basering;
    30735558    int n=nvars(br);
    3074     int m=ncols(F);
     5559    int m=ncols(A);
     5560    string mp=string(minpoly);
     5561    execute "ring R=("+charstr(br)+"),(x(1..n),y(1..m)),(dp(n),dp(m));";
     5562    execute "minpoly=number("+mp+");";
    30755563    ring R=0,(x(1..n),y(1..m)),(dp(n),dp(m));
    30765564    ideal vars=x(1..n);
    30775565    map emb=br,vars;
    3078     ideal F=ideal(emb(F));
     5566    ideal A=ideal(emb(A));
    30795567    ideal check=emb(p);
    30805568    for (int i=1;i<=m;i=i+1)
    3081     { F[i]=F[i]-y(i);
    3082     }
    3083     F=std(F);
    3084     check[1]=reduce(check[1],F);
    3085     F=elim(check,1,n);
    3086     if (F[1]<>0)
     5569    { A[i]=A[i]-y(i);
     5570    }
     5571    A=std(A);
     5572    check[1]=reduce(check[1],A);
     5573    A=elim(check,1,n);
     5574    if (A[1]<>0)
    30875575    { "\/\/ "+string(check);
    30885576      return(1);
    … …  
    30935581  }
    30945582  else
    3095   { "  ERROR:   <matrix> may only have one row";
     5583  { "ERROR:   <matrix> may only have one row";
    30965584    return();
    30975585  }
    30985586}
    30995587example
    3100 { "  EXAMPLE: Sturmfels: Algorithms in Invariant Theory 2.3.7:";
     5588{ "EXAMPLE: Sturmfels: Algorithms in Invariant Theory 2.3.7:";
    31015589  echo=2;
    3102            ring R=0,(x,y,z),dp;
    3103            matrix F[1][7]=x2+y2,z2,x4+y4,x4+y4,1,x2z-1y2z,xyz,x3y-1xy3;
    3104            poly p1=(x2z-1y2z)*z2;
    3105            algebra_con(p1,F);
    3106            poly p2=z;
    3107            algebra_con(p2,F);
     5590         ring R=0,(x,y,z),dp;
     5591         matrix A[1][7]=x2+y2,z2,x4+y4,1,x2z-1y2z,xyz,x3y-1xy3;
     5592         poly p1=x10z3-x8y2z3+2x6y4z3-2x4y6z3+x2y8z3-y10z3+x6z4+3x4y2z4+3x2y4z4+y6z4;
     5593         algebra_containment(p1,A);
     5594         poly p2=z;
     5595         algebra_containment(p2,A);
    31085596}
    31095597
    3110 ////////////////////////////////////////////////////////////////////////////////
    3111 // The procedure introduces n+m new variables y(i) and z(j), n being the number
    3112 // of primary generators {p_1,...,p_n} and m the number of secondary ones
    3113 // {s_1,...,s_m} in the variables x(1),...,x(n). A Groebner basis of
    3114 // {p_1-y(1),...,p_n-y(n),s_1-z(1),...,s_m-z(m)} is computed with respect to the
    3115 // product ordering of x^a*y^b*z^c > x^d*y^e*z^f if x^a > x^d with respect
    3116 // to the purely lexicographical ordering or else if z^c > z^f with respect
    3117 // to the degree lexicographical ordering or else if y^b > y^e with respect
    3118 // to the purely lexicographical ordering again. f reduces to a polynomial
    3119 // only in y(i) and z(j) (more specifically, linear in the z(j)) <=> f is
    3120 // contained in the Cohen-Macaulay ring.
    3121 ////////////////////////////////////////////////////////////////////////////////
    3122 proc module_con(poly f, matrix P, matrix S)
    3123   USAGE:   module_con(<poly>,<matrix_1>,<matrix_2>); <poly> is arbitrary in
    3124            the basering, <matrix_1> should represent the primary generators of
    3125            a Cohen-Macaulay ring, <matrix_2> the secondary ones
    3126   RETURNS: if <poly> is contained in the ring, 1 (TRUE) (type <int>) is
    3127            returned as well as a comment showing the unique representation
    3128            of <poly> with respect to a Hironaka decomposition; y(i) represents
    3129            the i-th element in <matrix_2> and z(j) represents the j-th element
    3130            in <matrix_1>. 0 (type <int>) is returned if <poly> is not contained.
    3131   EXAMPLE: example module_con; shows an example
     5598proc module_containment(poly p, matrix P, matrix S)
     5599USAGE:   module_containment(p,P,S);
     5600         p: arbitrary <poly>, P: a 1xn <matrix> giving generators of an algebra,
     5601         S: a 1xt <matrix> giving generators of a module over the algebra
     5602         generated by P
     5603ASSUME:  n is the number of variables in the basering and the generators in P
     5604         are algebraically independent
     5605RETURNS: 1 (TRUE) (type <int>) if p is contained in the ring
     5606         0 (FALSE) type <int>) if p is not contained
     5607DISPLAY: the representation of p in terms of algebra generators P[1,i]=z(i) and
     5608         module generators S[1,j]=y(j) if p is contained in the module
     5609EXAMPLE: example module_containment; shows an example
     5610THEORY:  The ideal of algebraic relations of all the generators p1,...,pn,
     5611         s1,...,st given by P and S is computed introducing new variables y(j),
     5612         z(i) and the product order: x^a*y^b*z^c > x^d*y^e*z^f if x^a > x^d
     5613         with respect to the lp ordering or else if z^c > z^f with respect to
     5614         the dp ordering or else if y^b > y^e with respect to the lp ordering
     5615         again. p reduces to a polynomial only in the y(j) and z(i) linear in
     5616         the z(i)) <=> p is contained in the module.
    31325617{ def br=basering;
     5618  degBound=0;
    31335619  int n=nvars(br);
    31345620  if (ncols(P)==n and nrows(P)==1 and nrows(S)==1)
    31355621  { int m=ncols(S);
    3136     ring R=0,(x(1..n),y(1..m),z(1..n)),(lp(n),dp(m),lp(n));
     5622    string mp=string(minpoly);
     5623    execute "ring R=("+charstr(br)+"),(x(1..n),y(1..m),z(1..n)),(lp(n),dp(m),lp(n));";
     5624    execute "minpoly=number("+mp+");";
    31375625    ideal vars=x(1..n);
    31385626    map emb=br,vars;
    31395627    matrix P=emb(P);
    31405628    matrix S=emb(S);
    3141     ideal check=emb(f);
     5629    ideal check=emb(p);
    31425630    ideal I;
    31435631    for (int i=1;i<=m;i=i+1)
    … …  
    31455633    }
    31465634    for (i=1;i<=n;i=i+1)
    3147     { I[n+i]=P[1,i]-z(i);
     5635    { I[m+i]=P[1,i]-z(i);
    31485636    }
    31495637    I=std(I);
    … …  
    31595647  }
    31605648  else
    3161   { "  ERROR:   <matrix_1> must have the same number of columns as the basering";
    3162     "           and both <matrix_1> and <matrix_2> may only have one row";
     5649  { "ERROR:   the first <matrix> must have the same number of columns as the";
     5650    "         basering and both <matrices> may only have one row";
    31635651    return();
    31645652  }
    31655653}
    31665654example
    3167 { "  EXAMPLE: Sturmfels: Algorithms in Invariant Theory 2.3.7:";
     5655{ "EXAMPLE: Sturmfels: Algorithms in Invariant Theory 2.3.7:";
    31685656  echo=2;
    3169            ring R=0,(x,y,z),dp;
    3170            matrix P[1][3]=x2+y2,z2,x4+y4;
    3171            matrix S[1][4]=1,x2z-1y2z,xyz,x3y-1xy3;
    3172            poly p1=(x2z-1y2z)*xyz;
    3173            module_con(p1,P,S);
    3174            poly p2=z;
    3175            module_con(p2,P,S);
     5657         ring R=0,(x,y,z),dp;
     5658         matrix P[1][3]=x2+y2,z2,x4+y4;
     5659         matrix S[1][4]=1,x2z-1y2z,xyz,x3y-1xy3;
     5660         poly p1=x10z3-x8y2z3+2x6y4z3-2x4y6z3+x2y8z3-y10z3+x6z4+3x4y2z4+3x2y4z4+y6z4;
     5661         module_containment(p1,P,S);
     5662         poly p2=z;
     5663         module_containment(p2,P,S);
    31765664}
    31775665
    3178 ////////////////////////////////////////////////////////////////////////////////
    3179 // 'orbit_var' calculates the syzygy ideal of the generators of the
    3180 // invariant ring, then eliminates the variables of the original ring and
    3181 // the polynomials that are left over define the orbit variety
    3182 ////////////////////////////////////////////////////////////////////////////////
    3183 proc orbit_var (matrix F,string newring)
    3184   USAGE:   orbit_var(<matrix>,<string>); <matrix> defines an invariant ring,
    3185            <string> is the name for a new ring
    3186   RETURN:  a Groebner basis (type <ideal>, named G) for the ideal defining the
    3187            orbit variety (i.e. the syzygy ideal) in the new ring (named
    3188            <string>)
    3189   EXAMPLE: example orbit_var; shows an example
     5666proc orbit_variety (matrix F,string newring)
     5667USAGE:   orbit_variety(F,s);
     5668         F: a 1xm <matrix> defing an invariant ring, s: a <string> giving the
     5669         name for a new ring
     5670RETURN:  a Groebner basis (type <ideal>, named G) for the ideal defining the
     5671         orbit variety (i.e. the syzygy ideal) in the new ring (named `s`)
     5672EXAMPLE: example orbit_variety; shows an example
     5673THEORY:  The ideal of algebraic relations of the invariant ring generators is
     5674         calculated, then the variables of the original ring are eliminated and
     5675         the polynomials that are left over define the orbit variety
    31905676{ if (newring=="")
    3191   { "  ERROR:   the second argument may not be an empty <string>";
     5677  { "ERROR:   the second parameter may not be an empty <string>";
    31925678    return();
    31935679  }
    … …  
    32195705  }
    32205706  else
    3221   { "  ERROR:   the <matrix> may only have one row";
     5707  { "ERROR:   the <matrix> may only have one row";
    32225708    return();
    32235709  }
    32245710}
    32255711example
    3226 { "  EXAMPLE: Sturmfels: Algorithms in Invariant Theory 2.3.7:";
     5712{ "EXAMPLE: Sturmfels: Algorithms in Invariant Theory 2.3.7:";
    32275713  echo=2;
    3228            ring R=0,(x,y,z),dp;
    3229            matrix F[1][7]=x2+y2,z2,x4+y4,1,x2z-1y2z,xyz,x3y-1xy3;
    3230            string newring="E";
    3231            orbit_var(F,newring);
    3232            print(G);
    3233            basering;
     5714         ring R=0,(x,y,z),dp;
     5715         matrix F[1][7]=x2+y2,z2,x4+y4,1,x2z-1y2z,xyz,x3y-1xy3;
     5716         string newring="E";
     5717         orbit_variety(F,newring);
     5718         print(G);
     5719         basering;
    32345720}
    32355721
    3236 ////////////////////////////////////////////////////////////////////////////////
    3237 // Let f1,...,fm be generators of the invariant ring, y1,...,ym new variables
    3238 // and h1,...,hk generators of I. 'rel_orbit_var'  computes a standard basis of
    3239 // the ideal generated by f1-y1,...,fm-ym with respect to a pure lexicographic
    3240 // order. Further, a standard basis of the the ideal generated by the elements
    3241 // of the previously found standard basis and h1,...,hk is found. Eliminating
    3242 // the original variables yields generators of the relative orbit variety with
    3243 // respect to I.
    3244 ////////////////////////////////////////////////////////////////////////////////
    3245 proc rel_orbit_var(ideal I,matrix F, string newring)
    3246   USAGE:   rel_orbit_var(<ideal>,<matrix>,<string>); <ideal> defines an
    3247            ideal invariant under the action of a group, <matrix> defines the
    3248            invariant ring of this group, <string> is a name for a new ring
    3249   RETURN:  a Groebner basis (type <ideal>, named G) for the ideal defining the
    3250            relative orbit variety with respect to <ideal> in the new ring (named
    3251            <string>)
    3252   EXAMPLE: example rel_orbit_var; shows an example
     5722proc relative_orbit_variety(ideal I,matrix F,string newring)
     5723USAGE:   relative_orbit_variety(I,F,s);
     5724         I: an <ideal> invariant under the action of a group, F: a 1xm
     5725         <matrix> defining the invariant ring of this group, s: a <string>
     5726         giving a name for a new ring
     5727RETURN:  a Groebner basis (type <ideal>, named G) for the ideal defining the
     5728         relative orbit variety with respect to I in the new ring (named s)
     5729EXAMPLE: example relative_orbit_variety; shows an example
     5730THEORY:  A Groebner basis of the ideal of algebraic relations of the invariant
     5731         ring generators is calculated, then one of the basis elements plus the
     5732         ideal generators. The variables of the original ring are eliminated and
     5733         the polynomials that are left over define thecrelative orbit variety
     5734         with respect to I.
    32535735{ if (newring=="")
    3254   { "  ERROR:   the third argument may not be empty a <string>";
    3255     return();
    3256   }
     5736  { "ERROR:   the third parameter may not be empty a <string>";
     5737    return();
     5738  }
     5739  degBound=0;
    32575740  if (nrows(F)==1)
    32585741  { def br=basering;
    … …  
    33015784  }
    33025785  else
    3303   { "  ERROR:   the <matrix> may only have one row";
     5786  { "ERROR:   the <matrix> may only have one row";
    33045787    return();
    33055788  }
    33065789}
    33075790example
    3308 { "  EXAMPLE: Sturmfels: Algorithms in Invariant Theory 2.6.3:";
     5791{ "EXAMPLE: Sturmfels: Algorithms in Invariant Theory 2.6.3:";
    33095792  echo=2;
    3310            ring R=0,(x,y,z),dp;
    3311            matrix F[1][3]=x+y+z,xy+xz+yz,xyz;
    3312            ideal I=x2+y2+z2-1,x2y+y2z+z2x-2x-2y-2z,xy2+yz2+zx2-2x-2y-2z;
    3313            string newring="E";
    3314            rel_orbit_var(I,F,newring);
    3315            print(G);
    3316            basering;
     5793         ring R=0,(x,y,z),dp;
     5794         matrix F[1][3]=x+y+z,xy+xz+yz,xyz;
     5795         ideal I=x2+y2+z2-1,x2y+y2z+z2x-2x-2y-2z,xy2+yz2+zx2-2x-2y-2z;
     5796         string newring="E";
     5797         relative_orbit_variety(I,F,newring);
     5798         print(G);
     5799         basering;
    33175800}
    33185801
    3319 ////////////////////////////////////////////////////////////////////////////////
    3320 // Let f1,...,fm be generators of the invariant ring, y1,...,ym new variables
    3321 // and h1,...,hk generators of I. 'im_of_var' calls 'rel_orbit_var' with input
    3322 // I, F and the string newring. In the output the variables y1,...,ym are
    3323 // replaced by f1,...,fm. The result is the output of 'im_of_var' and defines
    3324 // the variety under the matrix group.
    3325 ////////////////////////////////////////////////////////////////////////////////
    3326 proc im_of_var(ideal I,matrix F)
    3327   USAGE:   im_of_var(<ideal>,<matrix>); <ideal> is arbitrary, <matrix>
    3328            defines an invariant ring of a certain matrix group
    3329   RETURN:  the <ideal> defining the image of the variety defined by the input
    3330            ideal with respect to that group
    3331   EXAMPLE: example im_of_var; shows an example
     5802proc image_of_variety(ideal I,matrix F)
     5803USAGE:   image_of_variety(I,F);
     5804         I: an arbitray <ideal>, F: a 1xm <matrix> defining an invariant ring
     5805         of a some matrix group
     5806RETURN:  the <ideal> defining the image under that group of the variety defined
     5807         by I
     5808EXAMPLE: example image_of_variety; shows an example
     5809THEORY:  relative_orbit_variety(I,F,s) is called and the newly introduced
     5810         variables in the output are replaced by the generators of the
     5811         invariant ring. This ideal in the original variables defines the image
     5812         of the variety defined by I
    33325813{ if (nrows(F)==1)
    33335814  { def br=basering;
    33345815    int n=nvars(br);
    33355816    string newring="E";
    3336     rel_orbit_var(I,F,newring);
     5817    relative_orbit_variety(I,F,newring);
    33375818    execute "ring R=("+charstr(br)+"),("+varstr(br)+","+varstr(E)+"),lp;";
    33385819    ideal F=imap(br,F);
    … …  
    33455826  }
    33465827  else
    3347   { "  ERROR:   the <matrix> may only have one row";
     5828  { "ERROR:   the <matrix> may only have one row";
    33485829    return();
    33495830  }
    33505831}
    33515832example
    3352 { "  EXAMPLE: Sturmfels: Algorithms in Invariant Theory 2.6.8:";
     5833{ "EXAMPLE: Sturmfels: Algorithms in Invariant Theory 2.6.8:";
    33535834  echo=2;
    3354            ring R=0,(x,y,z),dp;
    3355            matrix F[1][3]=x+y+z,xy+xz+yz,xyz;
    3356            ideal I=xy;
    3357            print(im_of_var(I,F));
    3358 }
     5835         ring R=0,(x,y,z),dp;
     5836         matrix F[1][3]=x+y+z,xy+xz+yz,xyz;
     5837         ideal I=xy;
     5838         print(image_of_variety(I,F));
     5839}
Note: See TracChangeset for help on using the changeset viewer.