source: git/Singular/LIB/fpadim.lib @ 4cacf6

spielwiese
Last change on this file since 4cacf6 was 4cacf6, checked in by Viktor Levandovskyy <levandov@…>, 5 years ago
Update fpadim.lib removed ending semicolon in KEYWORDS
  • Property mode set to 100755
File size: 87.3 KB
Line 
1////////////////////////////////////////////////////////
2version="version fpadim.lib 4.1.1.4 Oct_2018 "; // $Id$
3category="Noncommutative";
4info="
5LIBRARY: fpadim.lib     Vector space dimension, basis and Hilbert series for finitely presented algebras (Letterplace)
6AUTHORS: Grischa Studzinski,       grischa.studzinski at rwth-aachen.de
7@*       Viktor Levandovskyy,      viktor.levandovskyy at math.rwth-aachen.de
8@*       Karim Abou Zeid,          karim.abou.zeid at rwth-aachen.de
9
10Support: Joint projects LE 2697/2-1 and KR 1907/3-1 of the Priority Programme SPP 1489:
11'Algorithmische und Experimentelle Methoden in Algebra, Geometrie und Zahlentheorie'
12of the German DFG (2010-2013)
13and Project II.6 of the transregional collaborative research centre
14SFB-TRR 195 'Symbolic Tools in Mathematics and their Application' of the German DFG  (from 2017 on)
15
16KEYWORDS: finitely presented algebra; Letterplace Groebner basis; K-basis; K-dimension; Hilbert series
17
18PROCEDURES:
19lpKDimCheck(G);            checks whether the K-dimension of A/<G> is finite
20lpKDim(G[,d,n]);           computes the K-dimension of A/<G>
21lpMonomialBasis(d, donly, J); computes a list of monomials not contained in J
22lpHilbert(G[,d,n]);        computes the truncated Hilbert series of A/<G>
23lpSickleDim(G[,d,n]);      computes the mistletoes and the K-dimension of A/<G>
24
25NOTE:
26- basering is a Letterplace ring
27- all intvecs correspond to Letterplace monomials
28- if a degree bound d is specified, d <= attrib(basering,uptodeg) holds
29
30In the procedures below, 'iv' stands for intvec representation
31and 'lp' for the letterplace representation of monomials
32
33OVERVIEW: Given the free associative algebra A = K<x_1,...,x_n> and a (finite) Groebner basis
34      GB = {g_1,..,g_w}, one is interested in the K-dimension and in the
35      explicit monomial K-basis of A/<GB>.
36      Therefore one is interested in the following data:
37      - the Ufnarovskij graph induced by GB
38      - the mistletoes of A/<GB> (special monomials in a basis)
39      - the K-dimension of A/<GB>
40      - the Hilbert series of A/<GB>
41
42@*      The Ufnarovskij graph is used to determine whether A/<GB> has finite
43@*      K-dimension. One has to check if the graph contains cycles.
44@*      For the whole theory we refer to [Ufn]. Given a
45@*      reduced set of monomials GB one can define the basis tree, whose vertex
46@*      set V consists of all normal monomials w.r.t. GB. For every two
47@*      monomials m_1, m_2 in V there is a direct edge from m_1 to m_2, if and
48@*      only if there exists x_k in {x_1,..,x_n}, such that m_1*x_k = m_2. The
49@*      set M = {m in V | there is no edge from m to another monomial in V} is
50@*      called the set of mistletoes. As one can easily see it consists of
51@*      the endpoints of the graph. Since there is a unique path to every
52@*      monomial in V the whole graph can be described only from the knowledge
53@*      of the mistletoes. Note that V corresponds to a basis of A/<GB>, so
54@*      knowing the mistletoes we know a K-basis. The name mistletoes was given
55@*      to those points because of these miraculous value and the algorithm is
56@*      named sickle, because a sickle is the tool to harvest mistletoes.
57@*      For more details see [Stu]. This package uses the Letterplace
58@*      format introduced by [LL]. The algebra can either be represented as a
59@*      Letterplace ring or via integer vectors: Every variable will only be
60@*      represented by its number, so variable one is represented as 1,
61@*      variable two as 2 and so on. The monomial x_1*x_3*x_2 for example will
62@*      be stored as (1,3,2). Multiplication is concatenation. Note that the
63@*      approach in this library does not need an algorithm for computing the normal
64@*      form yet. Note that fpa is an acronym for Finitely Presented Algebra.
65@*
66
67REFERENCES:
68@*   [Ufn] V. Ufnarovskij: Combinatorical and asymptotic methods in algebra, 1990.
69@*   [LL] R. La Scala, V. Levandovskyy: Letterplace ideals and non-commutative
70Groebner bases, Journal of Symbolic Computation, 2009.
71@*   [Stu] G. Studzinski: Dimension computations in non-commutative,
72associative algebras, Diploma thesis, RWTH Aachen, 2010.
73
74SEE ALSO: freegb_lib, fpaprops_lib, ncHilb_lib
75";
76
77// iv2lp, lp2iv etc not in HEADER because they should not be used anymore and will be removed in soon
78
79LIB "freegb.lib"; //for letterplace rings
80LIB "general.lib";//for sorting mistletoes
81
82/////////////////////////////////////////////////////////
83
84/* very fast and cheap test of consistency and functionality
85  DO NOT make it static !
86  after adding the new proc, add it here */
87proc tstfpadim()
88{
89  example ivDHilbert;
90  example ivDHilbertSickle;
91  example ivKDimCheck;
92  example ivHilbert;
93  example ivKDim;
94  example ivMis2Base;
95  example ivMis2Dim;
96  example ivOrdMisLex;
97  example ivSickle;
98  example ivSickleHil;
99  example ivSickleDim;
100  example lpDHilbert;
101  example lpDHilbertSickle;
102  example lpHilbert;
103  example lpKDimCheck;
104  example lpKDim;
105  example lpMis2Base;
106  example lpMis2Dim;
107  example lpOrdMisLex;
108  example lpSickle;
109  example lpSickleHil;
110  example lpSickleDim;
111  example sickle;
112  example ivL2lpI;
113  example iv2lp;
114  example iv2lpList;
115  example iv2lpMat;
116  example lp2iv;
117  example lp2ivId;
118  example lpId2ivLi;
119  example lpMonomialBasis;
120}
121
122
123//--------------- auxiliary procedures ------------------
124
125static proc allVars(list L, intvec P, int n)
126"USAGE: allVars(L,P,n); L a list of intmats, P an intvec, n an integer
127RETURN: int, 0 if all variables are contained in the quotient algebra, 1 otherwise
128"
129{int i,j,r;
130  intvec V;
131  for (i = 1; i <= size(P); i++) {if (P[i] == 1){ j = i; break;}}
132  V = L[j][1..nrows(L[j]),1];
133  for (i = 1; i <= n; i++) {if (isInVec(i,V) == 0) {r = 1; break;}}
134  if (r == 0) {return(1);}
135  else {return(0);}
136}
137
138static proc checkAssumptions(int d, list L)
139"PURPOSE: Checks, if all the Assumptions are holding
140"
141{if (attrib(basering,"isLetterplaceRing")==0) {ERROR("Basering is not a Letterplace ring!");}
142  if (d > attrib(basering,"uptodeg")) {ERROR("Specified degree bound exceeds ring parameter!");}
143  int i;
144  for (i = 1; i <= size(L); i++)
145  {if (entryViolation(L[i], attrib(basering,"isLetterplaceRing")))
146    {ERROR("Not allowed monomial/intvec found!");}
147  }
148  return();
149}
150
151static proc createStartMat(int d, int n)
152"USAGE: createStartMat(d,n); d, n integers
153RETURN: intmat
154PURPOSE:Creating the intmat with all normal monomials in n variables and of degree d to start with
155NOTE:   d has to be > 0
156"
157{intmat M[(n^d)][d];
158  int i1,i2,i3,i4;
159  for (i1 = 1; i1 <= d; i1++)  //Spalten
160  {i2 = 1; //durchlaeuft Zeilen
161    while (i2 <= (n^d))
162    {for (i3 = 1; i3 <= n; i3++)
163      {for (i4 = 1; i4 <= (n^(i1-1)); i4++)
164        {M[i2,i1] = i3;
165          i2 = i2 + 1;
166        }
167      }
168    }
169  }
170  return(M);
171}
172
173static proc createStartMat1(int n, intmat M)
174"USAGE: createStartMat1(n,M); n an integer, M an intmat
175RETURN: intmat, with all variables except those in M
176"
177{int i;
178  intvec V,Vt;
179  V = M[(1..nrows(M)),1];
180  for (i = 1; i <= size(V); i++) {if (isInVec(i,V) == 0) {Vt = Vt,i;}}
181  if (Vt == 0) {intmat S; return(S);}
182  else {Vt = Vt[2..size(Vt)]; intmat S [size(Vt)][1]; S[1..size(Vt),1] = Vt; return(S);}
183}
184
185static proc entryViolation(intmat M, int n)
186"PURPOSE:checks, if all entries in M are variable-related
187"
188{int i,j;
189  for (i = 1; i <= nrows(M); i++)
190  {for (j = 1; j <= ncols(M); j++)
191    {if(!((1<=M[i,j])&&(M[i,j]<=n))) {return(1);}}
192  }
193  return(0);
194}
195
196static proc findDimen(intvec V, int n, list L, intvec P, list #)
197"USAGE: findDimen(V,n,L,P,degbound); V,P intvecs, n, an integer, L a list,
198@*      degbound an optional integer
199RETURN: int
200PURPOSE:Compute the K-dimension of the quotient algebra
201"
202{int degbound = 0;
203  if (size(#) > 0) {if (#[1] > 0) {degbound = #[1];}}
204  int dimen,i,j,w,it;
205  intvec Vt,Vt2;
206  module M;
207  if (degbound == 0)
208  {for (i = 1; i <= n; i++)
209    {Vt = V, i; w = 0;
210      for (j = 1; j<= size(P); j++)
211      {if (P[j] <= size(Vt))
212        {Vt2 = Vt[(size(Vt)-P[j]+1)..size(Vt)];
213          if (isInMat(Vt2,L[j]) > 0) {w = 1; break;}
214        }
215      }
216      if (w == 0)
217      {vector Vtt;
218        for (it = 1; it <= size(Vt); it++){Vtt = Vtt + Vt[it]*gen(it);}
219        M = M,Vtt;
220        kill Vtt;
221      }
222    }
223    if (size(M) == 0) {return(0);}
224    else
225    {M = simplify(M,2);
226      for (i = 1; i <= size(M); i++)
227      {kill Vt; intvec Vt;
228        for (j =1; j <= size(M[i]); j++){Vt[j] =  int(leadcoef(M[i][j]));}
229        dimen = dimen + 1 + findDimen(Vt,n,L,P);
230      }
231      return(dimen);
232    }
233  }
234  else
235  {if (size(V) > degbound) {ERROR("monomial exceeds degreebound");}
236    if (size(V) == degbound) {return(0);}
237    for (i = 1; i <= n; i++)
238    {Vt = V, i; w = 0;
239      for (j = 1; j<= size(P); j++)
240      {if (P[j] <= size(Vt))
241        {Vt2 = Vt[(size(Vt)-P[j]+1)..size(Vt)];
242          if (isInMat(Vt2,L[j]) > 0) {w = 1; break;}
243        }
244      }
245      if (w == 0) {vector Vtt;
246        for (it = 1; it <= size(Vt); it++){Vtt = Vtt + Vt[it]*gen(it);}
247        M = M,Vtt;
248        kill Vtt;
249      }
250    }
251    if (size(M) == 0) {return(0);}
252    else
253    {M = simplify(M,2);
254      for (i = 1; i <= size(M); i++)
255      {kill Vt; intvec Vt;
256        for (j =1; j <= size(M[i]); j++){Vt[j] =  int(leadcoef(M[i][j]));}
257        dimen = dimen + 1 + findDimen(Vt,n,L,P,degbound);
258      }
259      return(dimen);
260    }
261  }
262}
263
264static proc findCycle(intvec V, list L, intvec P, int n, int ld, module M)
265"USAGE:
266RETURN: int, 1 if Ufn-graph contains a cycle, or 0 otherwise
267PURPOSE:Searching the Ufnarovskij graph for cycles
268"
269{int i,j,w,r;intvec Vt,Vt2;
270  int it, it2;
271  if (size(V) < ld)
272  {for (i = 1; i <= n; i++)
273    {Vt = V,i; w = 0;
274      for (j = 1; j <= size(P); j++)
275      {if (P[j] <= size(Vt))
276        {Vt2 = Vt[(size(Vt)-P[j]+1)..size(Vt)];
277          if (isInMat(Vt2,L[j]) > 0)
278          {w = 1; break;}
279        }
280      }
281      if (w == 0) {r = findCycle(Vt,L,P,n,ld,M);}
282      if (r == 1) {break;}
283    }
284    return(r);
285  }
286  else
287  {j = size(M);
288    if (j > 0)
289    {
290      intmat Mt[j][nrows(M)];
291      for (it = 1; it <= j; it++)
292      { for(it2 = 1; it2 <= nrows(M);it2++)
293        {Mt[it,it2] = int(leadcoef(M[it2,it]));}
294      }
295      Vt = V[(size(V)-ld+1)..size(V)];
296      //Mt; type(Mt);Vt;type(Vt);
297      if (isInMat(Vt,Mt) > 0) {return(1);}
298      else
299      {vector Vtt;
300        for (it =1; it <= size(Vt); it++)
301        {Vtt = Vtt + Vt[it]*gen(it);}
302        M = M,Vtt;
303        kill Vtt;
304        for (i = 1; i <= n; i++)
305        {Vt = V,i; w = 0;
306          for (j = 1; j <= size(P); j++)
307          {if (P[j] <= size(Vt))
308            {Vt2 = Vt[(size(Vt)-P[j]+1)..size(Vt)];
309              //L[j]; type(L[j]);Vt2;type(Vt2);
310              if (isInMat(Vt2,L[j]) > 0)
311              {w = 1; break;}
312            }
313          }
314          if (w == 0) {r = findCycle(Vt,L,P,n,ld,M);}
315          if (r == 1) {break;}
316        }
317        return(r);
318      }
319    }
320    else
321    { Vt = V[(size(V)-ld+1)..size(V)];
322      vector Vtt;
323      for (it = 1; it <= size(Vt); it++)
324      {Vtt = Vtt + Vt[it]*gen(it);}
325      M = Vtt;
326      kill Vtt;
327      for (i = 1; i <= n; i++)
328      {Vt = V,i; w = 0;
329        for (j = 1; j <= size(P); j++)
330        {if (P[j] <= size(Vt))
331          {Vt2 = Vt[(size(Vt)-P[j]+1)..size(Vt)];
332            //L[j]; type(L[j]);Vt2;type(Vt2);
333            if (isInMat(Vt2,L[j]) > 0)
334            {w = 1; break;}
335          }
336        }
337        if (w == 0) {r = findCycle(Vt,L,P,n,ld,M);}
338        if (r == 1) {break;}
339      }
340      return(r);
341    }
342  }
343}
344
345
346static proc findCycleDFS(int i, intmat T, intvec V)
347"
348PURPOSE:
349this is a classical deep-first search for cycles contained in a graph given by an intmat
350"
351{
352  intvec rV;
353  int k,k1,t;
354  int j = V[size(V)];
355  if (T[j,i] > 0) {return(V);}
356  else
357  {
358    for (k = 1; k <= ncols(T); k++)
359    {
360      t = 0;
361      if (T[j,k] > 0)
362      {
363        for (k1 = 1; k1 <= size(V); k1++) {if (V[k1] == k) {t = 1; break;}}
364        if (t == 0)
365        {
366          rV = V;
367          rV[size(rV)+1] = k;
368          rV = findCycleDFS(i,T,rV);
369          if (rV[1] > -1) {return(rV);}
370        }
371      }
372    }
373  }
374  return(intvec(-1));
375}
376
377
378
379static proc findHCoeff(intvec V,int n,list L,intvec P,intvec H,list #)
380"USAGE: findHCoeff(V,n,L,P,H,degbound); L a list of intmats, degbound an integer
381RETURN: intvec
382PURPOSE:Compute the coefficient of the Hilbert series (upto degree degbound)
383NOTE:   Starting with a part of the Hilbert series we change the coefficient
384@*      depending on how many basis elements we found on the actual branch
385"
386{int degbound = 0;
387  if (size(#) > 0){if (#[1] > 0){degbound = #[1];}}
388  int i,w,j,it;
389  int h1 = 0;
390  intvec Vt,Vt2,H1;
391  module M;
392  if (degbound == 0)
393  {for (i = 1; i <= n; i++)
394    {Vt = V, i; w = 0;
395      for (j = 1; j<= size(P); j++)
396      {if (P[j] <= size(Vt))
397        {Vt2 = Vt[(size(Vt)-P[j]+1)..size(Vt)];
398          if (isInMat(Vt2,L[j]) > 0) {w = 1; break;}
399        }
400      }
401      if (w == 0)
402      {vector Vtt;
403        for (it = 1; it <= size(Vt); it++){Vtt = Vtt + Vt[it]*gen(it);}
404        M = M,Vtt;
405        kill Vtt;
406      }
407    }
408    if (size(M) == 0) {return(H);}
409    else
410    {M = simplify(M,2);
411      for (i = 1; i <= size(M); i++)
412      {kill Vt; intvec Vt;
413        for (j =1; j <= size(M[i]); j++) {Vt[j] =  int(leadcoef(M[i][j]));}
414        h1 = h1 + 1; H1 = findHCoeff(Vt,n,L,P,H1);
415      }
416      if (size(H1) < (size(V)+2)) {H1[(size(V)+2)] = h1;}
417      else {H1[(size(V)+2)] = H1[(size(V)+2)] + h1;}
418      H1 = H1 + H;
419      return(H1);
420    }
421  }
422  else
423  {if (size(V) > degbound) {ERROR("monomial exceeds degreebound");}
424    if (size(V) == degbound) {return(H);}
425    for (i = 1; i <= n; i++)
426    {Vt = V, i; w = 0;
427      for (j = 1; j<= size(P); j++)
428      {if (P[j] <= size(Vt))
429        {Vt2 = Vt[(size(Vt)-P[j]+1)..size(Vt)];
430          if (isInMat(Vt2,L[j]) > 0) {w = 1; break;}
431        }
432      }
433      if (w == 0)
434      {vector Vtt;
435        for (it = 1; it <= size(Vt); it++){Vtt = Vtt + Vt[it]*gen(it);}
436        M = M,Vtt;
437        kill Vtt;
438      }
439    }
440    if (size(M) == 0) {return(H);}
441    else
442    {M = simplify(M,2);
443      for (i = 1; i <= size(M); i++)
444      {kill Vt; intvec Vt;
445        for (j =1; j <= size(M[i]); j++)
446        {Vt[j] =  int(leadcoef(M[i][j]));}
447        h1 = h1 + 1; H1 = findHCoeff(Vt,n,L,P,H1,degbound);
448      }
449      if (size(H1) < (size(V)+2)) { H1[(size(V)+2)] = h1;}
450      else {H1[(size(V)+2)] = H1[(size(V)+2)] + h1;}
451      H1 = H1 + H;
452      return(H1);
453    }
454  }
455}
456
457static proc findHCoeffMis(intvec V, int n, list L, intvec P, list R,list #)
458"USAGE: findHCoeffMis(V,n,L,P,R,degbound); degbound an optional integer, L a
459@*      list of Intmats, R
460RETURN: list
461PURPOSE:Compute the coefficients of the Hilbert series and the Mistletoes all
462@*      at once
463"
464{int degbound = 0;
465  if (size(#) > 0) {if (#[1] > 0) {degbound = #[1];}}
466  int i,w,j,h1;
467  intvec Vt,Vt2,H1; int it;
468  module M;
469  if (degbound == 0)
470  {for (i = 1; i <= n; i++)
471    {Vt = V, i; w = 0;
472      for (j = 1; j<= size(P); j++)
473      {if (P[j] <= size(Vt))
474        {Vt2 = Vt[(size(Vt)-P[j]+1)..size(Vt)];
475          if (isInMat(Vt2,L[j]) > 0) {w = 1; break;}
476        }
477      }
478      if (w == 0)
479      {vector Vtt;
480        for (it = 1; it <= size(Vt); it++){Vtt = Vtt + Vt[it]*gen(it);}
481        M = M,Vtt;
482        kill Vtt;
483      }
484    }
485    if (size(M) == 0) {if (size(R) < 2){R[2] = list(V);} else {R[2] = R[2] + list(V);} return(R);}
486    else
487    {M = simplify(M,2);
488      for (i = 1; i <= size(M); i++)
489      {kill Vt; intvec Vt;
490        for (j =1; j <= size(M[i]); j++)
491        {Vt[j] =  int(leadcoef(M[i][j]));}
492        if (size(R[1]) < (size(V)+2)) { R[1][(size(V)+2)] = 1;}
493        else
494        {R[1][(size(V)+2)] = R[1][(size(V)+2)] + 1;}
495        R = findHCoeffMis(Vt,n,L,P,R);
496      }
497      return(R);
498    }
499  }
500  else
501  {if (size(V) > degbound) {ERROR("monomial exceeds degreebound");}
502    if (size(V) == degbound)
503    {if (size(R) < 2){R[2] = list (V);}
504      else{R[2] = R[2] + list (V);}
505      return(R);
506    }
507    for (i = 1; i <= n; i++)
508    {Vt = V, i; w = 0;
509      for (j = 1; j<= size(P); j++)
510      {if (P[j] <= size(Vt))
511        {Vt2 = Vt[(size(Vt)-P[j]+1)..size(Vt)];
512          if (isInMat(Vt2,L[j]) > 0) {w = 1; break;}
513        }
514      }
515      if (w == 0)
516      {vector Vtt;
517        for (it = 1; it <= size(Vt); it++){Vtt = Vtt + Vt[it]*gen(it);}
518        M = M,Vtt;
519        kill Vtt;
520      }
521    }
522    if (size(M) == 0) {if (size(R) < 2){R[2] = list(V);} else {R[2] = R[2] + list(V);} return(R);}
523    else
524    {M = simplify(M,2);
525      for (i = 1; i <= ncols(M); i++)
526      {kill Vt; intvec Vt;
527        for (j =1; j <= size(M[i]); j++)
528        {Vt[j] =  int(leadcoef(M[i][j]));}
529        if (size(R[1]) < (size(V)+2)) { R[1][(size(V)+2)] = 1;}
530        else
531        {R[1][(size(V)+2)] = R[1][(size(V)+2)] + 1;}
532        R = findHCoeffMis(Vt,n,L,P,R,degbound);
533      }
534      return(R);
535    }
536  }
537}
538
539
540static proc findMisDim(intvec V,int n,list L,intvec P,list R,list #)
541"USAGE:
542RETURN: list
543PURPOSE:Compute the K-dimension and the Mistletoes all at once
544"
545{int degbound = 0;
546  if (size(#) > 0) {if (#[1] > 0) {degbound = #[1];}}
547  int dimen,i,j,w;
548  intvec Vt,Vt2; int it;
549  module M;
550  if (degbound == 0)
551  {for (i = 1; i <= n; i++)
552    {Vt = V, i; w = 0;
553      for (j = 1; j<= size(P); j++)
554      {if (P[j] <= size(Vt))
555        {Vt2 = Vt[(size(Vt)-P[j]+1)..size(Vt)];
556          if (isInMat(Vt2,L[j]) > 0) {w = 1; break;}
557        }
558      }
559      if (w == 0)
560      {vector Vtt;
561        for (it = 1; it <= size(Vt); it++){Vtt = Vtt + Vt[it]*gen(it);}
562        M = M,Vtt;
563        kill Vtt;
564      }
565    }
566    if (size(M) == 0)
567    {if (size(R) < 2){R[2] = list (V);}
568      else{R[2] = R[2] + list(V);}
569      return(R);
570    }
571    else
572    {M = simplify(M,2);
573      for (i = 1; i <= size(M); i++)
574      {kill Vt; intvec Vt;
575        for (j =1; j <= size(M[i]); j++){Vt[j] =  int(leadcoef(M[i][j]));}
576        R[1] = R[1] + 1; R = findMisDim(Vt,n,L,P,R);
577      }
578      return(R);
579    }
580  }
581  else
582  {if (size(V) > degbound) {ERROR("monomial exceeds degreebound");}
583    if (size(V) == degbound)
584    {if (size(R) < 2){R[2] = list (V);}
585      else{R[2] = R[2] + list (V);}
586      return(R);
587    }
588    for (i = 1; i <= n; i++)
589    {Vt = V, i; w = 0;
590      for (j = 1; j<= size(P); j++)
591      {if (P[j] <= size(Vt))
592        {Vt2 = Vt[(size(Vt)-P[j]+1)..size(Vt)];
593          if (isInMat(Vt2,L[j]) > 0) {w = 1; break;}
594        }
595      }
596      if (w == 0)
597      {vector Vtt;
598        for (it = 1; it <= size(Vt); it++){Vtt = Vtt + Vt[it]*gen(it);}
599        M = M,Vtt;
600        kill Vtt;
601      }
602    }
603    if (size(M) == 0)
604    {if (size(R) < 2){R[2] = list (V);}
605      else{R[2] = R[2] + list(V);}
606      return(R);
607    }
608    else
609    {M = simplify(M,2);
610      for (i = 1; i <= size(M); i++)
611      {kill Vt; intvec Vt;
612        for (j =1; j <= size(M[i]); j++){Vt[j] =  int(leadcoef(M[i][j]));}
613        R[1] = R[1] + 1; R = findMisDim(Vt,n,L,P,R,degbound);
614      }
615      return(R);
616    }
617  }
618}
619
620
621static proc findmistletoes(intvec V, int n, list L, intvec P, list #)
622"USAGE: findmistletoes(V,n,L,P,degbound); V a normal word, n the number of
623@*      variables, L the GB, P the occuring degrees,
624@*      and degbound the (optional) degreebound
625RETURN:  list
626PURPOSE:Compute mistletoes starting in V
627NOTE:   V has to be normal w.r.t. L, it will not be checked for being so
628"
629{int degbound = 0;
630  if (size(#) > 0) {if (#[1] > 0) {degbound = #[1];}}
631  list R; intvec Vt,Vt2; int it;
632  int i,j;
633  module M;
634  if (degbound == 0)
635  {int w;
636    for (i = 1; i <= n; i++)
637    {Vt = V,i; w = 0;
638      for (j = 1; j <= size(P); j++)
639      {if (P[j] <= size(Vt))
640        {Vt2 = Vt[(size(Vt)-P[j]+1)..size(Vt)];
641          if (isInMat(Vt2,L[j]) > 0)
642          {w = 1; break;}
643        }
644      }
645      if (w == 0)
646      {vector Vtt;
647        for (it = 1; it <= size(Vt); it++){Vtt = Vtt + Vt[it]*gen(it);}
648        M = M,Vtt;
649        kill Vtt;
650      }
651    }
652    if (size(M)==0) {R = V; return(R);}
653    else
654    {M = simplify(M,2);
655      for (i = 1; i <= size(M); i++)
656      {kill Vt; intvec Vt;
657        for (j =1; j <= size(M[i]); j++){Vt[j] =  int(leadcoef(M[i][j]));}
658        R = R + findmistletoes(Vt,n,L,P);
659      }
660      return(R);
661    }
662  }
663  else
664  {if (size(V) > degbound) {ERROR("monomial exceeds degreebound");}
665    if (size(V) == degbound) {R = V; return(R);}
666    int w;
667    for (i = 1; i <= n; i++)
668    {Vt = V,i; w = 0;
669      for (j = 1; j <= size(P); j++)
670      {if (P[j] <= size(Vt))
671        {Vt2 = Vt[(size(Vt)-P[j]+1)..size(Vt)];
672          if (isInMat(Vt2,L[j]) > 0){w = 1; break;}
673        }
674      }
675      if (w == 0)
676      {vector Vtt;
677        for (it = 1; it <= size(Vt); it++){Vtt = Vtt + Vt[it]*gen(it);}
678        M = M,Vtt;
679        kill Vtt;
680      }
681    }
682    if (size(M) == 0) {R = V; return(R);}
683    else
684    {M = simplify(M,2);
685      for (i = 1; i <= ncols(M); i++)
686      {kill Vt; intvec Vt;
687        for (j =1; j <= size(M[i]); j++)
688        {Vt[j] =  int(leadcoef(M[i][j]));}
689        //Vt; typeof(Vt); size(Vt);
690        R = R + findmistletoes(Vt,n,L,P,degbound);
691      }
692      return(R);
693    }
694  }
695}
696
697static proc growthAlg(intmat T, list #)
698"
699real algorithm for checking the growth of an algebra
700"
701{
702  int s = 1;
703  if (size(#) > 0) { s = #[1];}
704  int j;
705  int n = ncols(T);
706  intvec NV,C; NV[n] = 0; int m,i;
707  intmat T2[n][n] = T[1..n,1..n]; intmat N[n][n];
708  if (T2 == N)
709  {
710    for (i = 1; i <= n; i++)
711    {
712      if (m <  T[n+1,i]) { m = T[n+1,i];}
713    }
714    return(m);
715  }
716
717  //first part: the diagonals
718  for (i = s; i <= n; i++)
719  {
720    if (T[i,i] > 0)
721    {
722      if ((T[i,i] >= 1) && (T[n+1,i] > 0)) {return(-1);}
723      if ((T[i,i] == 1) && (T[n+1,i] == 0))
724      {
725        T[i,i] = 0;
726        T[n+1,i] = 1;
727        return(growthAlg(T));
728      }
729    }
730  }
731
732  //second part: searching for the last but one vertices
733  T2 = T2*T2;
734  for (i = s; i <= n; i++)
735  {
736    if ((intvec(T[i,1..n]) <> intvec(0)) && (intvec(T2[i,1..n]) == intvec(0)))
737    {
738      for (j = 1; j <= n; j++)
739      {
740        if ((T[i,j] > 0) && (m < T[n+1,j])) {m = T[n+1,j];}
741      }
742      T[n+1,i] = T[n+1,i] + m;
743      T[i,1..n] = NV;
744      return(growthAlg(T));
745    }
746  }
747  m = 0;
748
749  //third part: searching for circles
750  for (i = s; i <= n; i++)
751  {
752    T2 = T[1..n,1..n];
753    C = findCycleDFS(i,T2, intvec(i));
754    if (C[1] > 0)
755    {
756      for (j = 2; j <= size(C); j++)
757      {
758        T[i,1..n] = T[i,1..n] + T[C[j],1..n];
759        T[C[j],1..n] = NV;
760      }
761      for (j = 2; j <= size(C); j++)
762      {
763        T[1..n,i] = T[1..n,i] + T[1..n,C[j]];
764        T[1..n,C[j]] = NV;
765      }
766      T[i,i] = T[i,i] - size(C) + 1;
767      m = 0;
768      for (j = 1; j <= size(C); j++)
769      {
770        m = m + T[n+1,C[j]];
771      }
772      for (j = 1; j <= size(C); j++)
773      {
774        T[n+1,C[j]] = m;
775      }
776      return(growthAlg(T,i));
777    }
778    else {ERROR("No Cycle found, something seems wrong! Please contact the authors.");}
779  }
780
781  m = 0;
782  for (i = 1; i <= n; i++)
783  {
784    if (m < T[n+1,i])
785    {
786      m = T[n+1,i];
787    }
788  }
789  return(m);
790}
791
792static proc GlDimSuffix(intvec v, intvec g)
793{
794  //Computes the shortest r such that g is a suffix for vr
795  //only valid for lex orderings?
796  intvec r,gt,vt,lt,g2;
797  int lg,lv,l,i,c,f;
798  lg = size(g); lv = size(v);
799  if (lg <= lv)
800  {
801    l = lv-lg;
802  }
803  else
804  {
805    l = 0; g2 = g[(lv+1)..lg];
806    g = g[1..lv]; lg = size(g);
807    c = 1;
808  }
809  while (l < lv)
810  {
811    vt = v[(l+1)..lv];
812    gt = g[1..(lv-l)];
813    lt = size(gt);
814    for (i = 1; i <= lt; i++)
815    {
816      if (vt[i]<>gt[i]) {l++; break;}
817    }
818    if (lt <=i ) { f = 1; break;}
819  }
820  if (f == 0) {return(g);}
821  r = g[(lv-l+1)..lg];
822  if (c == 1) {r = r,g2;}
823  return(r);
824}
825
826static proc isNormal(intvec V, list G)
827{
828  int i,j,k,l;
829  k = 0;
830  for (i = 1; i <= size(G); i++)
831  {
832    if ( size(G[i]) <= size(V) )
833    {
834      while ( size(G[i])+k <= size(V) )
835      {
836        if ( G[i] == V[(1+k)..size(V)] ) {return(1);}
837      }
838    }
839  }
840  return(0);
841}
842
843static proc findDChain(list L)
844{
845  list Li; int i,j;
846  for (i = 1; i <= size(L); i++) {Li[i] = size(L[i]);}
847  Li = sort(Li); Li = Li[1];
848  return(Li[size(Li)]);
849}
850
851static proc isInList(intvec V, list L)
852"USAGE: isInList(V,L); V an intvec, L a list of intvecs
853RETURN: int
854PURPOSE:Finding the position of V in L, returns 0, if V is not in M
855"
856{int i,n;
857  n = 0;
858  for (i = 1; i <= size(L); i++) {if (L[i] == V) {n = i; break;}}
859  return(n);
860}
861
862static proc isInMat(intvec V, intmat M)
863"USAGE: isInMat(V,M);V an intvec, M an intmat
864RETURN: int
865PURPOSE:Finding the position of V in M, returns 0, if V is not in M
866"
867{if (size(V) <> ncols(M)) {return(0);}
868  int i;
869  intvec Vt;
870  for (i = 1; i <= nrows(M); i++)
871  {Vt = M[i,1..ncols(M)];
872    if ((V-Vt) == 0){return(i);}
873  }
874  return(0);
875}
876
877static proc isInVec(int v,intvec V)
878"USAGE: isInVec(v,V); v an integer,V an intvec
879RETURN: int
880PURPOSE:Finding the position of v in V, returns 0, if v is not in V
881"
882{int i,n;
883  n = 0;
884  for (i = 1; i <= size(V); i++) {if (V[i] == v) {n = i; break;}}
885  return(n);
886}
887
888
889static proc isPF(intvec P, intvec I)
890"
891PURPOSE:
892checks, if a word P is a praefix of another word I
893"
894{
895  int n = size(P);
896  if (n <= 0 || P == 0) {return(1);}
897  if (size(I) < n) {return(0);}
898  intvec IP = I[1..n];
899  if (IP == P) {return(1);}
900  else {return(0);}
901}
902
903proc ivL2lpI(list L)
904"USAGE: ivL2lpI(L); L a list of intvecs (deprecated, will be removed soon)
905RETURN: ideal
906PURPOSE:Transforming a list of intvecs into an ideal of Letterplace monomials
907ASSUME: - Intvec corresponds to a Letterplace monomial
908@*      - basering has to be a Letterplace ring
909NOTE:   - Assumptions will not be checked!
910EXAMPLE: example ivL2lpI; shows examples
911"
912{
913  int i; ideal G;
914  poly p;
915  for (i = 1; i <= size(L); i++)
916  {p = iv2lp(L[i]);
917    G[(size(G) + 1)] = p;
918  }
919  return(G);
920}
921example
922{
923  "EXAMPLE:"; echo = 2;
924  ring r = 0,(x,y,z),dp;
925  def R = makeLetterplaceRing(5);// constructs a Letterplace ring
926  setring R; //sets basering to Letterplace ring
927  intvec u = 1,1,2; intvec v = 2,1,3; intvec w = 3,1,1;
928  // u = x^2y, v = yxz, w = zx^2 in intvec representation
929  list L = u,v,w;
930  ivL2lpI(L);// invokes the procedure, returns the ideal containing u,v,w
931}
932
933proc iv2lp(intvec I)
934"USAGE: iv2lp(I); I an intvec (deprecated, will be removed soon)
935RETURN: poly
936PURPOSE:Transforming an intvec into the corresponding Letterplace polynomial
937ASSUME: - Intvec corresponds to a Letterplace monomial
938@*      - basering has to be a Letterplace ring
939NOTE:   - Assumptions will not be checked!
940EXAMPLE: example iv2lp; shows examples
941"
942{if (I[1] == 0) {return(1);}
943  int i = size(I);
944  if (i > attrib(basering,"uptodeg")) {ERROR("polynomial exceeds degreebound");}
945  int j; poly p = 1;
946  for (j = 1; j <= i; j++) {if (I[j] > 0) { p = p*var(I[j]);}} //ignore zeroes, because they correspond to 1
947  return(p);
948}
949example
950{
951  "EXAMPLE:"; echo = 2;
952  ring r = 0,(x,y,z),dp;
953  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
954  setring R; //sets basering to Letterplace ring
955  intvec u = 1,1,2; intvec v = 2,1,3; intvec w = 3,1,1;
956  // u = x^2y, v = yxz, w = zx^2 in intvec representation
957  iv2lp(u); // invokes the procedure and returns the corresponding poly
958  iv2lp(v);
959  iv2lp(w);
960}
961
962proc iv2lpList(list L)
963"USAGE: iv2lpList(L); L a list of intmats (deprecated, will be removed soon)
964RETURN: ideal
965PURPOSE:Converting a list of intmats into an ideal of corresponding monomials
966ASSUME: - The rows of each intmat in L must correspond to a Letterplace monomial
967@*      - basering has to be a Letterplace ring
968EXAMPLE: example iv2lpList; shows examples
969"
970{checkAssumptions(0,L);
971  ideal G;
972  int i;
973  for (i = 1; i <= size(L); i++){G = G + iv2lpMat(L[i]);}
974  return(G);
975}
976example
977{
978  "EXAMPLE:"; echo = 2;
979  ring r = 0,(x,y,z),dp;
980  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
981  setring R; // sets basering to Letterplace ring
982  intmat u[3][1] = 1,1,2; intmat v[1][3] = 2,1,3; intmat w[2][3] = 3,1,1,2,3,1;
983  // defines intmats of different size containing intvec representations of
984  // monomials as rows
985  list L = u,v,w;
986  print(u); print(v); print(w); // shows the intmats contained in L
987  iv2lpList(L); // returns the corresponding monomials as an ideal
988}
989
990
991proc iv2lpMat(intmat M)
992"USAGE: iv2lpMat(M); M an intmat (deprecated, will be removed soon)
993RETURN: ideal
994PURPOSE:Converting an intmat into an ideal of the corresponding monomials
995ASSUME: - The rows of M must correspond to Letterplace monomials
996@*      - basering has to be a Letterplace ring
997EXAMPLE: example iv2lpMat; shows examples
998"
999{list L = M;
1000  checkAssumptions(0,L);
1001  kill L;
1002  ideal G; poly p;
1003  int i; intvec I;
1004  for (i = 1; i <= nrows(M); i++)
1005  { I = M[i,1..ncols(M)];
1006    p = iv2lp(I);
1007    G[size(G)+1] = p;
1008  }
1009  return(G);
1010}
1011example
1012{
1013  "EXAMPLE:"; echo = 2;
1014  ring r = 0,(x,y,z),dp;
1015  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
1016  setring R; // sets basering to Letterplace ring
1017  intmat u[3][1] = 1,1,2; intmat v[1][3] = 2,1,3; intmat w[2][3] = 3,1,1,2,3,1;
1018  // defines intmats of different size containing intvec representations of
1019  // monomials as rows
1020  iv2lpMat(u); // returns the monomials contained in u
1021  iv2lpMat(v); // returns the monomials contained in v
1022  iv2lpMat(w); // returns the monomials contained in w
1023}
1024
1025proc lpId2ivLi(ideal G)
1026"USAGE: lpId2ivLi(G); G an ideal (deprecated, will be removed soon)
1027RETURN: list
1028PURPOSE:Transforming an ideal into the corresponding list of intvecs
1029ASSUME: - basering has to be a Letterplace ring
1030EXAMPLE: example lpId2ivLi; shows examples
1031"
1032{
1033  int i,j,k;
1034  list M;
1035  checkAssumptions(0,M);
1036  for (i = 1; i <= size(G); i++) {M[i] = lp2iv(G[i]);}
1037  return(M);
1038}
1039example
1040{
1041  "EXAMPLE:"; echo = 2;
1042  ring r = 0,(x,y),dp;
1043  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
1044  setring R; // sets basering to Letterplace ring
1045  ideal L = x*x,y*y,x*y*x;
1046  lpId2ivLi(L); // returns the corresponding intvecs as a list
1047}
1048
1049proc lp2iv(poly p)
1050"USAGE: lp2iv(p); p a poly (deprecated, will be removed soon)
1051RETURN: intvec
1052PURPOSE:Transforming a monomial into the corresponding intvec
1053ASSUME: - basering has to be a Letterplace ring
1054NOTE:   - Assumptions will not be checked!
1055EXAMPLE: example lp2iv; shows examples
1056"
1057{p = normalize(lead(p));
1058  intvec I;
1059  int i,j;
1060  if (deg(p) > attrib(basering,"uptodeg")) {ERROR("Monomial exceeds degreebound");}
1061  if (p == 1) {return(I);}
1062  if (p == 0) {ERROR("Monomial is not allowed to equal zero");}
1063  intvec lep = leadexp(p);
1064  for ( i = 1; i <= attrib(basering,"isLetterplaceRing"); i++) {if (lep[i] == 1) {I = i; break;}}
1065  for (i = (attrib(basering,"isLetterplaceRing")+1); i <= size(lep); i++)
1066  {if (lep[i] == 1)
1067    { j = (i mod attrib(basering,"isLetterplaceRing"));
1068      if (j == 0) {I = I,attrib(basering,"isLetterplaceRing");}
1069      else {I = I,j;}
1070    }
1071    else { if (lep[i] > 1) {ERROR("monomial has a not allowed multidegree");}}
1072  }
1073  if (I[1] == 0) {ERROR("monomial has a not allowed multidegree");}
1074
1075  return(I);
1076}
1077example
1078{
1079  "EXAMPLE:"; echo = 2;
1080  ring r = 0,(x,y,z),dp;
1081  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
1082  setring R; // sets basering to Letterplace ring
1083  poly p = x*x*z; poly q = y*y*x*x;
1084  poly w= z*y*x*z*z;
1085  // p,q,w are some polynomials we want to transform into their
1086  // intvec representation
1087  lp2iv(p); lp2iv(q); lp2iv(w);
1088}
1089
1090proc lp2ivId(ideal G)
1091"USAGE: lp2ivId(G); G an ideal (deprecated, will be removed soon)
1092RETURN: list
1093PURPOSE:Converting an ideal into an list of intmats,
1094@*      the corresponding intvecs forming the rows
1095ASSUME: - basering has to be a Letterplace ring
1096EXAMPLE: example lp2ivId; shows examples
1097"
1098{G = normalize(lead(G));
1099  intvec I; list L;
1100  checkAssumptions(0,L);
1101  int i,md;
1102  for (i = 1; i <= size(G); i++) { if (md <= deg(G[i])) {md = deg(G[i]);}}
1103  while (size(G) > 0)
1104  {ideal Gt;
1105    for (i = 1; i <= ncols(G); i++) {if (md == deg(G[i])) {Gt = Gt + G[i]; G[i] = 0;}}
1106    if (size(Gt) > 0)
1107    {G = simplify(G,2);
1108      intmat M [size(Gt)][md];
1109      for (i = 1; i <= size(Gt); i++) {M[i,1..md] = lp2iv(Gt[i]);}
1110      L = insert(L,M);
1111      kill M; kill Gt;
1112      md = md - 1;
1113    }
1114    else {kill Gt; md = md - 1;}
1115  }
1116  return(L);
1117}
1118example
1119{
1120  "EXAMPLE:"; echo = 2;
1121  ring r = 0,(x,y,z),dp;
1122  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
1123  setring R; // sets basering to Letterplace ring
1124  poly p = x*x*z; poly q = y*y*x*x;
1125  poly w = z*y*x*z;
1126  // p,q,w are some polynomials we want to transform into their
1127  // intvec representation
1128  ideal G = p,q,w;
1129  // define the ideal containing p,q and w
1130  lp2ivId(G); // and return the list of intmats for this ideal
1131}
1132
1133// -----------------main procedures----------------------
1134
1135static proc lpGraphOfNormalWords(ideal G)
1136"USAGE: lpGraphOfNormalWords(G); G a set of monomials in a letterplace ring
1137RETURN: intmat
1138PURPOSE: Constructs the graph of normal words induced by G
1139@*:      the adjacency matrix of the graph of normal words induced by G
1140ASSUME: - basering is a Letterplace ring
1141- G are the leading monomials of a Groebner basis
1142"
1143{
1144  // construct the Graph of normal words [Studzinski page 78]
1145  // construct set of vertices
1146  int v = attrib(basering,"isLetterplaceRing"); int d = attrib(basering,"uptodeg");
1147  ideal V; poly p,q,w;
1148  ideal LG = lead(G);
1149  int i,j,k,b; intvec E,Et;
1150  for (i = 1; i <= v; i++){V = V, var(i);}
1151  for (i = 1; i <= size(LG); i++)
1152  {
1153    E = leadexp(LG[i]);
1154    if (E == intvec(0)) {V = V,monomial(intvec(0));}
1155    else
1156    {
1157      for (j = 1; j < d; j++)
1158      {
1159        Et = E[(j*v+1)..(d*v)];
1160        if (Et == intvec(0)) {break;}
1161        else {V = V, monomial(Et);}
1162      }
1163    }
1164  }
1165  V = simplify(V,2+4);
1166  printf("V = %p", V);
1167
1168
1169  // construct incidence matrix
1170
1171  list LV = lpId2ivLi(V);
1172  intvec Ip,Iw;
1173  int n = size(V);
1174  intmat T[n+1][n];
1175  for (i = 1; i <= n; i++)
1176  {
1177    // printf("for1 (i=%p, n=%p)", i, n);
1178    p = V[i]; Ip = lp2iv(p);
1179    for (j = 1; j <= n; j++)
1180    {
1181      // printf("for2 (j=%p, n=%p)", j, n);
1182      k = 1; b = 1;
1183      q = V[j];
1184      w = lpNF(p*q,LG);
1185      if (w <> 0)
1186      {
1187        Iw = lp2iv(w);
1188        while (k <= n)
1189        {
1190          // printf("while (k=%p, n=%p)", k, n);
1191          if (isPF(LV[k],Iw) > 0)
1192          {if (isPF(LV[k],Ip) == 0) {b = 0; k = n+1;} else {k++;}
1193          }
1194          else {k++;}
1195        }
1196        T[i,j] = b;
1197        //  print("Incidence Matrix:");
1198        // print(T);
1199      }
1200    }
1201  }
1202  return(T);
1203}
1204
1205// This proc is deprecated, see lpGkDim() in fpaprops.lib
1206/* proc lpGkDim(ideal G) */
1207/* "USAGE: lpGkDim(G); G an ideal in a letterplace ring */
1208/* RETURN: int */
1209/* PURPOSE: Determines the Gelfand Kirillov dimension of A/<G> */
1210/* @*:     -1 means it is infinite */
1211/* ASSUME: - basering is a Letterplace ring */
1212/* - G is a Groebner basis */
1213/* NOTE: see fpaprops.lib for a faster and more up to date version of this method */
1214/* " */
1215/* { */
1216/*   return(growthAlg(lpGraphOfNormalWords(G))); */
1217/* } */
1218
1219static proc ivDHilbert(list L, int n, list #)
1220"USAGE: ivDHilbert(L,n[,degbound]); L a list of intmats, n an integer,
1221@*      degbound an optional integer
1222RETURN: list
1223PURPOSE:Compute the K-dimension and the Hilbert series
1224ASSUME: - basering is a Letterplace ring
1225@*      - all rows of each intmat correspond to a Letterplace monomial
1226@*      - if you specify a different degree bound degbound,
1227@*        degbound <= attrib(basering,uptodeg) holds
1228NOTE: - If L is the list returned, then L[1] is an integer corresponding to the
1229@*      dimension, L[2] is an intvec which contains the coefficients of the
1230@*      Hilbert series
1231@*    - If degbound is set, there will be a degree bound added. By default there
1232@*      is no degree bound
1233@*    - n is the number of variables
1234@*    - If I = L[2] is the intvec returned, then I[k] is the (k-1)-th coefficient of
1235@*      the Hilbert series.
1236@*    - If the K-dimension is known to be infinite, a degree bound is needed
1237EXAMPLE: example ivDHilbert; shows examples
1238"
1239{int degbound = 0;
1240  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] > 0){degbound = #[1];}}}
1241  checkAssumptions(degbound,L);
1242  intvec H; int i,dimen;
1243  H = ivHilbert(L,n,degbound);
1244  for (i = 1; i <= size(H); i++){dimen = dimen + H[i];}
1245  L = dimen,H;
1246  return(L);
1247}
1248example
1249{
1250  "EXAMPLE:"; echo = 2;
1251  ring r = 0,(x,y),dp;
1252  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
1253  R;
1254  setring R; // sets basering to Letterplace ring
1255  //some intmats, which contain monomials in intvec representation as rows
1256  intmat I1 [2][2] = 1,1,2,2; intmat I2 [1][3]  = 1,2,1;
1257  intmat J1 [1][2] =  1,1; intmat J2 [2][3] = 2,1,2,1,2,1;
1258  print(I1);
1259  print(I2);
1260  print(J1);
1261  print(J2);
1262  list G = I1,I2; // ideal, which is already a Groebner basis
1263  list I = J1,J2; // ideal, which is already a Groebner basis
1264  //the procedure without a degree bound
1265  ivDHilbert(G,2);
1266  // the procedure with degree bound 5
1267  ivDHilbert(I,2,5);
1268}
1269
1270static proc ivDHilbertSickle(list L, int n, list #)
1271"USAGE: ivDHilbertSickle(L,n[,degbound]); L a list of intmats, n an integer,
1272@*      degbound an optional integer
1273RETURN: list
1274PURPOSE:Compute the K-dimension, Hilbert series and mistletoes
1275ASSUME: - basering is a Letterplace ring.
1276@*      - All rows of each intmat correspond to a Letterplace monomial.
1277@*      - If you specify a different degree bound degbound,
1278@*        degbound <= attrib(basering,uptodeg) holds.
1279NOTE: - If L is the list returned, then L[1] is an integer, L[2] is an intvec
1280@*      which contains the coefficients of the Hilbert series and L[3]
1281@*      is a list, containing the mistletoes as intvecs.
1282@*    - If degbound is set, a degree bound will be added. By default there
1283@*      is no degree bound.
1284@*    - n is the number of variables.
1285@*    - If I = L[2] is the intvec returned, then I[k] is the (k-1)-th
1286@*      coefficient of the Hilbert series.
1287@*    - If the K-dimension is known to be infinite, a degree bound is needed
1288EXAMPLE: example ivDHilbertSickle; shows examples
1289"
1290{int degbound = 0;
1291  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] > 0){degbound = #[1];}}}
1292  checkAssumptions(degbound,L);
1293  int i,dimen; list R;
1294  R = ivSickleHil(L,n,degbound);
1295  for (i = 1; i <= size(R[1]); i++){dimen = dimen + R[1][i];}
1296  R[3] = R[2]; R[2] = R[1]; R[1] = dimen;
1297  return(R);
1298}
1299example
1300{
1301  "EXAMPLE:"; echo = 2;
1302  ring r = 0,(x,y),dp;
1303  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
1304  R;
1305  setring R; // sets basering to Letterplace ring
1306  //some intmats, which contain monomials in intvec representation as rows
1307  intmat I1 [2][2] = 1,1,2,2; intmat I2 [1][3]  = 1,2,1;
1308  intmat J1 [1][2] =  1,1; intmat J2 [2][3] = 2,1,2,1,2,1;
1309  print(I1);
1310  print(I2);
1311  print(J1);
1312  print(J2);
1313  list G = I1,I2;// ideal, which is already a Groebner basis
1314  list I = J1,J2; // ideal, which is already a Groebner basis
1315  ivDHilbertSickle(G,2); // invokes the procedure without a degree bound
1316  ivDHilbertSickle(I,2,3); // invokes the procedure with degree bound 3
1317}
1318
1319static proc ivKDimCheck(list L, int n)
1320"USAGE: ivKDimCheck(L,n); L a list of intmats, n an integer
1321RETURN: int, 0 if the dimension is finite, or 1 otherwise
1322PURPOSE:Decides, whether the K-dimension is finite or not
1323ASSUME: - basering is a Letterplace ring.
1324@*      - All rows of each intmat correspond to a Letterplace monomial.
1325NOTE:   - n is the number of variables.
1326EXAMPLE: example ivKDimCheck; shows examples
1327"
1328{checkAssumptions(0,L);
1329  int i,r;
1330  intvec P,H;
1331  for (i = 1; i <= size(L); i++)
1332  {P[i] = ncols(L[i]);
1333    if (P[i] == 1) {if (isInMat(H,L[i]) > 0) {ERROR("Quotient algebra is trivial");}}
1334  }
1335  if (size(L) == 0) {ERROR("GB is empty, quotient algebra corresponds to free algebra");}
1336  kill H;
1337  intmat S; int sd,ld; intvec V;
1338  sd = P[1]; ld = P[1];
1339  for (i = 2; i <= size(P); i++)
1340  {if (P[i] < sd) {sd = P[i];}
1341    if (P[i] > ld) {ld = P[i];}
1342  }
1343  sd = (sd - 1); ld = ld - 1;
1344  if (ld == 0) { return(allVars(L,P,n));}
1345  if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
1346  else {S = createStartMat(sd,n);}
1347  module M;
1348  for (i = 1; i <= nrows(S); i++)
1349  {V = S[i,1..ncols(S)];
1350    if (findCycle(V,L,P,n,ld,M)) {r = 1; break;}
1351  }
1352  return(r);
1353}
1354example
1355{
1356  "EXAMPLE:"; echo = 2;
1357  ring r = 0,(x,y),dp;
1358  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
1359  R;
1360  setring R; // sets basering to Letterplace ring
1361  //some intmats, which contain monomials in intvec representation as rows
1362  intmat I1 [2][2] = 1,1,2,2; intmat I2 [1][3]  = 1,2,1;
1363  intmat J1 [1][2] =  1,1; intmat J2 [2][3] = 2,1,2,1,2,1;
1364  print(I1);
1365  print(I2);
1366  print(J1);
1367  print(J2);
1368  list G = I1,I2;// ideal, which is already a Groebner basis
1369  list I = J1,J2; // ideal, which is already a Groebner basis and which
1370  ivKDimCheck(G,2); // invokes the procedure, factor is of finite K-dimension
1371  ivKDimCheck(I,2); // invokes the procedure, factor is not of finite K-dimension
1372}
1373
1374static proc ivHilbert(list L, int n, list #)
1375"USAGE: ivHilbert(L,n[,degbound]); L a list of intmats, n an integer,
1376@*      degbound an optional integer
1377RETURN: intvec, containing the coefficients of the Hilbert series
1378PURPOSE:Compute the Hilbert series
1379ASSUME: - basering is a Letterplace ring.
1380@*      - all rows of each intmat correspond to a Letterplace monomial
1381@*      - if you specify a different degree bound degbound,
1382@*       degbound <= attrib(basering,uptodeg) holds.
1383NOTE: - If degbound is set, a degree bound  will be added. By default there
1384@*      is no degree bound.
1385@*    - n is the number of variables.
1386@*    - If I is returned, then I[k] is the (k-1)-th coefficient of the Hilbert
1387@*      series.
1388@*    - If the K-dimension is known to be infinite, a degree bound is needed
1389EXAMPLE: example ivHilbert; shows examples
1390"
1391{int degbound = 0;
1392  if (size(#) > 0) {if (typeof(#[1])=="int"){if (#[1] > 0) {degbound = #[1];}}}
1393  intvec P,H; int i;
1394  for (i = 1; i <= size(L); i++)
1395  {P[i] = ncols(L[i]);
1396    if (P[i] == 1) {if ( isInMat(H,L[i]) > 0) {ERROR("Quotient algebra is trivial");}}
1397  }
1398  if (size(L) == 0) {ERROR("GB is empty, quotient algebra corresponds to free algebra");}
1399  H[1] = 1;
1400  checkAssumptions(degbound,L);
1401  if (degbound == 0)
1402  {int sd;
1403    intmat S;
1404    sd = P[1];
1405    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
1406    sd = (sd - 1);
1407    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
1408    else {S = createStartMat(sd,n);}
1409    if (intvec(S) == 0) {return(H);}
1410    for (i = 1; i <= sd; i++) {H = H,(n^i);}
1411    for (i = 1; i <= nrows(S); i++)
1412    {intvec St = S[i,1..ncols(S)];
1413      H = findHCoeff(St,n,L,P,H);
1414      kill St;
1415    }
1416    return(H);
1417  }
1418  else
1419  {for (i = 1; i <= size(P); i++)
1420    {if (P[i] > degbound) {ERROR("degreebound is too small, GB contains elements of higher degree");}}
1421    int sd;
1422    intmat S;
1423    sd = P[1];
1424    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
1425    sd = (sd - 1);
1426    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
1427    else {S = createStartMat(sd,n);}
1428    if (intvec(S) == 0) {return(H);}
1429    for (i = 1; i <= sd; i++) {H = H,(n^i);}
1430    for (i = 1; i <= nrows(S); i++)
1431    {intvec St = S[i,1..ncols(S)];
1432      H = findHCoeff(St,n,L,P,H,degbound);
1433      kill St;
1434    }
1435    return(H);
1436  }
1437}
1438example
1439{
1440  "EXAMPLE:"; echo = 2;
1441  ring r = 0,(x,y),dp;
1442  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
1443  R;
1444  setring R; // sets basering to Letterplace ring
1445  //some intmats, which contain monomials in intvec representation as rows
1446  intmat I1 [2][2] = 1,1,2,2; intmat I2 [1][3]  = 1,2,1;
1447  intmat J1 [1][2] =  1,1; intmat J2 [2][3] = 2,1,2,1,2,1;
1448  print(I1);
1449  print(I2);
1450  print(J1);
1451  print(J2);
1452  list G = I1,I2; // ideal, which is already a Groebner basis
1453  list I = J1,J2; // ideal, which is already a Groebner basis
1454  ivHilbert(G,2); // invokes the procedure without any degree bound
1455  ivHilbert(I,2,5); // invokes the procedure with degree bound 5
1456}
1457
1458
1459static proc ivKDim(list L, int n, list #)
1460"USAGE: ivKDim(L,n[,degbound]); L a list of intmats,
1461@*      n an integer, degbound an optional integer
1462RETURN: int, the K-dimension of A/<L>
1463PURPOSE:Compute the K-dimension of A/<L>
1464ASSUME: - basering is a Letterplace ring.
1465@*      - all rows of each intmat correspond to a Letterplace monomial
1466@*      - if you specify a different degree bound degbound,
1467@*        degbound <= attrib(basering,uptodeg) holds.
1468NOTE: - If degbound is set, a degree bound will be added. By default there
1469@*      is no degree bound.
1470@*    - n is the number of variables.
1471@*    - If the K-dimension is known to be infinite, a degree bound is needed
1472EXAMPLE: example ivKDim; shows examples
1473"
1474{int degbound = 0;
1475  if (size(#) > 0) {if (typeof(#[1])=="int"){if (#[1] > 0) {degbound = #[1];}}}
1476  intvec P,H; int i;
1477  for (i = 1; i <= size(L); i++)
1478  {P[i] = ncols(L[i]);
1479    if (P[i] == 1) {if ( isInMat(H,L[i]) > 0) {ERROR("Quotient algebra is trivial");}}
1480  }
1481  if (size(L) == 0) {ERROR("GB is empty, quotient algebra corresponds to free algebra");}
1482  kill H;
1483  checkAssumptions(degbound,L);
1484  if (degbound == 0)
1485  {int sd; int dimen = 1;
1486    intmat S;
1487    sd = P[1];
1488    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
1489    sd = (sd - 1);
1490    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
1491    else {S = createStartMat(sd,n);}
1492    if (intvec(S) == 0) {return(dimen);}
1493    for (i = 1; i <= sd; i++) {dimen = dimen +(n^i);}
1494    for (i = 1; i <= nrows(S); i++)
1495    {intvec St = S[i,1..ncols(S)];
1496      dimen = dimen + findDimen(St,n,L,P);
1497      kill St;
1498    }
1499    return(dimen);
1500  }
1501  else
1502  {for (i = 1; i <= size(P); i++)
1503    {if (P[i] > degbound) {ERROR("degreebound is too small, GB contains elements of higher degree");}}
1504    int sd; int dimen = 1;
1505    intmat S;
1506    sd = P[1];
1507    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
1508    sd = (sd - 1);
1509    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
1510    else {S = createStartMat(sd,n);}
1511    if (intvec(S) == 0) {return(dimen);}
1512    for (i = 1; i <= sd; i++) {dimen = dimen +(n^i);}
1513    for (i = 1; i <= nrows(S); i++)
1514    {intvec St = S[i,1..ncols(S)];
1515      dimen = dimen + findDimen(St,n,L,P, degbound);
1516      kill St;
1517    }
1518    return(dimen);
1519  }
1520}
1521example
1522{
1523  "EXAMPLE:"; echo = 2;
1524  ring r = 0,(x,y),dp;
1525  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
1526  R;
1527  setring R; // sets basering to Letterplace ring
1528  //some intmats, which contain monomials in intvec representation as rows
1529  intmat I1 [2][2] = 1,1,2,2; intmat I2 [1][3]  = 1,2,1;
1530  intmat J1 [1][2] =  1,1; intmat J2 [2][3] = 2,1,2,1,2,1;
1531  print(I1);
1532  print(I2);
1533  print(J1);
1534  print(J2);
1535  list G = I1,I2; // ideal, which is already a Groebner basis
1536  list I = J1,J2; // ideal, which is already a Groebner basis
1537  ivKDim(G,2); // invokes the procedure without any degree bound
1538  ivKDim(I,2,5); // invokes the procedure with degree bound 5
1539}
1540
1541static proc ivMis2Base(list M)
1542"USAGE: ivMis2Base(M); M a list of intvecs
1543RETURN: ideal, a K-base of the given algebra
1544PURPOSE:Compute the K-base out of given mistletoes
1545ASSUME: - The mistletoes have to be ordered lexicographically -> OrdMisLex.
1546@*        Otherwise there might some elements missing.
1547@*      - basering is a Letterplace ring.
1548@*      - mistletoes are stored as intvecs, as described in the overview
1549EXAMPLE: example ivMis2Base; shows examples
1550"
1551{
1552  //checkAssumptions(0,M);
1553  intvec L,A;
1554  if (size(M) == 0){ERROR("There are no mistletoes, so it appears your dimension is infinite!");}
1555  if (isInList(L,M) > 0) {print("1 is a mistletoe, therefore 1 is the only basis element"); return(list(intvec(0)));}
1556  int i,j,d,s;
1557  list Rt;
1558  Rt[1] = intvec(0);
1559  L = M[1];
1560  for (i = size(L); 1 <= i; i--) {Rt = insert(Rt,intvec(L[1..i]));}
1561  for (i = 2; i <= size(M); i++)
1562  {A = M[i]; L = M[i-1];
1563    s = size(A);
1564    if (s > size(L))
1565    {d = size(L);
1566      for (j = s; j > d; j--) {Rt = insert(Rt,intvec(A[1..j]));}
1567      A = A[1..d];
1568    }
1569    if (size(L) > s){L = L[1..s];}
1570    while (A <> L)
1571    {Rt = insert(Rt, intvec(A));
1572      if (size(A) > 1)
1573      {A = A[1..(size(A)-1)];
1574        L = L[1..(size(L)-1)];
1575      }
1576      else {break;}
1577    }
1578  }
1579  return(Rt);
1580}
1581example
1582{
1583  "EXAMPLE:"; echo = 2;
1584  ring r = 0,(x,y),dp;
1585  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
1586  R;
1587  setring R; // sets basering to Letterplace ring
1588  intvec i1 = 1,2; intvec i2 = 2,1,2;
1589  // the mistletoes are xy and yxy, which are already ordered lexicographically
1590  list L = i1,i2;
1591  ivMis2Base(L); // returns the basis of the factor algebra
1592}
1593
1594
1595static proc ivMis2Dim(list M)
1596"USAGE: ivMis2Dim(M); M a list of intvecs
1597RETURN: int, the K-dimension of the given algebra
1598PURPOSE:Compute the K-dimension out of given mistletoes
1599ASSUME: - The mistletoes have to be ordered lexicographically -> OrdMisLex.
1600@*        Otherwise the returned value may differ from the K-dimension.
1601@*      - basering is a Letterplace ring.
1602EXAMPLE: example ivMis2Dim; shows examples
1603"
1604{checkAssumptions(0,M);
1605  intvec L;
1606  if (size(M) == 0){ERROR("There are no mistletoes, so it appears your dimension is infinite!");}
1607  if (isInList(L,M) > 0) {print("1 is a mistletoe, therefore dim = 1"); return(1);}
1608  int i,j,d,s;
1609  j = 1;
1610  d = 1 + size(M[1]);
1611  for (i = 1; i < size(M); i++)
1612  {s = size(M[i]); if (s > size(M[i+1])){s = size(M[i+1]);}
1613    while ((M[i][j] == M[i+1][j]) && (j <= s)){j = j + 1;}
1614    d = d + size(M[i+1])- j + 1;
1615  }
1616  return(d);
1617}
1618example
1619{
1620  "EXAMPLE:"; echo = 2;
1621  ring r = 0,(x,y),dp;
1622  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
1623  R;
1624  setring R; // sets basering to Letterplace ring
1625  intvec i1 = 1,2; intvec i2 = 2,1,2;
1626  // the mistletoes are xy and yxy, which are already ordered lexicographically
1627  list L = i1,i2;
1628  ivMis2Dim(L); // returns the dimension of the factor algebra
1629}
1630
1631static proc ivOrdMisLex(list M)
1632"USAGE: ivOrdMisLex(M); M a list of intvecs
1633RETURN: list, containing the ordered intvecs of M
1634PURPOSE:Orders a given set of mistletoes lexicographically
1635ASSUME: - basering is a Letterplace ring.
1636- intvecs correspond to monomials
1637NOTE:   - This is preprocessing, it's not needed if the mistletoes are returned
1638@*        from the sickle algorithm.
1639@*      - Each entry of the list returned is an intvec.
1640EXAMPLE: example ivOrdMisLex; shows examples
1641"
1642{checkAssumptions(0,M);
1643  return(sort(M)[1]);
1644}
1645example
1646{
1647  "EXAMPLE:"; echo = 2;
1648  ring r = 0,(x,y),dp;
1649  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
1650  setring R; // sets basering to Letterplace ring
1651  intvec i1 = 1,2,1; intvec i2 = 2,2,1; intvec i3 = 1,1; intvec i4 = 2,1,1,1;
1652  // the corresponding monomials are xyx,y^2x,x^2,yx^3
1653  list M = i1,i2,i3,i4;
1654  M;
1655  ivOrdMisLex(M);// orders the list of monomials
1656}
1657
1658static proc ivSickle(list L, int n, list #)
1659"USAGE: ivSickle(L,n,[degbound]); L a list of intmats, n an int, degbound an
1660@*      optional integer
1661RETURN: list, containing intvecs, the mistletoes of A/<L>
1662PURPOSE:Compute the mistletoes for a given Groebner basis L
1663ASSUME: - basering is a Letterplace ring.
1664@*      - all rows of each intmat correspond to a Letterplace monomial
1665@*      - if you specify a different degree bound degbound,
1666@*        degbound <= attrib(basering,uptodeg) holds.
1667NOTE: - If degbound is set, a degree bound will be added. By default there
1668@*      is no degree bound.
1669@*    - n is the number of variables.
1670@*    - If the K-dimension is known to be infinite, a degree bound is needed
1671EXAMPLE: example ivSickle; shows examples
1672"
1673{list M;
1674  int degbound = 0;
1675  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] > 0){degbound = #[1];}}}
1676  int i;
1677  intvec P,H;
1678  for (i = 1; i <= size(L); i++)
1679  {P[i] = ncols(L[i]);
1680    if (P[i] == 1) {if (isInMat(H,L[i]) > 0) {ERROR("Quotient algebra is trivial");}}
1681  }
1682  if (size(L) == 0) {ERROR("GB is empty, quotient algebra corresponds to free algebra");}
1683  kill H;
1684  checkAssumptions(degbound,L);
1685  if (degbound == 0)
1686  {intmat S; int sd;
1687    sd = P[1];
1688    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
1689    sd = (sd - 1);
1690    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
1691    else {S = createStartMat(sd,n);}
1692    if (intvec(S) == 0) {return(list (intvec(0)));}
1693    for (i = 1; i <= nrows(S); i++)
1694    {intvec St = S[i,1..ncols(S)];
1695      M = M + findmistletoes(St,n,L,P);
1696      kill St;
1697    }
1698    return(M);
1699  }
1700  else
1701  {for (i = 1; i <= size(P); i++)
1702    {if (P[i] > degbound) {ERROR("degreebound is too small, GB contains elements of higher degree");}}
1703    intmat S; int sd;
1704    sd = P[1];
1705    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
1706    sd = (sd - 1);
1707    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
1708    else {S = createStartMat(sd,n);}
1709    if (intvec(S) == 0) {return(list (intvec(0)));}
1710    for (i = 1; i <= nrows(S); i++)
1711    {intvec St = S[i,1..ncols(S)];
1712      M = M + findmistletoes(St,n,L,P,degbound);
1713      kill St;
1714    }
1715    return(M);
1716  }
1717}
1718example
1719{
1720  "EXAMPLE:"; echo = 2;
1721  ring r = 0,(x,y),dp;
1722  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
1723  setring R; // sets basering to Letterplace ring
1724  //some intmats, which contain monomials in intvec representation as rows
1725  intmat I1 [2][2] = 1,1,2,2; intmat I2 [1][3]  = 1,2,1;
1726  intmat J1 [1][2] =  1,1; intmat J2 [2][3] = 2,1,2,1,2,1;
1727  print(I1);
1728  print(I2);
1729  print(J1);
1730  print(J2);
1731  list G = I1,I2; // ideal, which is already a Groebner basis
1732  list I =  J1,J2; // ideal, which is already a Groebner basis
1733  ivSickle(G,2); // invokes the procedure without any degree bound
1734  ivSickle(I,2,5); // invokes the procedure with degree bound 5
1735}
1736
1737static proc ivSickleDim(list L, int n, list #)
1738"USAGE: ivSickleDim(L,n[,degbound]); L a list of intmats, n an integer, degbound
1739@*      an optional integer
1740RETURN: list
1741PURPOSE:Compute mistletoes and the K-dimension
1742ASSUME: - basering is a Letterplace ring.
1743@*      - all rows of each intmat correspond to a Letterplace monomial
1744@*      - if you specify a different degree bound degbound,
1745@*        degbound <= attrib(basering,uptodeg) holds.
1746NOTE: - If L is the list returned, then L[1] is an integer, L[2] is a list,
1747@*      containing the mistletoes as intvecs.
1748@*    - If degbound is set, a degree bound will be added. By default there
1749@*      is no degree bound.
1750@*    - n is the number of variables.
1751@*    - If the K-dimension is known to be infinite, a degree bound is needed
1752EXAMPLE: example ivSickleDim; shows examples
1753"
1754{list M;
1755  int degbound = 0;
1756  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] > 0){degbound = #[1];}}}
1757  int i,dimen; list R;
1758  intvec P,H;
1759  for (i = 1; i <= size(L); i++)
1760  {P[i] = ncols(L[i]);
1761    if (P[i] == 1) {if (isInMat(H,L[i]) > 0) {ERROR("Quotient algebra is trivial, dimension equals zero");}}
1762  }
1763  if (size(L) == 0) {ERROR("GB is empty, quotient algebra corresponds to free algebra");}
1764  kill H;
1765  checkAssumptions(degbound,L);
1766  if (degbound == 0)
1767  {int sd; dimen = 1;
1768    intmat S;
1769    sd = P[1];
1770    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
1771    sd = (sd - 1);
1772    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
1773    else {S = createStartMat(sd,n);}
1774    if (intvec(S) == 0) {return(list(dimen,list(intvec(0))));}
1775    for (i = 1; i <= sd; i++) {dimen = dimen +(n^i);}
1776    R[1] = dimen;
1777    for (i = 1; i <= nrows(S); i++)
1778    {intvec St = S[i,1..ncols(S)];
1779      R = findMisDim(St,n,L,P,R);
1780      kill St;
1781    }
1782    return(R);
1783  }
1784  else
1785  {for (i = 1; i <= size(P); i++)
1786    {if (P[i] > degbound) {ERROR("degreebound is too small, GB contains elements of higher degree");}}
1787    int sd; dimen = 1;
1788    intmat S;
1789    sd = P[1];
1790    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
1791    sd = (sd - 1);
1792    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
1793    else {S = createStartMat(sd,n);}
1794    if (intvec(S) == 0) {return(list(dimen,list(intvec(0))));}
1795    for (i = 1; i <= sd; i++) {dimen = dimen +(n^i);}
1796    R[1] = dimen;
1797    for (i = 1; i <= nrows(S); i++)
1798    {intvec St = S[i,1..ncols(S)];
1799      R = findMisDim(St,n,L,P,R,degbound);
1800      kill St;
1801    }
1802    return(R);
1803  }
1804}
1805example
1806{
1807  "EXAMPLE:"; echo = 2;
1808  ring r = 0,(x,y),dp;
1809  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
1810  setring R; // sets basering to Letterplace ring
1811  //some intmats, which contain monomials in intvec representation as rows
1812  intmat I1 [2][2] = 1,1,2,2; intmat I2 [1][3]  = 1,2,1;
1813  intmat J1 [1][2] =  1,1; intmat J2 [2][3] = 2,1,2,1,2,1;
1814  print(I1);
1815  print(I2);
1816  print(J1);
1817  print(J2);
1818  list G = I1,I2;// ideal, which is already a Groebner basis
1819  list I =  J1,J2; // ideal, which is already a Groebner basis
1820  ivSickleDim(G,2); // invokes the procedure without any degree bound
1821  ivSickleDim(I,2,5); // invokes the procedure with degree bound 5
1822}
1823
1824static proc ivSickleHil(list L, int n, list #)
1825"USAGE:ivSickleHil(L,n[,degbound]); L a list of intmats, n an integer,
1826@*     degbound an optional integer
1827RETURN: list
1828PURPOSE:Compute the mistletoes and the Hilbert series
1829ASSUME: - basering is a Letterplace ring.
1830@*      - all rows of each intmat correspond to a Letterplace monomial
1831@*      - if you specify a different degree bound degbound,
1832@*        degbound <= attrib(basering,uptodeg) holds.
1833NOTE: - If L is the list returned, then L[1] is an intvec, L[2] is a list,
1834@*      containing the mistletoes as intvecs.
1835@*    - If degbound is set, a degree bound will be added. By default there
1836@*      is no degree bound.
1837@*    - n is the number of variables.
1838@*    - If I = L[1] is the intvec returned, then I[k] is the (k-1)-th
1839@*      coefficient of the Hilbert series.
1840@*    - If the K-dimension is known to be infinite, a degree bound is needed
1841EXAMPLE: example ivSickleHil; shows examples
1842"
1843{int degbound = 0;
1844  if (size(#) > 0) {if (typeof(#[1])=="int"){if (#[1] > 0) {degbound = #[1];}}}
1845  intvec P,H; int i; list R;
1846  for (i = 1; i <= size(L); i++)
1847  {P[i] = ncols(L[i]);
1848    if (P[i] == 1) {if ( isInMat(H,L[i]) > 0) {ERROR("Quotient algebra is trivial");}}
1849  }
1850  if (size(L) == 0) {ERROR("GB is empty, quotient algebra corresponds to free algebra");}
1851  H[1] = 1;
1852  checkAssumptions(degbound,L);
1853  if (degbound == 0)
1854  {int sd;
1855    intmat S;
1856    sd = P[1];
1857    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
1858    sd = (sd - 1);
1859    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
1860    else {S = createStartMat(sd,n);}
1861    if (intvec(S) == 0) {return(list(H,list(intvec (0))));}
1862    for (i = 1; i <= sd; i++) {H = H,(n^i);}
1863    R[1] = H; kill H;
1864    for (i = 1; i <= nrows(S); i++)
1865    {intvec St = S[i,1..ncols(S)];
1866      R = findHCoeffMis(St,n,L,P,R);
1867      kill St;
1868    }
1869    return(R);
1870  }
1871  else
1872  {for (i = 1; i <= size(P); i++)
1873    {if (P[i] > degbound) {ERROR("degreebound is too small, GB contains elements of higher degree");}}
1874    int sd;
1875    intmat S;
1876    sd = P[1];
1877    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
1878    sd = (sd - 1);
1879    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
1880    else {S = createStartMat(sd,n);}
1881    if (intvec(S) == 0) {return(list(H,list(intvec(0))));}
1882    for (i = 1; i <= sd; i++) {H = H,(n^i);}
1883    R[1] = H; kill H;
1884    for (i = 1; i <= nrows(S); i++)
1885    {intvec St = S[i,1..ncols(S)];
1886      R = findHCoeffMis(St,n,L,P,R,degbound);
1887      kill St;
1888    }
1889    return(R);
1890  }
1891}
1892example
1893{
1894  "EXAMPLE:"; echo = 2;
1895  ring r = 0,(x,y),dp;
1896  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
1897  setring R; // sets basering to Letterplace ring
1898  //some intmats, which contain monomials in intvec representation as rows
1899  intmat I1[2][2] = 1,1,2,2; intmat I2[1][3]  = 1,2,1;
1900  intmat J1[1][2] =  1,1; intmat J2[2][3] = 2,1,2,1,2,1;
1901  print(I1);
1902  print(I2);
1903  print(J1);
1904  print(J2);
1905  list G = I1,I2;// ideal, which is already a Groebner basis
1906  list I =  J1,J2; // ideal, which is already a Groebner basis
1907  ivSickleHil(G,2); // invokes the procedure without any degree bound
1908  ivSickleHil(I,2,5); // invokes the procedure with degree bound 5
1909}
1910
1911static proc lpDHilbert(ideal G, list #)
1912"USAGE: lpDHilbert(G[,degbound,n]); G an ideal, degbound, n optional integers
1913RETURN: list
1914PURPOSE:Compute K-dimension and Hilbert series, starting with a lp-ideal
1915ASSUME: - basering is a Letterplace ring.
1916@*      - if you specify a different degree bound degbound,
1917@*        degbound <= attrib(basering,uptodeg) holds.
1918NOTE: - If L is the list returned, then L[1] is an integer corresponding to the
1919@*      dimension, L[2] is an intvec which contains the coefficients of the
1920@*      Hilbert series
1921@*    - If degbound is set, there will be a degree bound added. 0 means no
1922@*      degree bound. Default: attrib(basering,uptodeg).
1923@*    - n can be set to a different number of variables.
1924@*      Default: n = attrib(basering, lV).
1925@*    - If I = L[2] is the intvec returned, then I[k] is the (k-1)-th
1926@*      coefficient of the Hilbert series.
1927@*    - If the K-dimension is known to be infinite, a degree bound is needed
1928EXAMPLE: example lpDHilbert; shows examples
1929"
1930{int degbound = attrib(basering,"uptodeg");int n = attrib(basering, "isLetterplaceRing");
1931  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] >= 0){degbound = #[1];}}}
1932  if (size(#) > 1){if (typeof(#[1])=="int"){if (#[2] > 0){n = #[2];}}}
1933  list L;
1934  L = lp2ivId(normalize(lead(G)));
1935  return(ivDHilbert(L,n,degbound));
1936}
1937example
1938{
1939  "EXAMPLE:"; echo = 2;
1940  ring r = 0,(x,y),dp;
1941  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
1942  setring R; // sets basering to Letterplace ring
1943  ideal G = x*x, y*y,x*y*x; // ideal G contains a
1944  //Groebner basis
1945  lpDHilbert(G,5,2); // invokes procedure with degree bound 5 and 2 variables
1946  // note that the optional parameters are not necessary, due to the finiteness
1947  // of the K-dimension of the factor algebra
1948  lpDHilbert(G); // procedure with ring parameters
1949  lpDHilbert(G,0); // procedure without degreebound
1950}
1951
1952static proc lpDHilbertSickle(ideal G, list #)
1953"USAGE: lpDHilbertSickle(G[,degbound,n]); G an ideal, degbound, n optional
1954@*      integers
1955RETURN: list
1956PURPOSE:Compute K-dimension, Hilbert series and mistletoes at once
1957ASSUME: - basering is a Letterplace ring.
1958@*      - if you specify a different degree bound degbound,
1959@*        degbound <= attrib(basering,uptodeg) holds.
1960NOTE: - If L is the list returned, then L[1] is an integer, the K-dimension,
1961@*      L[2] is an intvec, the Hilbert series and L[3] is an ideal,
1962@*      the mistletoes
1963@*    - If degbound is set, there will be a degree bound added. 0 means no
1964@*      degree bound. Default: attrib(basering,uptodeg).
1965@*    - n can be set to a different number of variables.
1966@*      Default: n = attrib(basering, lV).
1967@*    - If I = L[1] is the intvec returned, then I[k] is the (k-1)-th
1968@*      coefficient of the Hilbert series.
1969@*    - If the K-dimension is known to be infinite, a degree bound is needed
1970EXAMPLE: example lpDHilbertSickle; shows examples
1971"
1972{int degbound = attrib(basering,"uptodeg");int n = attrib(basering, "isLetterplaceRing");
1973  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] >= 0){degbound = #[1];}}}
1974  if (size(#) > 1){if (typeof(#[1])=="int"){if (#[2] > 0){n = #[2];}}}
1975  list L;
1976  L = lp2ivId(normalize(lead(G)));
1977  L = ivDHilbertSickle(L,n,degbound);
1978  L[3] =  ivL2lpI(L[3]);
1979  return(L);
1980}
1981example
1982{
1983  "EXAMPLE:"; echo = 2;
1984  ring r = 0,(x,y),dp;
1985  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
1986  setring R; // sets basering to Letterplace ring
1987  ideal G = x*x, y*y,x*y*x; // ideal G contains a
1988  //Groebner basis
1989  lpDHilbertSickle(G,5,2); //invokes procedure with degree bound 5 and 2 variables
1990  // note that the optional parameters are not necessary, due to the finiteness
1991  // of the K-dimension of the factor algebra
1992  lpDHilbertSickle(G); // procedure with ring parameters
1993  lpDHilbertSickle(G,0); // procedure without degreebound
1994}
1995
1996proc lpHilbert(ideal G, list #)
1997"USAGE: lpHilbert(G[,degbound,n]); G an ideal, degbound, n optional integers
1998RETURN: intvec, containing the coefficients of the Hilbert series
1999PURPOSE: Compute the truncated Hilbert series of K<X>/<G> up to a degree bound
2000ASSUME: - basering is a Letterplace ring.
2001@*      - if you specify a different degree bound degbound,
2002@*        degbound <= attrib(basering,uptodeg) holds.
2003THEORY: Hilbert series of an algebra K<X>/<G> is @code{\sum_{i=0} h_i t^i},
2004where @code{h_i} is the K-dimension of the space of monomials of degree i,
2005not contained in <G>. For finitely presented algebras Hilbert series NEED
2006NOT be a rational function, though it happens often. Therefore in general
2007there is no notion of a Hilbert polynomial.
2008NOTE: - If degbound is set, there will be a degree bound added. 0 means no
2009@*      degree bound. Default: attrib(basering,uptodeg).
2010@*    - n is the number of variables, which can be set to a different number.
2011@*      Default: attrib(basering, lV).
2012@*    - In the output intvec I, I[k] is the (k-1)-th coefficient of the Hilbert
2013@*      series, i.e. @code{h_{k-1}} as above.
2014EXAMPLE: example lpHilbert; shows examples
2015SEE ALSO: ncHilb_lib
2016"
2017{int degbound = attrib(basering,"uptodeg");int n = attrib(basering, "isLetterplaceRing");
2018  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] >= 0){degbound = #[1];}}}
2019  if (size(#) > 1){if (typeof(#[1])=="int"){if (#[2] > 0){n = #[2];}}}
2020  list L;
2021  L = lp2ivId(normalize(lead(G)));
2022  return(ivHilbert(L,n,degbound));
2023}
2024example
2025{
2026  "EXAMPLE:"; echo = 2;
2027  ring r = 0,(x,y),dp;
2028  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2029  setring R; // sets basering to Letterplace ring
2030  ideal G = y*y,x*y*x; // G is a Groebner basis
2031  lpHilbert(G); // procedure with default parameters
2032  lpHilbert(G,3,2); // invokes procedure with degree bound 3 and (same) 2 variables
2033}
2034
2035// compatibiltiy, do not put in header
2036proc lpDimCheck(ideal G)
2037{
2038  return(lpKDimCheck(G));
2039}
2040
2041proc lpKDimCheck(ideal G)
2042"USAGE: lpKDimCheck(G);
2043RETURN: int, 1 if K-dimension of the factor algebra is infinite, 0 otherwise
2044PURPOSE:Checking a factor algebra for finiteness of the K-dimension
2045ASSUME: - basering is a Letterplace ring.
2046EXAMPLE: example lpKDimCheck; shows examples
2047"
2048{int n = attrib(basering,"isLetterplaceRing");
2049  list L;
2050  ideal R;
2051  R = normalize(lead(G));
2052  L = lp2ivId(R);
2053  return(ivKDimCheck(L,n));
2054}
2055example
2056{
2057  "EXAMPLE:"; echo = 2;
2058  ring r = 0,(x,y),dp;
2059  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2060  setring R; // sets basering to Letterplace ring
2061  ideal G = x*x, y*y,x*y*x;
2062  // Groebner basis
2063  ideal I = x*x, y*x*y, x*y*x;
2064  // Groebner basis
2065  lpKDimCheck(G); // invokes procedure, factor algebra is of finite K-dimension
2066  lpKDimCheck(I); // invokes procedure, factor algebra is of infinite Kdimension
2067}
2068
2069proc lpKDim(ideal G, list #)
2070"USAGE: lpKDim(G[,degbound, n]); G an ideal, degbound, n optional integers
2071RETURN: int, the K-dimension of the factor algebra
2072PURPOSE:Compute the K-dimension of a factor algebra, given via an ideal
2073ASSUME: - basering is a Letterplace ring
2074@*      - if you specify a different degree bound degbound,
2075@*        degbound <= attrib(basering,uptodeg) holds.
2076NOTE: - If degbound is set, there will be a degree bound added. 0 means no
2077@*      degree bound. Default: attrib(basering, uptodeg).
2078@*    - n is the number of variables, which can be set to a different number.
2079@*      Default: attrib(basering, lV).
2080@*    - If the K-dimension is known to be infinite, a degree bound is needed
2081EXAMPLE: example lpKDim; shows examples
2082"
2083{int degbound = attrib(basering, "uptodeg");int n = attrib(basering, "isLetterplaceRing");
2084  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] >= 0){degbound = #[1];}}}
2085  if (size(#) > 1){if (typeof(#[1])=="int"){if (#[2] > 0){n = #[2];}}}
2086  list L;
2087  L = lp2ivId(normalize(lead(G)));
2088  return(ivKDim(L,n,degbound));
2089}
2090example
2091{
2092  "EXAMPLE:"; echo = 2;
2093  ring r = 0,(x,y),dp;
2094  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2095  setring R; // sets basering to Letterplace ring
2096  ideal G = x*x, y*y,x*y*x;
2097  // ideal G contains a Groebner basis
2098  lpKDim(G); //procedure invoked with ring parameters
2099  // the factor algebra is finite, so the degree bound given by the Letterplace
2100  // ring is not necessary
2101  lpKDim(G,0); // procedure without any degree bound
2102}
2103
2104static proc lpMis2Base(ideal M)
2105"USAGE: lpMis2Base(M); M an ideal
2106RETURN: ideal, a K-basis of the factor algebra
2107PURPOSE:Compute a K-basis out of given mistletoes
2108ASSUME: - basering is a Letterplace ring. G is a Letterplace ideal.
2109@*      - M contains only monomials
2110NOTE:   - The mistletoes have to be ordered lexicographically -> OrdMisLex.
2111EXAMPLE: example lpMis2Base; shows examples
2112"
2113{list L;
2114  L = lpId2ivLi(M);
2115  return(ivL2lpI(ivMis2Base(L)));
2116}
2117example
2118{
2119  "EXAMPLE:"; echo = 2;
2120  ring r = 0,(x,y),dp;
2121  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2122  setring R; // sets basering to Letterplace ring
2123  ideal L = x*y,y*x*y;
2124  // ideal containing the mistletoes
2125  lpMis2Base(L); // returns the K-basis of the factor algebra
2126}
2127
2128static proc lpMis2Dim(ideal M)
2129"USAGE: lpMis2Dim(M); M an ideal
2130RETURN: int, the K-dimension of the factor algebra
2131PURPOSE:Compute the K-dimension out of given mistletoes
2132ASSUME: - basering is a Letterplace ring.
2133@*      - M contains only monomials
2134NOTE:   - The mistletoes have to be ordered lexicographically -> OrdMisLex.
2135EXAMPLE: example lpMis2Dim; shows examples
2136"
2137{list L;
2138  L = lpId2ivLi(M);
2139  return(ivMis2Dim(L));
2140}
2141example
2142{
2143  "EXAMPLE:"; echo = 2;
2144  ring r = 0,(x,y),dp;
2145  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2146  setring R; // sets basering to Letterplace ring
2147  ideal L = x*y,y*x*y;
2148  // ideal containing the mistletoes
2149  lpMis2Dim(L); // returns the K-dimension of the factor algebra
2150}
2151
2152static proc lpOrdMisLex(ideal M)
2153"USAGE: lpOrdMisLex(M); M an ideal of mistletoes
2154RETURN: ideal, containing the mistletoes, ordered lexicographically
2155PURPOSE:A given set of mistletoes is ordered lexicographically
2156ASSUME: - basering is a Letterplace ring.
2157NOTE:   This is preprocessing, it is not needed if the mistletoes are returned
2158@*      from the sickle algorithm.
2159EXAMPLE: example lpOrdMisLex; shows examples
2160"
2161{return(ivL2lpI(sort(lpId2ivLi(M))[1]));}
2162example
2163{
2164  "EXAMPLE:"; echo = 2;
2165  ring r = 0,(x,y),dp;
2166  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2167  setring R; // sets basering to Letterplace ring
2168  ideal M = x*y*x, y*y*x, x*x, y*x*x*x;
2169  // some monomials
2170  lpOrdMisLex(M); // orders the monomials lexicographically
2171}
2172
2173static proc lpSickle(ideal G,  list #)
2174"USAGE: lpSickle(G[,degbound,n]); G an ideal, degbound, n optional integers
2175RETURN: ideal
2176PURPOSE:Compute the mistletoes of K[X]/<G>
2177ASSUME: - basering is a Letterplace ring.
2178@*      - if you specify a different degree bound degbound,
2179@*        degbound <= attrib(basering,uptodeg) holds.
2180NOTE: - If degbound is set, there will be a degree bound added. 0 means no
2181@*      degree bound. Default: attrib(basering,uptodeg).
2182@*    - n is the number of variables, which can be set to a different number.
2183@*      Default: attrib(basering, lV).
2184@*    - If the K-dimension is known to be infinite, a degree bound is needed
2185EXAMPLE: example lpSickle; shows examples
2186"
2187{int degbound = attrib(basering,"uptodeg"); int n = attrib(basering, "isLetterplaceRing");
2188  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] >= 0){degbound = #[1];}}}
2189  if (size(#) > 1){if (typeof(#[1])=="int"){if (#[2] > 0){n = #[2];}}}
2190  list L; ideal R;
2191  R = normalize(lead(G));
2192  L = lp2ivId(R);
2193  L = ivSickle(L,n,degbound);
2194  R = ivL2lpI(L);
2195  return(R);
2196}
2197example
2198{
2199  "EXAMPLE:"; echo = 2;
2200  ring r = 0,(x,y),dp;
2201  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2202  setring R; // sets basering to Letterplace ring
2203  ideal G = x*x, y*y,x*y*x; // ideal G contains a
2204  //Groebner basis
2205  lpSickle(G); //invokes the procedure with ring parameters
2206  // the factor algebra is finite, so the degree bound given by the Letterplace
2207  // ring is not necessary
2208  lpSickle(G,0); // procedure without any degree bound
2209}
2210
2211proc lpSickleDim(ideal G, list #)
2212"USAGE: lpSickleDim(G[,degbound,n]); G an ideal, degbound, n optional integers
2213RETURN: list
2214PURPOSE:Compute the K-dimension and the mistletoes
2215ASSUME: - basering is a Letterplace ring.
2216@*      - if you specify a different degree bound degbound,
2217@*        degbound <= attrib(basering,uptodeg) holds.
2218NOTE: - If L is the list returned, then L[1] is an integer, the K-dimension,
2219@*      L[2] is an ideal, the mistletoes.
2220@*    - If degbound is set, there will be a degree bound added. 0 means no
2221@*      degree bound. Default: attrib(basering,uptodeg).
2222@*    - n is the number of variables, which can be set to a different number.
2223@*      Default: attrib(basering, lV).
2224@*    - If the K-dimension is known to be infinite, a degree bound is needed
2225EXAMPLE: example lpSickleDim; shows examples
2226"
2227{int degbound = attrib(basering,"uptodeg");int n = attrib(basering, "isLetterplaceRing");
2228  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] >= 0){degbound = #[1];}}}
2229  if (size(#) > 1){if (typeof(#[1])=="int"){if (#[2] > 0){n = #[2];}}}
2230  list L;
2231  L = lp2ivId(normalize(lead(G)));
2232  L = ivSickleDim(L,n,degbound);
2233  L[2] = ivL2lpI(L[2]);
2234  return(L);
2235}
2236example
2237{
2238  "EXAMPLE:"; echo = 2;
2239  ring r = 0,(x,y),dp;
2240  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2241  setring R; // sets basering to Letterplace ring
2242  ideal G = x*x, y*y,x*y*x; // ideal G contains a
2243  //Groebner basis
2244  lpSickleDim(G); // invokes the procedure with ring parameters
2245  // the factor algebra is finite, so the degree bound given by the Letterplace
2246  // ring is not necessary
2247  lpSickleDim(G,0); // procedure without any degree bound
2248}
2249
2250static proc lpSickleHil(ideal G, list #)
2251"USAGE: lpSickleHil(G);
2252RETURN: list
2253PURPOSE:Compute the Hilbert series and the mistletoes
2254ASSUME: - basering is a Letterplace ring.
2255@*      - if you specify a different degree bound degbound,
2256@*        degbound <= attrib(basering,uptodeg) holds.
2257NOTE: - If L is the list returned, then L[1] is an intvec, corresponding to the
2258@*      Hilbert series, L[2] is an ideal, the mistletoes.
2259@*    - If degbound is set, there will be a degree bound added. 0 means no
2260@*      degree bound. Default: attrib(basering,uptodeg).
2261@*    - n is the number of variables, which can be set to a different number.
2262@*      Default: attrib(basering, lV).
2263@*    - If I = L[1] is the intvec returned, then I[k] is the (k-1)-th
2264@*      coefficient of the Hilbert series.
2265@*    - If the K-dimension is known to be infinite, a degree bound is needed
2266EXAMPLE: example lpSickleHil; shows examples
2267"
2268{int degbound = attrib(basering,"uptodeg");int n = attrib(basering, "isLetterplaceRing");
2269  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] >= 0){degbound = #[1];}}}
2270  if (size(#) > 1){if (typeof(#[1])=="int"){if (#[2] > 0){n = #[2];}}}
2271  list L;
2272  L = lp2ivId(normalize(lead(G)));
2273  L = ivSickleHil(L,n,degbound);
2274  L[2] =  ivL2lpI(L[2]);
2275  return(L);
2276}
2277example
2278{
2279  "EXAMPLE:"; echo = 2;
2280  ring r = 0,(x,y),dp;
2281  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2282  setring R; // sets basering to Letterplace ring
2283  ideal G = x*x, y*y,x*y*x; // ideal G contains a
2284  //Groebner basis
2285  lpSickleHil(G); // invokes the procedure with ring parameters
2286  // the factor algebra is finite, so the degree bound given by the Letterplace
2287  // ring is not necessary
2288  lpSickleHil(G,0); // procedure without any degree bound
2289}
2290
2291static proc sickle(ideal G, list #)
2292"USAGE: sickle(G[,m, d, h, degbound]); G an ideal; m,d,h,degbound optional
2293@*      integers
2294RETURN: list
2295PURPOSE:Allowing the user to access all procs with one command
2296ASSUME: - basering is a Letterplace ring.
2297@*      - if you specify a different degree bound degbound,
2298@*        degbound <= attrib(basering,uptodeg) holds.
2299NOTE:   The returned object will always be a list, but the entries of the
2300@*      returned list may be very different
2301@* case m=1,d=1,h=1: see lpDHilbertSickle
2302@* case m=1,d=1,h=0: see lpSickleDim
2303@* case m=1,d=0,h=1: see lpSickleHil
2304@* case m=1,d=0,h=0: see lpSickle (this is the default case)
2305@* case m=0,d=1,h=1: see lpDHilbert
2306@* case m=0,d=1,h=0: see lpKDim
2307@* case m=0,d=0,h=1: see lpHilbert
2308@* case m=0,d=0,h=0: returns an error
2309@*    - If degbound is set, there will be a degree bound added. 0 means no
2310@*      degree bound. Default: attrib(basering,uptodeg).
2311@*    - If the K-dimension is known to be infinite, a degree bound is needed
2312EXAMPLE: example sickle; shows examples
2313"
2314{int m,d,h,degbound;
2315  m = 1; d = 0; h = 0; degbound = attrib(basering,"uptodeg");
2316  if (size(#) > 0) {if (typeof(#[1])=="int"){if (#[1] < 1) {m = 0;}}}
2317  if (size(#) > 1) {if (typeof(#[1])=="int"){if (#[2] > 0) {d = 1;}}}
2318  if (size(#) > 2) {if (typeof(#[1])=="int"){if (#[3] > 0) {h = 1;}}}
2319  if (size(#) > 3) {if (typeof(#[1])=="int"){if (#[4] >= 0) {degbound = #[4];}}}
2320  if (m == 1)
2321  {if (d == 0)
2322    {if (h == 0) {return(lpSickle(G,degbound,attrib(basering,"isLetterplaceRing")));}
2323      else        {return(lpSickleHil(G,degbound,attrib(basering,"isLetterplaceRing")));}
2324    }
2325    else
2326    {if (h == 0) {return(lpSickleDim(G,degbound,attrib(basering,"isLetterplaceRing")));}
2327      else {return(lpDHilbertSickle(G,degbound,attrib(basering,"isLetterplaceRing")));}
2328    }
2329  }
2330  else
2331  {if (d == 0)
2332    {if (h == 0) {ERROR("You request to do nothing, so relax and do so");}
2333      else        {return(lpHilbert(G,degbound,attrib(basering,"isLetterplaceRing")));}
2334    }
2335    else
2336    {if (h == 0) {return(lpKDim(G,degbound,attrib(basering,"isLetterplaceRing")));}
2337      else {return(lpDHilbert(G,degbound,attrib(basering,"isLetterplaceRing")));}
2338    }
2339  }
2340}
2341example
2342{
2343  "EXAMPLE:"; echo = 2;
2344  ring r = 0,(x,y),dp;
2345  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2346  setring R; // sets basering to Letterplace ring
2347  ideal G = x*x, y*y,x*y*x;
2348  // G contains a Groebner basis
2349  sickle(G,1,1,1); // computes mistletoes, K-dimension and the Hilbert series
2350  sickle(G,1,0,0); // computes mistletoes only
2351  sickle(G,0,1,0); // computes K-dimension only
2352  sickle(G,0,0,1); // computes Hilbert series only
2353}
2354
2355proc lpMonomialBasis(int d, int donly, ideal J)
2356  "USAGE: lpMonomialBasis(d, donly, J); d, donly integers, J an ideal
2357  RETURN: ideal
2358  PURPOSE: computes a list of free monomials in a Letterplace
2359  @*       basering R of degree at most d and not contained in <LM(J)>
2360  @*       if donly <> 0, only monomials of degree d are returned
2361  ASSUME: - basering is a Letterplace ring.
2362  @*      - d <= attrib(basering,uptodeg) holds.
2363  @*      - J is a Groebner basis
2364  "
2365{
2366  int nv = attrib(basering,"uptodeg");
2367  if ((d>nv) || (d<0) )
2368  {
2369    ERROR("incorrect degree");
2370  }
2371  nv = attrib(basering,"isLetterplaceRing"); // nvars
2372  if (d==0)
2373  {
2374    return(ideal(1));
2375  }
2376  /* from now on d>=1 */
2377  ideal I;
2378  if (size(J)==0)
2379  {
2380    I = maxideal(d);
2381    if (!donly)
2382    {
2383      for (int i = d-1; i >= 0; i--)
2384      {
2385        I = maxideal(i), I;
2386      } kill i;
2387    }
2388    return(I);
2389  }
2390  // ok, Sickle misbehaves: have to remove all
2391  // elts from J of degree >d
2392  ideal JJ;
2393  int j; int sj = ncols(J);
2394  int cnt=0;
2395  for(j=1;j<=sj;j++)
2396  {
2397    if (deg(J[j]) <= d)
2398    {
2399      cnt++;
2400      JJ[cnt]=lead(J[j]); // only LMs are needed
2401    }
2402  }
2403  if (cnt==0)
2404  {
2405    // there are no elements in J of degree <= d
2406    // return free stuff and the 1
2407    I = lpMonomialBasis(d, donly, ideal(0));
2408    if (!donly)
2409    {
2410      I = 1, I;
2411    }
2412    return(I);
2413  }
2414  // from here on, Ibase is not zero
2415  ideal Ibase = lpMis2Base(lpSickle(JJ,d)); // the complete K-basis modulo J up to d
2416  if (!donly)
2417  {
2418    // for not donly, give everything back
2419    Ibase = sort(Ibase)[1];
2420    return(Ibase);
2421  }
2422  /* !donly: pick out only monomials of degree d */
2423  int i; int si = ncols(Ibase);
2424  cnt=0;
2425  I=0;
2426  for(i=1;i<=si;i++)
2427  {
2428    if (deg(Ibase[i]) == d)
2429    {
2430      cnt++;
2431      I[cnt]=Ibase[i];
2432    }
2433  }
2434  kill Ibase;
2435  return(I);
2436}
2437example
2438{
2439  "EXAMPLE:"; echo = 2;
2440  ring r = 0,(x,y),dp;
2441  def R = makeLetterplaceRing(7); setring R;
2442  ideal J = x*y*x - y*x*y;
2443  option(redSB); option(redTail);
2444  J = letplaceGBasis(J);
2445  J;
2446  lpMonomialBasis(2,1,ideal(0));
2447  lpMonomialBasis(2,0,ideal(0));
2448  lpMonomialBasis(3,1,J);
2449  lpMonomialBasis(3,0,J);
2450}
2451
2452///////////////////////////////////////////////////////////////////////////////
2453
2454/*
2455   Here are some examples one may try. Just copy them into your console.
2456   These are relations for braid groups, up to degree d:
2457
2458   LIB "fpadim.lib";
2459   ring r = 0,(x,y,z),dp;
2460   int d =10; // degree
2461   def R = makeLetterplaceRing(d);
2462   setring R;
2463   ideal I = y*x*y - z*y*z, x*y*x - z*x*y,
2464   z*x*z - y*z*x, x*x*x + y*y*y +
2465   z*z*z + x*y*z;
2466   option(prot);
2467   option(redSB);option(redTail);option(mem);
2468   ideal J = system("freegb",I,d,3);
2469   lpKDimCheck(J);
2470   sickle(J,1,1,1,d);//Computes mistletoes, K-dimension and the Hilbert series
2471
2472
2473
2474   LIB "fpadim.lib";
2475   ring r = 0,(x,y,z),dp;
2476   int d =11; // degree
2477   def R = makeLetterplaceRing(d);
2478   setring R;
2479   ideal I = y*x*y - z*y*z, x*y*z - z*x*y,
2480   z*x*z - y*z*x, x*x*x + y*y*y +
2481   z*z*z + x*y*z;
2482   option(prot);
2483   option(redSB);option(redTail);option(mem);
2484   ideal J = system("freegb",I,d,3);
2485   lpKDimCheck(J);
2486   sickle(J,1,1,1,d);
2487
2488
2489
2490   LIB "fpadim.lib";
2491   ring r = 0,(x,y,z),dp;
2492   int d  = 6; // degree
2493   def R  = makeLetterplaceRing(d);
2494   setring R;
2495   ideal I = y*x*y - z*y*z, x*y*x - z*x*y,
2496   z*x*z - y*z*x, x*x*x -2*y*y*y + 3*z*z*z -4*x*y*z + 5*x*z*z- 6*x*y*y +7*x*x*z - 8*x*x*y;
2497   option(prot);
2498   option(redSB);option(redTail);option(mem);
2499   ideal J = system("freegb",I,d,3);
2500   lpKDimCheck(J);
2501   sickle(J,1,1,1,d);
2502 */
2503
2504/*
2505   Here are some examples, which can also be found in [studzins]:
2506
2507// takes up to 880Mb of memory
2508LIB "fpadim.lib";
2509ring r = 0,(x,y,z),dp;
2510int d =10; // degree
2511def R = makeLetterplaceRing(d);
2512setring R;
2513ideal I =
2514z*z*z*z + y*x*y*x - x*y*y*x - 3*z*y*x*z, x*x*x + y*x*y - x*y*x, z*y*x-x*y*z + z*x*z;
2515option(prot);
2516option(redSB);option(redTail);option(mem);
2517ideal J = system("freegb",I,d,nvars(r));
2518lpKDimCheck(J);
2519sickle(J,1,1,1,d); // dimension is 24872
2520
2521
2522LIB "fpadim.lib";
2523ring r = 0,(x,y,z),dp;
2524int d =10; // degree
2525def R = makeLetterplaceRing(d);
2526setring R;
2527ideal I = x*y + y*z, x*x + x*y - y*x - y*y;
2528option(prot);
2529option(redSB);option(redTail);option(mem);
2530ideal J = system("freegb",I,d,3);
2531lpKDimCheck(J);
2532sickle(J,1,1,1,d);
2533 */
2534
2535
2536/*
2537   Example for Compute GK dimension:
2538   returns a ring which contains an ideal I
2539   run gkDim(I) inside this ring and it should return 2n (the GK dimension
2540   of n-th Weyl algebra including evaluation operators).
2541
2542   static proc createWeylEx(int n, int d)
2543   "
2544   "
2545   {
2546   int baseringdef;
2547   if (defined(basering)) // if a basering is defined, it should be saved for later use
2548   {
2549   def save = basering;
2550   baseringdef = 1;
2551   }
2552   ring r = 0,(d(1..n),x(1..n),e(1..n)),dp;
2553   def R = makeLetterplaceRing(d);
2554   setring R;
2555   ideal I; int i,j;
2556
2557   for (i = 1; i <= n; i++)
2558   {
2559   for (j = i+1; j<= n; j++)
2560   {
2561   I[size(I)+1] = lpMult(var(i),var(j));
2562   }
2563   }
2564
2565   for (i = 1; i <= n; i++)
2566   {
2567   for (j = i+1; j<= n; j++)
2568   {
2569   I[size(I)+1] = lpMult(var(n+i),var(n+j));
2570   }
2571   }
2572   for (i = 1; i <= n; i++)
2573   {
2574   for (j = 1; j<= n; j++)
2575   {
2576   I[size(I)+1] = lpMult(var(i),var(n+j));
2577   }
2578   }
2579   for (i = 1; i <= n; i++)
2580   {
2581   for (j = 1; j<= n; j++)
2582   {
2583   I[size(I)+1] = lpMult(var(i),var(2*n+j));
2584   }
2585   }
2586   for (i = 1; i <= n; i++)
2587   {
2588   for (j = 1; j<= n; j++)
2589   {
2590   I[size(I)+1] = lpMult(var(2*n+i),var(n+j));
2591   }
2592   }
2593   for (i = 1; i <= n; i++)
2594   {
2595   for (j = 1; j<= n; j++)
2596   {
2597   I[size(I)+1] = lpMult(var(2*n+i),var(2*n+j));
2598   }
2599   }
2600   I = simplify(I,2+4);
2601   I = letplaceGBasis(I);
2602   export(I);
2603   if (baseringdef == 1) {setring save;}
2604   return(R);
2605   }
2606
2607proc TestGKAuslander3()
2608{
2609  ring r = (0,q),(z,x,y),(dp(2),dp(2));
2610  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2611  R; setring R; // sets basering to Letterplace ring
2612  ideal I;
2613  I = q*x*y - y*x, z*y - y*z, z*x - x*z;
2614  I = letplaceGBasis(I);
2615  lpGkDim(I); // must be 3
2616  I = x*y*z - y*x, z*y - y*z, z*x - x*z;//gkDim = 2
2617  I = letplaceGBasis(I); // not finite BUT contains a poly in x,y only
2618  lpGkDim(I); // must be 4
2619
2620  ring r = 0,(y,x,z),dp;
2621  def R = makeLetterplaceRing(10); // constructs a Letterplace ring
2622  R; setring R; // sets basering to Letterplace ring
2623  ideal I;
2624  I = x*y*z - y*x, z*y - y*z, z*x - x*z;//gkDim = 2
2625  I = letplaceGBasis(I); // computed as it would be homogenized; infinite
2626  poly p = x*y*y*x-y*x*x*y;
2627  lpNF(p, I); // 0 as expected
2628
2629  // with inverse of z
2630  ring r = 0,(iz,z,x,y),dp;
2631  def R = makeLetterplaceRing(11); // constructs a Letterplace ring
2632  R; setring R; // sets basering to Letterplace ring
2633  ideal I;
2634  I = x*y*z - y*x, z*y - y*z, z*x - x*z,
2635    iz*y - y*iz, iz*x - x*iz, iz*z-1, z*iz -1;
2636  I = letplaceGBasis(I); //
2637  setring r;
2638  def R2 = makeLetterplaceRing(23); // constructs a Letterplace ring
2639  setring R2; // sets basering to Letterplace ring
2640  ideal I = imap(R,I);
2641  lpGkDim(I);
2642
2643
2644  ring r = 0,(t,z,x,y),(dp,dp);
2645  def R = makeLetterplaceRing(20); // constructs a Letterplace ring
2646  R; setring R; // sets basering to Letterplace ring
2647  ideal I;
2648  I = x*y*z - y*x*t, z*y - y*z, z*x - x*z,
2649    t*y - y*t, t*x - x*t, t*z - z*t;//gkDim = 2
2650  I = letplaceGBasis(I); // computed as it would be homogenized; infinite
2651  LIB "elim.lib";
2652  ideal Inoz = nselect(I,intvec(2,6,10,14,18,22,26,30));
2653  for(int i=1; i<=20; i++)
2654  {
2655    Inoz=subst(Inoz,t(i),1);
2656  }
2657  ideal J = x*y*y*x-y*x*x*y;
2658  J = letplaceGBasis(J);
2659
2660  poly p = x*y*y*x-y*x*x*y;
2661  lpNF(p, I); // 0 as expected
2662
2663  ring r2 = 0,(x,y),dp;
2664  def R2 = makeLetterplaceRing(50); // constructs a Letterplace ring
2665  setring R2;
2666  ideal J = x*y*y*x-y*x*x*y;
2667  J = letplaceGBasis(J);
2668}
2669
2670*/
2671
2672
2673/*   more tests : downup algebra A
2674LIB "fpadim.lib";
2675ring r = (0,a,b,g),(x,y),Dp;
2676def R = makeLetterplaceRing(6); // constructs a Letterplace ring
2677setring R;
2678poly F1 = g*x;
2679poly F2 = g*y;
2680ideal J = x*x*y-a*x*y*x - b*y*x*x - F1,
2681x*y*y-a*y*x*y - b*y*y*x - F2;
2682J = letplaceGBasis(J);
2683lpGkDim(J); // 3 == correct
2684
2685// downup algebra B
2686LIB "fpadim.lib";
2687ring r = (0,a,b,g, p(1..7),q(1..7)),(x,y),Dp;
2688def R = makeLetterplaceRing(6); // constructs a Letterplace ring
2689setring R;
2690ideal imn = 1, y*y*y, x*y, y*x, x*x, y*y, x, y;
2691int i;
2692poly F1, F2;
2693for(i=1;i<=7;i++)
2694{
2695F1 = F1 + p(i)*imn[i];
2696F2 = F2 + q(i)*imn[i];
2697}
2698ideal J = x*x*y-a*x*y*x - b*y*x*x - F1,
2699x*y*y-a*y*x*y - b*y*y*x - F2;
2700J = letplaceGBasis(J);
2701lpGkDim(J); // 3 == correct
2702 */
Note: See TracBrowser for help on using the repository browser.