source: git/Singular/LIB/finvar.lib @ 558eb2

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