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

fieker-DuValspielwiese
Last change on this file since 4d0ea67 was 4d0ea67, checked in by Karim Abou Zeid <karim23697@…>, 6 years ago
Add error message to Uf-Graph when l = 1
  • Property mode set to 100644
File size: 112.3 KB
Line 
1///////////////////////////////////////////////////////
2version="$Id$";
3category="Noncommutative";
4info="
5LIBRARY: fpadim.lib     Algorithms for quotient algebras in the letterplace case
6AUTHORS: Grischa Studzinski,       grischa.studzinski@rwth-aachen.de
7@*       Viktor Levandovskyy,      viktor.levandovskyy@math.rwth-aachen.de
8@*       Karim Abou Zeid,          karim.abou.zeid@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'
12@* of the German DFG
13
14OVERVIEW: Given the free algebra A = K<x_1,...,x_n> and a (finite) Groebner basis
15@*      GB = {g_1,..,g_w}, one is interested in the K-dimension and in the
16@*      explicit K-basis of A/<GB>.
17@*      Therefore one is interested in the following data:
18@*      - the Ufnarovskij graph induced by GB
19@*      - the mistletoes of A/<GB>
20@*      - the K-dimension of A/<GB>
21@*      - the Hilbert series of A/<GB>
22@*
23@*      The Ufnarovskij graph is used to determine whether A/<GB> has finite
24@*      K-dimension. One has to check if the graph contains cycles.
25@*      For the whole theory we refer to [ufna]. Given a
26@*      reduced set of monomials GB one can define the basis tree, whose vertex
27@*      set V consists of all normal monomials w.r.t. GB. For every two
28@*      monomials m_1, m_2 in V there is a direct edge from m_1 to m_2, if and
29@*      only if there exists x_k in {x_1,..,x_n}, such that m_1*x_k = m_2. The
30@*      set M = {m in V | there is no edge from m to another monomial in V} is
31@*      called the set of mistletoes. As one can easily see it consists of
32@*      the endpoints of the graph. Since there is a unique path to every
33@*      monomial in V the whole graph can be described only from the knowledge
34@*      of the mistletoes. Note that V corresponds to a basis of A/<GB>, so
35@*      knowing the mistletoes we know a K-basis. The name mistletoes was given
36@*      to those points because of these miraculous value and the algorithm is
37@*      named sickle, because a sickle is the tool to harvest mistletoes.
38@*      For more details see [studzins]. This package uses the Letterplace
39@*      format introduced by [lls]. The algebra can either be represented as a
40@*      Letterplace ring or via integer vectors: Every variable will only be
41@*      represented by its number, so variable one is represented as 1,
42@*      variable two as 2 and so on. The monomial x_1*x_3*x_2 for example will
43@*      be stored as (1,3,2). Multiplication is concatenation. Note that there
44@*      is no algorithm for computing the normal form yet, but for our case it
45@*      is not needed. Note that the name fpadim.lib is short for dimensions of
46@*      finite presented algebras.
47@*
48
49REFERENCES:
50
51@*   [ufna] Ufnarovskij: Combinatorical and asymptotic methods in algebra, 1990
52@*   [lls] Levandovskyy, La Scala: Letterplace ideals and non-commutative
53Groebner bases, 2009
54@*   [studzins] Studzinski: Dimension computations in non-commutative,
55associative algebras, Diploma thesis, RWTH Aachen, 2010
56
57ASSUMPTIONS:
58@* - basering is always a Letterplace ring
59@* - all intvecs correspond to Letterplace monomials
60@* - if you specify a different degree bound d,
61d <= attrib(basering,uptodeg) holds
62@* In the procedures below, 'iv' stands for intvec representation
63and 'lp' for the letterplace representation of monomials
64
65PROCEDURES:
66
67lpGkDim(G);                        computes the Gelfand Kirillov dimension of A/<G>
68ivDHilbert(L,n[,d]);       computes the K-dimension and the Hilbert series
69ivDHilbertSickle(L,n[,d]); computes mistletoes, K-dimension and Hilbert series
70ivDimCheck(L,n);           checks if the K-dimension of A/<L> is infinite
71lpGlDimBound(G);           computes upper bound of global dimension of A/<G>
72ivHilbert(L,n[,d]);        computes the Hilbert series of A/<L> in intvec format
73ivKDim(L,n[,d]);           computes the K-dimension of A/<L> in intvec format
74ivMis2Base(M);             computes a K-basis of the factor algebra
75ivMis2Dim(M);              computes the K-dimension of the factor algebra
76ivOrdMisLex(M);            orders a list of intvecs lexicographically
77ivSickle(L,n[,d]);         computes the mistletoes of A/<L> in intvec format
78ivSickleHil(L,n[,d]);      computes the mistletoes and Hilbert series of A/<L>
79ivSickleDim(L,n[,d]);      computes the mistletoes and the K-dimension of A/<L>
80lpDHilbert(G[,d,n]);       computes the K-dimension and Hilbert series of A/<G>
81lpDHilbertSickle(G[,d,n]); computes mistletoes, K-dimension and Hilbert series
82lpHilbert(G[,d,n]);        computes the Hilbert series of A/<G> in lp format
83lpDimCheck(G);             checks if the K-dimension of A/<G> is infinite
84lpKDim(G[,d,n]);           computes the K-dimension of A/<G> in lp format
85lpMis2Base(M);             computes a K-basis of the factor algebra
86lpMis2Dim(M);              computes the K-dimension of the factor algebra
87lpOrdMisLex(M);            orders an ideal of lp-monomials lexicographically
88lpSickle(G[,d,n]);         computes the mistletoes of A/<G> in lp format
89lpSickleHil(G[,d,n]);      computes the mistletoes and Hilbert series of A/<G>
90lpSickleDim(G[,d,n]);      computes the mistletoes and the K-dimension of A/<G>
91sickle(G[,m,d,h]);         can be used to access all lp main procedures
92
93
94ivL2lpI(L);           transforms a list of intvecs into an ideal of lp monomials
95iv2lp(I);             transforms an intvec into the corresponding monomial
96iv2lpList(L);         transforms a list of intmats into an ideal of lp monomials
97iv2lpMat(M);          transforms an intmat into an ideal of lp monomials
98lp2iv(p);             transforms a polynomial into the corresponding intvec
99lp2ivId(G);           transforms an ideal into the corresponding list of intmats
100lpId2ivLi(G);         transforms a lp-ideal into the corresponding list of intvecs
101
102SEE ALSO: freegb_lib
103";
104
105LIB "freegb.lib"; //for letterplace rings
106LIB "general.lib";//for sorting mistletoes
107
108/////////////////////////////////////////////////////////
109
110
111//--------------- auxiliary procedures ------------------
112
113static proc allVars(list L, intvec P, int n)
114"USAGE: allVars(L,P,n); L a list of intmats, P an intvec, n an integer
115RETURN: int, 0 if all variables are contained in the quotient algebra, 1 otherwise
116"
117{int i,j,r;
118  intvec V;
119  for (i = 1; i <= size(P); i++) {if (P[i] == 1){ j = i; break;}}
120  V = L[j][1..nrows(L[j]),1];
121  for (i = 1; i <= n; i++) {if (isInVec(i,V) == 0) {r = 1; break;}}
122  if (r == 0) {return(1);}
123  else {return(0);}
124}
125
126static proc checkAssumptions(int d, list L)
127"PURPOSE: Checks, if all the Assumptions are holding
128"
129{if (typeof(attrib(basering,"isLetterplaceRing"))=="string") {ERROR("Basering is not a Letterplace ring!");}
130  if (d > attrib(basering,"uptodeg")) {ERROR("Specified degree bound exceeds ring parameter!");}
131  int i;
132  for (i = 1; i <= size(L); i++)
133  {if (entryViolation(L[i], attrib(basering,"lV")))
134    {ERROR("Not allowed monomial/intvec found!");}
135  }
136  return();
137}
138
139static proc createStartMat(int d, int n)
140"USAGE: createStartMat(d,n); d, n integers
141RETURN: intmat
142PURPOSE:Creating the intmat with all normal monomials in n variables and of degree d to start with
143NOTE:   d has to be > 0
144"
145{intmat M[(n^d)][d];
146  int i1,i2,i3,i4;
147  for (i1 = 1; i1 <= d; i1++)  //Spalten
148  {i2 = 1; //durchlaeuft Zeilen
149    while (i2 <= (n^d))
150    {for (i3 = 1; i3 <= n; i3++)
151      {for (i4 = 1; i4 <= (n^(i1-1)); i4++)
152        {M[i2,i1] = i3;
153          i2 = i2 + 1;
154        }
155      }
156    }
157  }
158  return(M);
159}
160
161static proc createStartMat1(int n, intmat M)
162"USAGE: createStartMat1(n,M); n an integer, M an intmat
163RETURN: intmat, with all variables except those in M
164"
165{int i;
166  intvec V,Vt;
167  V = M[(1..nrows(M)),1];
168  for (i = 1; i <= size(V); i++) {if (isInVec(i,V) == 0) {Vt = Vt,i;}}
169  if (Vt == 0) {intmat S; return(S);}
170  else {Vt = Vt[2..size(Vt)]; intmat S [size(Vt)][1]; S[1..size(Vt),1] = Vt; return(S);}
171}
172
173static proc entryViolation(intmat M, int n)
174"PURPOSE:checks, if all entries in M are variable-related
175"
176{int i,j;
177  for (i = 1; i <= nrows(M); i++)
178  {for (j = 1; j <= ncols(M); j++)
179    {if(!((1<=M[i,j])&&(M[i,j]<=n))) {return(1);}}
180  }
181  return(0);
182}
183
184static proc findDimen(intvec V, int n, list L, intvec P, list #)
185"USAGE: findDimen(V,n,L,P,degbound); V,P intvecs, n, an integer, L a list,
186@*      degbound an optional integer
187RETURN: int
188PURPOSE:Computing the K-dimension of the quotient algebra
189"
190{int degbound = 0;
191  if (size(#) > 0) {if (#[1] > 0) {degbound = #[1];}}
192  int dimen,i,j,w,it;
193  intvec Vt,Vt2;
194  module M;
195  if (degbound == 0)
196  {for (i = 1; i <= n; i++)
197    {Vt = V, i; w = 0;
198      for (j = 1; j<= size(P); j++)
199      {if (P[j] <= size(Vt))
200        {Vt2 = Vt[(size(Vt)-P[j]+1)..size(Vt)];
201          if (isInMat(Vt2,L[j]) > 0) {w = 1; break;}
202        }
203      }
204      if (w == 0)
205      {vector Vtt;
206        for (it = 1; it <= size(Vt); it++){Vtt = Vtt + Vt[it]*gen(it);}
207        M = M,Vtt;
208        kill Vtt;
209      }
210    }
211    if (size(M) == 0) {return(0);}
212    else
213    {M = simplify(M,2);
214      for (i = 1; i <= size(M); i++)
215      {kill Vt; intvec Vt;
216        for (j =1; j <= size(M[i]); j++){Vt[j] =  int(leadcoef(M[i][j]));}
217        dimen = dimen + 1 + findDimen(Vt,n,L,P);
218      }
219      return(dimen);
220    }
221  }
222  else
223  {if (size(V) > degbound) {ERROR("monomial exceeds degreebound");}
224    if (size(V) == degbound) {return(0);}
225    for (i = 1; i <= n; i++)
226    {Vt = V, i; w = 0;
227      for (j = 1; j<= size(P); j++)
228      {if (P[j] <= size(Vt))
229        {Vt2 = Vt[(size(Vt)-P[j]+1)..size(Vt)];
230          if (isInMat(Vt2,L[j]) > 0) {w = 1; break;}
231        }
232      }
233      if (w == 0) {vector Vtt;
234        for (it = 1; it <= size(Vt); it++){Vtt = Vtt + Vt[it]*gen(it);}
235        M = M,Vtt;
236        kill Vtt;
237      }
238    }
239    if (size(M) == 0) {return(0);}
240    else
241    {M = simplify(M,2);
242      for (i = 1; i <= size(M); i++)
243      {kill Vt; intvec Vt;
244        for (j =1; j <= size(M[i]); j++){Vt[j] =  int(leadcoef(M[i][j]));}
245        dimen = dimen + 1 + findDimen(Vt,n,L,P,degbound);
246      }
247      return(dimen);
248    }
249  }
250}
251
252static proc findCycle(intvec V, list L, intvec P, int n, int ld, module M)
253"USAGE:
254RETURN: int, 1 if Ufn-graph contains a cycle, or 0 otherwise
255PURPOSE:Searching the Ufnarovskij graph for cycles
256"
257{int i,j,w,r;intvec Vt,Vt2;
258  int it, it2;
259  if (size(V) < ld)
260  {for (i = 1; i <= n; i++)
261    {Vt = V,i; w = 0;
262      for (j = 1; j <= size(P); j++)
263      {if (P[j] <= size(Vt))
264        {Vt2 = Vt[(size(Vt)-P[j]+1)..size(Vt)];
265          if (isInMat(Vt2,L[j]) > 0)
266          {w = 1; break;}
267        }
268      }
269      if (w == 0) {r = findCycle(Vt,L,P,n,ld,M);}
270      if (r == 1) {break;}
271    }
272    return(r);
273  }
274  else
275  {j = size(M);
276    if (j > 0)
277    {
278      intmat Mt[j][nrows(M)];
279      for (it = 1; it <= j; it++)
280      { for(it2 = 1; it2 <= nrows(M);it2++)
281        {Mt[it,it2] = int(leadcoef(M[it2,it]));}
282      }
283      Vt = V[(size(V)-ld+1)..size(V)];
284      //Mt; type(Mt);Vt;type(Vt);
285      if (isInMat(Vt,Mt) > 0) {return(1);}
286      else
287      {vector Vtt;
288        for (it =1; it <= size(Vt); it++)
289        {Vtt = Vtt + Vt[it]*gen(it);}
290        M = M,Vtt;
291        kill Vtt;
292        for (i = 1; i <= n; i++)
293        {Vt = V,i; w = 0;
294          for (j = 1; j <= size(P); j++)
295          {if (P[j] <= size(Vt))
296            {Vt2 = Vt[(size(Vt)-P[j]+1)..size(Vt)];
297              //L[j]; type(L[j]);Vt2;type(Vt2);
298              if (isInMat(Vt2,L[j]) > 0)
299              {w = 1; break;}
300            }
301          }
302          if (w == 0) {r = findCycle(Vt,L,P,n,ld,M);}
303          if (r == 1) {break;}
304        }
305        return(r);
306      }
307    }
308    else
309    { Vt = V[(size(V)-ld+1)..size(V)];
310      vector Vtt;
311      for (it = 1; it <= size(Vt); it++)
312      {Vtt = Vtt + Vt[it]*gen(it);}
313      M = Vtt;
314      kill Vtt;
315      for (i = 1; i <= n; i++)
316      {Vt = V,i; w = 0;
317        for (j = 1; j <= size(P); j++)
318        {if (P[j] <= size(Vt))
319          {Vt2 = Vt[(size(Vt)-P[j]+1)..size(Vt)];
320            //L[j]; type(L[j]);Vt2;type(Vt2);
321            if (isInMat(Vt2,L[j]) > 0)
322            {w = 1; break;}
323          }
324        }
325        if (w == 0) {r = findCycle(Vt,L,P,n,ld,M);}
326        if (r == 1) {break;}
327      }
328      return(r);
329    }
330  }
331}
332
333
334static proc findCycleDFS(int i, intmat T, intvec V)
335"
336PURPOSE:
337this is a classical deep-first search for cycles contained in a graph given by an intmat
338"
339{
340  intvec rV;
341  int k,k1,t;
342  int j = V[size(V)];
343  if (T[j,i] > 0) {return(V);}
344  else
345  {
346    for (k = 1; k <= ncols(T); k++)
347    {
348      t = 0;
349      if (T[j,k] > 0)
350      {
351        for (k1 = 1; k1 <= size(V); k1++) {if (V[k1] == k) {t = 1; break;}}
352        if (t == 0)
353        {
354          rV = V;
355          rV[size(rV)+1] = k;
356          rV = findCycleDFS(i,T,rV);
357          if (rV[1] > -1) {return(rV);}
358        }
359      }
360    }
361  }
362  return(intvec(-1));
363}
364
365
366
367static proc findHCoeff(intvec V,int n,list L,intvec P,intvec H,list #)
368"USAGE: findHCoeff(V,n,L,P,H,degbound); L a list of intmats, degbound an integer
369RETURN: intvec
370PURPOSE:Computing the coefficient of the Hilbert series (upto degree degbound)
371NOTE:   Starting with a part of the Hilbert series we change the coefficient
372@*      depending on how many basis elements we found on the actual branch
373"
374{int degbound = 0;
375  if (size(#) > 0){if (#[1] > 0){degbound = #[1];}}
376  int i,w,j,it;
377  int h1 = 0;
378  intvec Vt,Vt2,H1;
379  module M;
380  if (degbound == 0)
381  {for (i = 1; i <= n; i++)
382    {Vt = V, i; w = 0;
383      for (j = 1; j<= size(P); j++)
384      {if (P[j] <= size(Vt))
385        {Vt2 = Vt[(size(Vt)-P[j]+1)..size(Vt)];
386          if (isInMat(Vt2,L[j]) > 0) {w = 1; break;}
387        }
388      }
389      if (w == 0)
390      {vector Vtt;
391        for (it = 1; it <= size(Vt); it++){Vtt = Vtt + Vt[it]*gen(it);}
392        M = M,Vtt;
393        kill Vtt;
394      }
395    }
396    if (size(M) == 0) {return(H);}
397    else
398    {M = simplify(M,2);
399      for (i = 1; i <= size(M); i++)
400      {kill Vt; intvec Vt;
401        for (j =1; j <= size(M[i]); j++) {Vt[j] =  int(leadcoef(M[i][j]));}
402        h1 = h1 + 1; H1 = findHCoeff(Vt,n,L,P,H1);
403      }
404      if (size(H1) < (size(V)+2)) {H1[(size(V)+2)] = h1;}
405      else {H1[(size(V)+2)] = H1[(size(V)+2)] + h1;}
406      H1 = H1 + H;
407      return(H1);
408    }
409  }
410  else
411  {if (size(V) > degbound) {ERROR("monomial exceeds degreebound");}
412    if (size(V) == degbound) {return(H);}
413    for (i = 1; i <= n; i++)
414    {Vt = V, i; w = 0;
415      for (j = 1; j<= size(P); j++)
416      {if (P[j] <= size(Vt))
417        {Vt2 = Vt[(size(Vt)-P[j]+1)..size(Vt)];
418          if (isInMat(Vt2,L[j]) > 0) {w = 1; break;}
419        }
420      }
421      if (w == 0)
422      {vector Vtt;
423        for (it = 1; it <= size(Vt); it++){Vtt = Vtt + Vt[it]*gen(it);}
424        M = M,Vtt;
425        kill Vtt;
426      }
427    }
428    if (size(M) == 0) {return(H);}
429    else
430    {M = simplify(M,2);
431      for (i = 1; i <= size(M); i++)
432      {kill Vt; intvec Vt;
433        for (j =1; j <= size(M[i]); j++)
434        {Vt[j] =  int(leadcoef(M[i][j]));}
435        h1 = h1 + 1; H1 = findHCoeff(Vt,n,L,P,H1,degbound);
436      }
437      if (size(H1) < (size(V)+2)) { H1[(size(V)+2)] = h1;}
438      else {H1[(size(V)+2)] = H1[(size(V)+2)] + h1;}
439      H1 = H1 + H;
440      return(H1);
441    }
442  }
443}
444
445static proc findHCoeffMis(intvec V, int n, list L, intvec P, list R,list #)
446"USAGE: findHCoeffMis(V,n,L,P,R,degbound); degbound an optional integer, L a
447@*      list of Intmats, R
448RETURN: list
449PURPOSE:Computing the coefficients of the Hilbert series and the Mistletoes all
450@*      at once
451"
452{int degbound = 0;
453  if (size(#) > 0) {if (#[1] > 0) {degbound = #[1];}}
454  int i,w,j,h1;
455  intvec Vt,Vt2,H1; int it;
456  module M;
457  if (degbound == 0)
458  {for (i = 1; i <= n; i++)
459    {Vt = V, i; w = 0;
460      for (j = 1; j<= size(P); j++)
461      {if (P[j] <= size(Vt))
462        {Vt2 = Vt[(size(Vt)-P[j]+1)..size(Vt)];
463          if (isInMat(Vt2,L[j]) > 0) {w = 1; break;}
464        }
465      }
466      if (w == 0)
467      {vector Vtt;
468        for (it = 1; it <= size(Vt); it++){Vtt = Vtt + Vt[it]*gen(it);}
469        M = M,Vtt;
470        kill Vtt;
471      }
472    }
473    if (size(M) == 0) {if (size(R) < 2){R[2] = list(V);} else {R[2] = R[2] + list(V);} return(R);}
474    else
475    {M = simplify(M,2);
476      for (i = 1; i <= size(M); i++)
477      {kill Vt; intvec Vt;
478        for (j =1; j <= size(M[i]); j++)
479        {Vt[j] =  int(leadcoef(M[i][j]));}
480        if (size(R[1]) < (size(V)+2)) { R[1][(size(V)+2)] = 1;}
481        else
482        {R[1][(size(V)+2)] = R[1][(size(V)+2)] + 1;}
483        R = findHCoeffMis(Vt,n,L,P,R);
484      }
485      return(R);
486    }
487  }
488  else
489  {if (size(V) > degbound) {ERROR("monomial exceeds degreebound");}
490    if (size(V) == degbound)
491    {if (size(R) < 2){R[2] = list (V);}
492      else{R[2] = R[2] + list (V);}
493      return(R);
494    }
495    for (i = 1; i <= n; i++)
496    {Vt = V, i; w = 0;
497      for (j = 1; j<= size(P); j++)
498      {if (P[j] <= size(Vt))
499        {Vt2 = Vt[(size(Vt)-P[j]+1)..size(Vt)];
500          if (isInMat(Vt2,L[j]) > 0) {w = 1; break;}
501        }
502      }
503      if (w == 0)
504      {vector Vtt;
505        for (it = 1; it <= size(Vt); it++){Vtt = Vtt + Vt[it]*gen(it);}
506        M = M,Vtt;
507        kill Vtt;
508      }
509    }
510    if (size(M) == 0) {if (size(R) < 2){R[2] = list(V);} else {R[2] = R[2] + list(V);} return(R);}
511    else
512    {M = simplify(M,2);
513      for (i = 1; i <= ncols(M); i++)
514      {kill Vt; intvec Vt;
515        for (j =1; j <= size(M[i]); j++)
516        {Vt[j] =  int(leadcoef(M[i][j]));}
517        if (size(R[1]) < (size(V)+2)) { R[1][(size(V)+2)] = 1;}
518        else
519        {R[1][(size(V)+2)] = R[1][(size(V)+2)] + 1;}
520        R = findHCoeffMis(Vt,n,L,P,R,degbound);
521      }
522      return(R);
523    }
524  }
525}
526
527
528static proc findMisDim(intvec V,int n,list L,intvec P,list R,list #)
529"USAGE:
530RETURN: list
531PURPOSE:Computing the K-dimension and the Mistletoes all at once
532"
533{int degbound = 0;
534  if (size(#) > 0) {if (#[1] > 0) {degbound = #[1];}}
535  int dimen,i,j,w;
536  intvec Vt,Vt2; int it;
537  module M;
538  if (degbound == 0)
539  {for (i = 1; i <= n; i++)
540    {Vt = V, i; w = 0;
541      for (j = 1; j<= size(P); j++)
542      {if (P[j] <= size(Vt))
543        {Vt2 = Vt[(size(Vt)-P[j]+1)..size(Vt)];
544          if (isInMat(Vt2,L[j]) > 0) {w = 1; break;}
545        }
546      }
547      if (w == 0)
548      {vector Vtt;
549        for (it = 1; it <= size(Vt); it++){Vtt = Vtt + Vt[it]*gen(it);}
550        M = M,Vtt;
551        kill Vtt;
552      }
553    }
554    if (size(M) == 0)
555    {if (size(R) < 2){R[2] = list (V);}
556      else{R[2] = R[2] + list(V);}
557      return(R);
558    }
559    else
560    {M = simplify(M,2);
561      for (i = 1; i <= size(M); i++)
562      {kill Vt; intvec Vt;
563        for (j =1; j <= size(M[i]); j++){Vt[j] =  int(leadcoef(M[i][j]));}
564        R[1] = R[1] + 1; R = findMisDim(Vt,n,L,P,R);
565      }
566      return(R);
567    }
568  }
569  else
570  {if (size(V) > degbound) {ERROR("monomial exceeds degreebound");}
571    if (size(V) == degbound)
572    {if (size(R) < 2){R[2] = list (V);}
573      else{R[2] = R[2] + list (V);}
574      return(R);
575    }
576    for (i = 1; i <= n; i++)
577    {Vt = V, i; w = 0;
578      for (j = 1; j<= size(P); j++)
579      {if (P[j] <= size(Vt))
580        {Vt2 = Vt[(size(Vt)-P[j]+1)..size(Vt)];
581          if (isInMat(Vt2,L[j]) > 0) {w = 1; break;}
582        }
583      }
584      if (w == 0)
585      {vector Vtt;
586        for (it = 1; it <= size(Vt); it++){Vtt = Vtt + Vt[it]*gen(it);}
587        M = M,Vtt;
588        kill Vtt;
589      }
590    }
591    if (size(M) == 0)
592    {if (size(R) < 2){R[2] = list (V);}
593      else{R[2] = R[2] + list(V);}
594      return(R);
595    }
596    else
597    {M = simplify(M,2);
598      for (i = 1; i <= size(M); i++)
599      {kill Vt; intvec Vt;
600        for (j =1; j <= size(M[i]); j++){Vt[j] =  int(leadcoef(M[i][j]));}
601        R[1] = R[1] + 1; R = findMisDim(Vt,n,L,P,R,degbound);
602      }
603      return(R);
604    }
605  }
606}
607
608
609static proc findmistletoes(intvec V, int n, list L, intvec P, list #)
610"USAGE: findmistletoes(V,n,L,P,degbound); V a normal word, n the number of
611@*      variables, L the GB, P the occuring degrees,
612@*      and degbound the (optional) degreebound
613RETURN:  list
614PURPOSE:Computing mistletoes starting in V
615NOTE:   V has to be normal w.r.t. L, it will not be checked for being so
616"
617{int degbound = 0;
618  if (size(#) > 0) {if (#[1] > 0) {degbound = #[1];}}
619  list R; intvec Vt,Vt2; int it;
620  int i,j;
621  module M;
622  if (degbound == 0)
623  {int w;
624    for (i = 1; i <= n; i++)
625    {Vt = V,i; w = 0;
626      for (j = 1; j <= size(P); j++)
627      {if (P[j] <= size(Vt))
628        {Vt2 = Vt[(size(Vt)-P[j]+1)..size(Vt)];
629          if (isInMat(Vt2,L[j]) > 0)
630          {w = 1; break;}
631        }
632      }
633      if (w == 0)
634      {vector Vtt;
635        for (it = 1; it <= size(Vt); it++){Vtt = Vtt + Vt[it]*gen(it);}
636        M = M,Vtt;
637        kill Vtt;
638      }
639    }
640    if (size(M)==0) {R = V; return(R);}
641    else
642    {M = simplify(M,2);
643      for (i = 1; i <= size(M); i++)
644      {kill Vt; intvec Vt;
645        for (j =1; j <= size(M[i]); j++){Vt[j] =  int(leadcoef(M[i][j]));}
646        R = R + findmistletoes(Vt,n,L,P);
647      }
648      return(R);
649    }
650  }
651  else
652  {if (size(V) > degbound) {ERROR("monomial exceeds degreebound");}
653    if (size(V) == degbound) {R = V; return(R);}
654    int w;
655    for (i = 1; i <= n; i++)
656    {Vt = V,i; w = 0;
657      for (j = 1; j <= size(P); j++)
658      {if (P[j] <= size(Vt))
659        {Vt2 = Vt[(size(Vt)-P[j]+1)..size(Vt)];
660          if (isInMat(Vt2,L[j]) > 0){w = 1; break;}
661        }
662      }
663      if (w == 0)
664      {vector Vtt;
665        for (it = 1; it <= size(Vt); it++){Vtt = Vtt + Vt[it]*gen(it);}
666        M = M,Vtt;
667        kill Vtt;
668      }
669    }
670    if (size(M) == 0) {R = V; return(R);}
671    else
672    {M = simplify(M,2);
673      for (i = 1; i <= ncols(M); i++)
674      {kill Vt; intvec Vt;
675        for (j =1; j <= size(M[i]); j++)
676        {Vt[j] =  int(leadcoef(M[i][j]));}
677        //Vt; typeof(Vt); size(Vt);
678        R = R + findmistletoes(Vt,n,L,P,degbound);
679      }
680      return(R);
681    }
682  }
683}
684
685static proc growthAlg(intmat T, list #)
686"
687real algorithm for checking the growth of an algebra
688"
689{
690  int s = 1;
691  if (size(#) > 0) { s = #[1];}
692  int j;
693  int n = ncols(T);
694  intvec NV,C; NV[n] = 0; int m,i;
695  intmat T2[n][n] = T[1..n,1..n]; intmat N[n][n];
696  if (T2 == N)
697  {
698    for (i = 1; i <= n; i++)
699    {
700      if (m <  T[n+1,i]) { m = T[n+1,i];}
701    }
702    return(m);
703  }
704
705  //first part: the diagonals
706  for (i = s; i <= n; i++)
707  {
708    if (T[i,i] > 0)
709    {
710      if ((T[i,i] >= 1) && (T[n+1,i] > 0)) {return(-1);}
711      if ((T[i,i] == 1) && (T[n+1,i] == 0))
712      {
713        T[i,i] = 0;
714        T[n+1,i] = 1;
715        return(growthAlg(T));
716      }
717    }
718  }
719
720  //second part: searching for the last but one vertices
721  T2 = T2*T2;
722  for (i = s; i <= n; i++)
723  {
724    if ((intvec(T[i,1..n]) <> intvec(0)) && (intvec(T2[i,1..n]) == intvec(0)))
725    {
726      for (j = 1; j <= n; j++)
727      {
728        if ((T[i,j] > 0) && (m < T[n+1,j])) {m = T[n+1,j];}
729      }
730      T[n+1,i] = T[n+1,i] + m;
731      T[i,1..n] = NV;
732      return(growthAlg(T));
733    }
734  }
735  m = 0;
736
737  //third part: searching for circles
738  for (i = s; i <= n; i++)
739  {
740    T2 = T[1..n,1..n];
741    C = findCycleDFS(i,T2, intvec(i));
742    if (C[1] > 0)
743    {
744      for (j = 2; j <= size(C); j++)
745      {
746        T[i,1..n] = T[i,1..n] + T[C[j],1..n];
747        T[C[j],1..n] = NV;
748      }
749      for (j = 2; j <= size(C); j++)
750      {
751        T[1..n,i] = T[1..n,i] + T[1..n,C[j]];
752        T[1..n,C[j]] = NV;
753      }
754      T[i,i] = T[i,i] - size(C) + 1;
755      m = 0;
756      for (j = 1; j <= size(C); j++)
757      {
758        m = m + T[n+1,C[j]];
759      }
760      for (j = 1; j <= size(C); j++)
761      {
762        T[n+1,C[j]] = m;
763      }
764      return(growthAlg(T,i));
765    }
766    else {ERROR("No Cycle found, something seems wrong! Please contact the authors.");}
767  }
768
769  m = 0;
770  for (i = 1; i <= n; i++)
771  {
772    if (m < T[n+1,i])
773    {
774      m = T[n+1,i];
775    }
776  }
777  return(m);
778}
779
780static proc GlDimSuffix(intvec v, intvec g)
781{
782  //Computes the shortest r such that g is a suffix for vr
783  //only valid for lex orderings?
784  intvec r,gt,vt,lt,g2;
785  int lg,lv,l,i,c,f;
786  lg = size(g); lv = size(v);
787  if (lg <= lv)
788  {
789    l = lv-lg;
790  }
791  else
792  {
793    l = 0; g2 = g[(lv+1)..lg];
794    g = g[1..lv]; lg = size(g);
795    c = 1;
796  }
797  while (l < lv)
798  {
799    vt = v[(l+1)..lv];
800    gt = g[1..(lv-l)];
801    lt = size(gt);
802    for (i = 1; i <= lt; i++)
803    {
804      if (vt[i]<>gt[i]) {l++; break;}
805    }
806    if (lt <=i ) { f = 1; break;}
807  }
808  if (f == 0) {return(g);}
809  r = g[(lv-l+1)..lg];
810  if (c == 1) {r = r,g2;}
811  return(r);
812}
813
814static proc isNormal(intvec V, list G)
815{
816  int i,j,k,l;
817  k = 0;
818  for (i = 1; i <= size(G); i++)
819  {
820    if ( size(G[i]) <= size(V) )
821    {
822      while ( size(G[i])+k <= size(V) )
823      {
824        if ( G[i] == V[(1+k)..size(V)] ) {return(1);}
825      }
826    }
827  }
828  return(0);
829}
830
831static proc findDChain(list L)
832{
833  list Li; int i,j;
834  for (i = 1; i <= size(L); i++) {Li[i] = size(L[i]);}
835  Li = sort(Li); Li = Li[1];
836  return(Li[size(Li)]);
837}
838
839static proc isInList(intvec V, list L)
840"USAGE: isInList(V,L); V an intvec, L a list of intvecs
841RETURN: int
842PURPOSE:Finding the position of V in L, returns 0, if V is not in M
843"
844{int i,n;
845  n = 0;
846  for (i = 1; i <= size(L); i++) {if (L[i] == V) {n = i; break;}}
847  return(n);
848}
849
850static proc isInMat(intvec V, intmat M)
851"USAGE: isInMat(V,M);V an intvec, M an intmat
852RETURN: int
853PURPOSE:Finding the position of V in M, returns 0, if V is not in M
854"
855{if (size(V) <> ncols(M)) {return(0);}
856  int i;
857  intvec Vt;
858  for (i = 1; i <= nrows(M); i++)
859  {Vt = M[i,1..ncols(M)];
860    if ((V-Vt) == 0){return(i);}
861  }
862  return(0);
863}
864
865static proc isInVec(int v,intvec V)
866"USAGE: isInVec(v,V); v an integer,V an intvec
867RETURN: int
868PURPOSE:Finding the position of v in V, returns 0, if v is not in V
869"
870{int i,n;
871  n = 0;
872  for (i = 1; i <= size(V); i++) {if (V[i] == v) {n = i; break;}}
873  return(n);
874}
875
876
877static proc isPF(intvec P, intvec I)
878"
879PURPOSE:
880checks, if a word P is a praefix of another word I
881"
882{
883  int n = size(P);
884  if (n <= 0 || P == 0) {return(1);}
885  if (size(I) < n) {return(0);}
886  intvec IP = I[1..n];
887  if (IP == P) {return(1);}
888  else {return(0);}
889}
890
891static proc isSF(intvec S, intvec I)
892"
893PURPOSE:
894checks, if a word S is a suffix of another word I
895"
896{
897  int n = size(S);
898  if (n <= 0 || S == 0) {return(1);}
899  int m = size(I);
900  if (m < n) {return(0);}
901  intvec IS = I[(m-n+1)..m];
902  if (IS == S) {return(1);}
903  else {return(0);}
904}
905
906static proc isIF(intvec IF, intvec I)
907"
908PURPOSE:
909checks, if a word IF is an infix of another word I
910"
911{
912  int n = size(IF);
913  int m = size(I);
914
915  if (n <= 0 || IF == 0) {return(1);}
916  if (m < n) {return(0);}
917
918  for (int i = 0; (n + i) <= m; i++){
919    intvec IIF = I[(1 + i)..(n + i)];
920    if (IIF == IF) {
921      return(1);
922    }
923  }
924  return(0);
925}
926
927proc ivL2lpI(list L)
928"USAGE: ivL2lpI(L); L a list of intvecs
929RETURN: ideal
930PURPOSE:Transforming a list of intvecs into an ideal of Letterplace monomials
931ASSUME: - Intvec corresponds to a Letterplace monomial
932@*      - basering has to be a Letterplace ring
933EXAMPLE: example ivL2lpI; shows examples
934"
935{checkAssumptions(0,L);
936  int i; ideal G;
937  poly p;
938  for (i = 1; i <= size(L); i++)
939  {p = iv2lp(L[i]);
940    G[(size(G) + 1)] = p;
941  }
942  return(G);
943}
944example
945{
946  "EXAMPLE:"; echo = 2;
947  ring r = 0,(x,y,z),dp;
948  def R = makeLetterplaceRing(5);// constructs a Letterplace ring
949  setring R; //sets basering to Letterplace ring
950  intvec u = 1,1,2; intvec v = 2,1,3; intvec w = 3,1,1;
951  // u = x^2y, v = yxz, w = zx^2 in intvec representation
952  list L = u,v,w;
953  ivL2lpI(L);// invokes the procedure, returns the ideal containing u,v,w
954}
955
956proc iv2lp(intvec I)
957"USAGE: iv2lp(I); I an intvec
958RETURN: poly
959PURPOSE:Transforming an intvec into the corresponding Letterplace polynomial
960ASSUME: - Intvec corresponds to a Letterplace monomial
961@*      - basering has to be a Letterplace ring
962NOTE:   - Assumptions will not be checked!
963EXAMPLE: example iv2lp; shows examples
964"
965{if (I[1] == 0) {return(1);}
966  int i = size(I);
967  if (i > attrib(basering,"uptodeg")) {ERROR("polynomial exceeds degreebound");}
968  int j; poly p = 1;
969  for (j = 1; j <= i; j++) {if (I[j] > 0) { p = lpMult(p,var(I[j]));}} //ignore zeroes, because they correspond to 1
970  return(p);
971}
972example
973{
974  "EXAMPLE:"; echo = 2;
975  ring r = 0,(x,y,z),dp;
976  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
977  setring R; //sets basering to Letterplace ring
978  intvec u = 1,1,2; intvec v = 2,1,3; intvec w = 3,1,1;
979  // u = x^2y, v = yxz, w = zx^2 in intvec representation
980  iv2lp(u); // invokes the procedure and returns the corresponding poly
981  iv2lp(v);
982  iv2lp(w);
983}
984
985proc iv2lpList(list L)
986"USAGE: iv2lpList(L); L a list of intmats
987RETURN: ideal
988PURPOSE:Converting a list of intmats into an ideal of corresponding monomials
989ASSUME: - The rows of each intmat in L must correspond to a Letterplace monomial
990@*      - basering has to be a Letterplace ring
991EXAMPLE: example iv2lpList; shows examples
992"
993{checkAssumptions(0,L);
994  ideal G;
995  int i;
996  for (i = 1; i <= size(L); i++){G = G + iv2lpMat(L[i]);}
997  return(G);
998}
999example
1000{
1001  "EXAMPLE:"; echo = 2;
1002  ring r = 0,(x,y,z),dp;
1003  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
1004  setring R; // sets basering to Letterplace ring
1005  intmat u[3][1] = 1,1,2; intmat v[1][3] = 2,1,3; intmat w[2][3] = 3,1,1,2,3,1;
1006  // defines intmats of different size containing intvec representations of
1007  // monomials as rows
1008  list L = u,v,w;
1009  print(u); print(v); print(w); // shows the intmats contained in L
1010  iv2lpList(L); // returns the corresponding monomials as an ideal
1011}
1012
1013
1014proc iv2lpMat(intmat M)
1015"USAGE: iv2lpMat(M); M an intmat
1016RETURN: ideal
1017PURPOSE:Converting an intmat into an ideal of the corresponding monomials
1018ASSUME: - The rows of M must correspond to Letterplace monomials
1019@*      - basering has to be a Letterplace ring
1020EXAMPLE: example iv2lpMat; shows examples
1021"
1022{list L = M;
1023  checkAssumptions(0,L);
1024  kill L;
1025  ideal G; poly p;
1026  int i; intvec I;
1027  for (i = 1; i <= nrows(M); i++)
1028  { I = M[i,1..ncols(M)];
1029    p = iv2lp(I);
1030    G[size(G)+1] = p;
1031  }
1032  return(G);
1033}
1034example
1035{
1036  "EXAMPLE:"; echo = 2;
1037  ring r = 0,(x,y,z),dp;
1038  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
1039  setring R; // sets basering to Letterplace ring
1040  intmat u[3][1] = 1,1,2; intmat v[1][3] = 2,1,3; intmat w[2][3] = 3,1,1,2,3,1;
1041  // defines intmats of different size containing intvec representations of
1042  // monomials as rows
1043  iv2lpMat(u); // returns the monomials contained in u
1044  iv2lpMat(v); // returns the monomials contained in v
1045  iv2lpMat(w); // returns the monomials contained in w
1046}
1047
1048proc lpId2ivLi(ideal G)
1049"USAGE: lpId2ivLi(G); G an ideal
1050RETURN: list
1051PURPOSE:Transforming an ideal into the corresponding list of intvecs
1052ASSUME: - basering has to be a Letterplace ring
1053EXAMPLE: example lpId2ivLi; shows examples
1054"
1055{
1056  int i,j,k;
1057  list M;
1058  checkAssumptions(0,M);
1059  for (i = 1; i <= size(G); i++) {M[i] = lp2iv(G[i]);}
1060  return(M);
1061}
1062example
1063{
1064  "EXAMPLE:"; echo = 2;
1065  ring r = 0,(x,y),dp;
1066  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
1067  setring R; // sets basering to Letterplace ring
1068  ideal L = x(1)*x(2),y(1)*y(2),x(1)*y(2)*x(3);
1069  lpId2ivLi(L); // returns the corresponding intvecs as a list
1070}
1071
1072proc lp2iv(poly p)
1073"USAGE: lp2iv(p); p a poly
1074RETURN: intvec
1075PURPOSE:Transforming a monomial into the corresponding intvec
1076ASSUME: - basering has to be a Letterplace ring
1077NOTE:   - Assumptions will not be checked!
1078EXAMPLE: example lp2iv; shows examples
1079"
1080{p = normalize(lead(p));
1081  intvec I;
1082  int i,j;
1083  if (deg(p) > attrib(basering,"uptodeg")) {ERROR("Monomial exceeds degreebound");}
1084  if (p == 1) {return(I);}
1085  if (p == 0) {ERROR("Monomial is not allowed to equal zero");}
1086  intvec lep = leadexp(p);
1087  for ( i = 1; i <= attrib(basering,"lV"); i++) {if (lep[i] == 1) {I = i; break;}}
1088  for (i = (attrib(basering,"lV")+1); i <= size(lep); i++)
1089  {if (lep[i] == 1)
1090    { j = (i mod attrib(basering,"lV"));
1091      if (j == 0) {I = I,attrib(basering,"lV");}
1092      else {I = I,j;}
1093    }
1094    else { if (lep[i] > 1) {ERROR("monomial has a not allowed multidegree");}}
1095  }
1096  if (I[1] == 0) {ERROR("monomial has a not allowed multidegree");}
1097
1098  return(I);
1099}
1100example
1101{
1102  "EXAMPLE:"; echo = 2;
1103  ring r = 0,(x,y,z),dp;
1104  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
1105  setring R; // sets basering to Letterplace ring
1106  poly p = x(1)*x(2)*z(3); poly q = y(1)*y(2)*x(3)*x(4);
1107  poly w= z(1)*y(2)*x(3)*z(4)*z(5);
1108  // p,q,w are some polynomials we want to transform into their
1109  // intvec representation
1110  lp2iv(p); lp2iv(q); lp2iv(w);
1111}
1112
1113proc lp2ivId(ideal G)
1114"USAGE: lp2ivId(G); G an ideal
1115RETURN: list
1116PURPOSE:Converting an ideal into an list of intmats,
1117@*      the corresponding intvecs forming the rows
1118ASSUME: - basering has to be a Letterplace ring
1119EXAMPLE: example lp2ivId; shows examples
1120"
1121{G = normalize(lead(G));
1122  intvec I; list L;
1123  checkAssumptions(0,L);
1124  int i,md;
1125  for (i = 1; i <= size(G); i++) { if (md <= deg(G[i])) {md = deg(G[i]);}}
1126  while (size(G) > 0)
1127  {ideal Gt;
1128    for (i = 1; i <= ncols(G); i++) {if (md == deg(G[i])) {Gt = Gt + G[i]; G[i] = 0;}}
1129    if (size(Gt) > 0)
1130    {G = simplify(G,2);
1131      intmat M [size(Gt)][md];
1132      for (i = 1; i <= size(Gt); i++) {M[i,1..md] = lp2iv(Gt[i]);}
1133      L = insert(L,M);
1134      kill M; kill Gt;
1135      md = md - 1;
1136    }
1137    else {kill Gt; md = md - 1;}
1138  }
1139  return(L);
1140}
1141example
1142{
1143  "EXAMPLE:"; echo = 2;
1144  ring r = 0,(x,y,z),dp;
1145  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
1146  setring R; // sets basering to Letterplace ring
1147  poly p = x(1)*x(2)*z(3); poly q = y(1)*y(2)*x(3)*x(4);
1148  poly w = z(1)*y(2)*x(3)*z(4);
1149  // p,q,w are some polynomials we want to transform into their
1150  // intvec representation
1151  ideal G = p,q,w;
1152  // define the ideal containing p,q and w
1153  lp2ivId(G); // and return the list of intmats for this ideal
1154}
1155
1156// -----------------main procedures----------------------
1157
1158proc lpNoetherian(ideal G) {
1159  // return 0 not noetherian
1160  // return 1 left
1161  // return 2 right
1162  // return 3 both
1163
1164  G = lead(G);
1165  G = simplify(G, 2+4+8);
1166
1167  // check special case 1
1168  int l = 0;
1169  for (int i = 1; i <= size(G); i++) {
1170    // find the max degree in G
1171    int d = deg(G[i]);
1172    if (d > l) {
1173      l = d;
1174    }
1175
1176    // also if G is the whole ring return noetherian
1177    if (leadmonom(G[i]) == 1) {
1178      return(3);
1179    }
1180  }
1181  // if longest word has length 1 we handle it as a special case
1182  if (l == 1) {
1183    int n = attrib(basering, "lV"); // variable count
1184    int k = size(G);
1185    if (k == n) { // only the field left
1186      return(3); // every field is noetherian
1187    }
1188    if (k == n-1) { // V = {1} with loop
1189      return(3);
1190    }
1191    if (k <= n-2) { // V = {1} with more than one loop
1192      return(0);
1193    }
1194  }
1195
1196  intmat UG = lpUfGraph(G);
1197
1198  // check special case 2
1199  intmat zero[nrows(UG)][ncols(UG)];
1200  if (UG == zero) {
1201    return (3);
1202  }
1203
1204  if (!imHasLoops(UG) && imIsUpRightTriangle(topologicalSort(UG))) {
1205    // UG is a DAG
1206    return (3);
1207  }
1208
1209  // DFS from every vertex, if cycle is found, check every vertex for incomming/outcom
1210  intvec visited;
1211  visited[ncols(UG)] = 0;
1212  int inFlag, outFlag;
1213  for (int v = 1; v <= ncols(UG) && (inFlag + outFlag) != 3; v++) {
1214    int inOutFlags = inOrOutCommingEdgeInCycle(UG, v, visited, 0);
1215    if (inOutFlags == 1) {
1216      inFlag = 1;
1217    }
1218    if (inOutFlags == 2) {
1219      outFlag = 2;
1220    }
1221    if (inOutFlags == 3) {
1222      inFlag = 1;
1223      outFlag = 2;
1224    }
1225  }
1226  return (3 - inFlag - outFlag);
1227}
1228
1229proc inOrOutCommingEdgeInCycle(intmat G, int v, intvec visited, intvec path) {
1230  // Mark the current vertex as visited
1231  visited[v] = 1;
1232
1233  // Store the current vertex in path
1234  if (path[1] == 0) {
1235    path[1] = v;
1236  } else {
1237    path[size(path) + 1] = v;
1238  }
1239
1240  int inFlag, outFlag;
1241
1242  for (int w = 1; w <= ncols(G) && (inFlag + outFlag) != 3; w++) {
1243    if (G[v,w] == 1) {
1244      if (visited[w] == 1) {
1245        // new cycle
1246        if (v == w) {
1247          for (int u = 1; u <= ncols(G); u++) {
1248            if (G[v,u] && u != v) {
1249              outFlag = 2;
1250            }
1251            if (G[u,v] && u != v) {
1252              inFlag = 1;
1253            }
1254          }
1255        } else {
1256          for (int i = size(path); i >= 1; i--) { // for each vertex in the path
1257            // check for neighbors not directly next or prev in cycle
1258            for (int u = 1; u <= ncols(G); u++) {
1259              if (G[path[i],u] == 1) { // there is an edge to u
1260                if (path[i] != v) {
1261                  if (u != path[i+1]) { // and u is not the next element in the cycle
1262                    outFlag = 2;
1263                  }
1264                } else {
1265                  if (u != w) {
1266                    outFlag = 2;
1267                  }
1268                }
1269              }
1270              if (G[u,path[i]] == 1) { // there is an edge from u
1271                if (path[i] != w) {
1272                  if (u != path[i-1]) { // and u is not the previous element in the cylce
1273                    inFlag = 1;
1274                  }
1275                } else {
1276                  if (u != v) {
1277                    inFlag = 1;
1278                  }
1279                }
1280              }
1281            }
1282            if (path[i] == w) {
1283              break;
1284            }
1285          }
1286        }
1287      } else {
1288        int inOutFlags = inOrOutCommingEdgeInCycle(G, w, visited, path);
1289        if (inOutFlags == 1) {
1290          inFlag = 1;
1291        }
1292        if (inOutFlags == 2) {
1293          outFlag = 2;
1294        }
1295        if (inOutFlags == 3) {
1296          inFlag = 1;
1297          outFlag = 2;
1298        }
1299      }
1300    }
1301  }
1302
1303  return (inFlag + outFlag);
1304}
1305
1306proc lpIsSemiPrime(ideal G)
1307{
1308  G = lead(G);
1309  G = simplify(G, 2+4+8);
1310
1311  list VUG = lpUfGraph(G, 1);
1312  intmat UG = VUG[1]; // the Ufnarovskij graph
1313  ideal V = VUG[2]; // the vertices of UG (standard words with length = l-1)
1314
1315  list LG = lpId2ivLi(G);
1316  list SW = ivStandardWordsUpToLength(LG, maxDeg(G));
1317  list LV = lpId2ivLi(V);
1318
1319  // delete the 0 in SW
1320  int indexofzero = ivIndexOf(SW, 0);
1321  if (indexofzero > 0) { // should be always true when |SW| > 0
1322    SW = delete(SW, indexofzero);
1323  }
1324
1325  // check if each monomial in SW is cyclic
1326  for (int i = 1; i <= size(SW); i++) {
1327    if (!isCyclicInUfGraph(UG, LV, SW[i])) {
1328      return (0);
1329    }
1330  }
1331
1332  return (1);
1333}
1334
1335// checks whether a monomial is a cyclic monomial
1336proc isCyclicInUfGraph(intmat UG, list LV, intvec u)
1337{
1338  if (ncols(UG) == 0) {return (0);} // UG is empty
1339  if (u == 0) {return (0);} // 0 is never cyclic
1340
1341  int l = size(LV[1]) + 1;
1342
1343  int s = size(u);
1344  if (s <= l - 1) {
1345    for (int i = 1; i <= size(LV); i++) {
1346      // for all vertices where u is a suffix
1347      if(isSF(u, LV[i])) {
1348        if (existsRoute(UG, i, i)) {
1349          return (1);
1350        }
1351      }
1352    }
1353  } else { // size(u) > l - 1
1354    int m = s - l + 1;
1355
1356    // there must be a route from v0 to vm
1357    intvec v0 = u[1..(l-1)]; // first in route of u
1358    intvec vm = u[m+1..m+(l-1)]; // last in route of u
1359
1360    int iv0 = ivIndexOf(LV, v0);
1361    int ivm = ivIndexOf(LV, vm);
1362    if (iv0 <= 0 || ivm <= 0) {
1363      ERROR("u is not a standard word");
1364    }
1365
1366    return (existsRoute(UG, ivm, iv0));
1367  }
1368
1369  return (0);
1370}
1371
1372proc lpIsPrime(ideal G)
1373"USAGE: lpIsPrime(G); G an ideal in a Letterplace ring
1374RETURN: boolean
1375PURPOSE: Check whether R/<G> is prime, where R is the basering
1376ASSUME: - basering is a Letterplace ring
1377@*      - G is a Groebner basis
1378"
1379{
1380  G = lead(G);
1381  G = simplify(G, 2+4+8);
1382
1383  list VUG = lpUfGraph(G, 1);
1384  intmat UG = VUG[1]; // the Ufnarovskij graph
1385  ideal V = VUG[2]; // the vertices of UG (standard words with length = l-1)
1386
1387  list LG = lpId2ivLi(G);
1388  list LV = lpId2ivLi(V);
1389
1390  int n = ncols(UG);
1391
1392  // 1) for each vi vj there exists a route from vi to vj (means UG is connected)
1393  for (int i = 1; i <= n; i++) {
1394    for (int j = 1; j <= n; j++) {
1395      if (!existsRoute(UG, i, j)) {
1396        return (0);
1397      }
1398    }
1399  }
1400
1401  // 2) any standard word with length < l-1 is a suffix of a vertex
1402  list SW = ivStandardWordsUpToLength(LG, maxDeg(G) - 2); // < maxDeg - 1
1403  if (size(SW) > 0 && size(LV) == 0) {return (0);}
1404  for (int i = 1; i <= size(SW); i++) {
1405    // check if SW[i] is a suffix of some LV
1406    for (int j = 1; j <= size(LV); j++) {
1407      if (!isSF(SW[i], LV[j])) {
1408        if (j == size(LV)) {
1409          return (0);
1410        }
1411      } else {
1412        break;
1413      }
1414    }
1415  }
1416
1417  return (1);
1418}
1419example {
1420  "EXAMPLE:"; echo = 2;
1421  ring r = 0,(x,y),dp;
1422  def R = makeLetterplaceRing(5);
1423  setring R;
1424  ideal G = x(1)*x(2), y(1)*y(2); // K<x,y>/<xx,yy> is prime
1425  lpIsPrime(G);
1426}
1427
1428static proc existsRoute(intmat G, int v, int u, list #)
1429"USAGE: existsRoute(G,v,u); G a graph, v and u vertices
1430NOTE: don't pass anything to # (internal use for recursion)
1431@*    routes always have at least one edge
1432"
1433{
1434  int n = ncols(G);
1435
1436  // init visited
1437  intvec visited;
1438  if (size(#) > 0) {
1439    if (v == u) {return (1);} // don't check on first call so |route| >= 1 holds
1440    visited = #[1];
1441  } else { // first call
1442    visited[n] = 0;
1443  }
1444
1445  // mark current vertex as visited
1446  visited[v] = 1;
1447
1448  // recursive DFS
1449  for (int i = 1; i <= n; i++) {
1450    if (G[v,i] && (!visited[i] || i == u)) { // i == u to allow routes from u to u
1451      if (existsRoute(G, i, u, visited)) {
1452        return (1);
1453      }
1454    }
1455  }
1456
1457  return (0);
1458}
1459
1460static proc lpUfGkDim(ideal G)
1461{
1462  G = lead(G);
1463  G = simplify(G, 2+4+8);
1464
1465  // check special case 1
1466  int l = 0;
1467  for (int i = 1; i <= size(G); i++) {
1468    // find the max degree in G
1469    int d = deg(G[i]);
1470    if (d > l) {
1471      l = d;
1472    }
1473
1474    // also if G is the whole ring return minus infinity
1475    if (leadmonom(G[i]) == 1) {
1476      return(-2); // minus infinity
1477    }
1478  }
1479  // if longest word has length 1 we handle it as a special case
1480  if (l == 1) {
1481    int n = attrib(basering, "lV"); // variable count
1482    int k = size(G);
1483    if (k == n) { // V = {1} no edges
1484      return(0);
1485    }
1486    if (k == n-1) { // V = {1} with loop
1487      return(1);
1488    }
1489    if (k <= n-2) { // V = {1} with more than one loop
1490      return(-1);
1491    }
1492  }
1493
1494  int t = rtimer; // DEBUG
1495  intmat UG = lpUfGraph(G);
1496  printf("lpUfGraph took %p", rtimer - t); // DEBUG
1497
1498  // check special case 2
1499  intmat zero[nrows(UG)][ncols(UG)];
1500  if (UG == zero) {
1501    return (0);
1502  }
1503
1504  // check special case 3
1505  UG = topologicalSort(UG);
1506
1507  if (imIsUpRightTriangle(UG)) {
1508    UG = eliminateZerosUpTriangle(UG);
1509    if (ncols(UG) == 0 || nrows(UG) == 0) { // when the diagonal was zero
1510      return (0)
1511    }
1512    return(UfGraphURTNZDGrowth(UG));
1513  }
1514
1515  // otherwise count cycles in the Ufnarovskij Graph
1516  int t = rtimer; // DEBUG
1517  int gkdim = UfGraphGrowth(UG);
1518  printf("UfGraphGrowth took %p", rtimer - t); // DEBUG
1519  return(gkdim);
1520}
1521
1522static proc UfGraphURTNZDGrowth(intmat UG) {
1523  // URTNZD = upper right triangle non zero diagonal
1524  for (int i = 1; i <= ncols(UG); i++) {
1525    UG[i,i] = 0; // remove all loops
1526  }
1527  intmat UGk = UG;
1528  intmat zero[nrows(UGk)][ncols(UGk)];
1529  int k = 1;
1530  while (UGk != zero) {
1531    UGk = UGk * UG;
1532    k++;
1533  }
1534  return (k);
1535}
1536
1537proc imIsUpRightTriangle(intmat M) {
1538  for (int i = 1; i <= nrows(M); i++) {
1539    for (int j = 1; j < i; j++) {
1540      if(M[i,j] != 0) { return (0); }
1541    }
1542  }
1543  return (1);
1544}
1545
1546static proc eliminateZerosUpTriangle(intmat G) {
1547  // G is expected to be an upper triangle matrix
1548  for (int i = ncols(G); i >= 1; i--) { // loop order is important because we delete entries
1549    if (G[i,i] == 0) { // i doesn't have a cycle
1550      for (int j = 1; j < i; j++) {
1551        if (G[j,i] == 1) { // j has an edge to i
1552          for (int k = i + 1; k <= nrows(G); k++) {
1553            if (G[i,k] == 1) {
1554              G[j,k] = G[i,k]; // give j all edges from i
1555            }
1556          }
1557        }
1558      }
1559      G = imDelRowCol(G,i,i); // remove vertex i
1560    }
1561  }
1562  return (G);
1563}
1564
1565static proc imDelRowCol(intmat M, int row, int col) {
1566  // row and col are expected to be > 0
1567  int nr = nrows(M);
1568  int nc = ncols(M);
1569  intmat Mdel[nr - 1][nc - 1];
1570  for (int i = 1; i <= nr; i++) {
1571    for (int j = 1; j <= nc; j++) {
1572      if(i != row && j != col) {
1573        int newi = i;
1574        int newj = j;
1575        if (i > row) { newi = i - 1; }
1576        if (j > col) { newj = j - 1; }
1577        Mdel[newi,newj] = M[i,j];
1578      }
1579    }
1580  }
1581  return (Mdel);
1582}
1583
1584static proc topologicalSort(intmat G) {
1585  // NOTE: ignores loops
1586  // NOTE: this takes O(|V^3|), can be optimized
1587  int n = ncols(G);
1588  for (int i = 1; i <= n; i++) { // only use the submat at i
1589    // find a vertex v in the submat at i with no incoming edges
1590    int v;
1591    for (int j = i; j <= n; j++) {
1592      int incoming = 0;
1593      for (int k = i; k <= n; k++) {
1594        if (k != j && G[k,j] == 1) {
1595          incoming = 1;
1596        }
1597      }
1598      if (incoming == 0) {
1599        v = j;
1600        break;
1601      } else {
1602        if (j == n) {
1603          // G contains at least one cycle, abort
1604          return (G);
1605        }
1606      }
1607    }
1608
1609    // swap v and i
1610    if (v != i) {
1611      G = imPermcol(G, v, i);
1612      G = imPermrow(G, v, i);
1613    }
1614  }
1615  return (G);
1616}
1617
1618static proc imPermcol (intmat A, int c1, int c2)
1619{
1620  intmat B = A;
1621  int k = nrows(B);
1622  B[1..k,c1] = A[1..k,c2];
1623  B[1..k,c2] = A[1..k,c1];
1624  return (B);
1625}
1626
1627static proc imPermrow (intmat A, int r1, int r2)
1628{
1629  intmat B = A;
1630  int k = ncols(B);
1631  B[r1,1..k] = A[r2,1..k];
1632  B[r2,1..k] = A[r1,1..k];
1633  return (B);
1634}
1635
1636static proc UfGraphGrowth(intmat UG)
1637{
1638  int n = ncols(UG); // number of vertices
1639  // iterate through all vertices
1640
1641  intvec visited;
1642  visited[n] = 0;
1643
1644  intvec cyclic;
1645  cyclic[n] = 0;
1646
1647  int maxCycleCount = 0;
1648  for (int v = 1; v <= n; v++) {
1649    int cycleCount = countCycles(UG, v, visited, cyclic, 0);
1650    if (cycleCount == -1) {
1651      return(-1);
1652    }
1653    if (cycleCount > maxCycleCount) {
1654      maxCycleCount = cycleCount;
1655    }
1656  }
1657  return(maxCycleCount);
1658}
1659
1660static proc countCycles(intmat G, int v, intvec visited, intvec cyclic, intvec path)
1661"USAGE: countCycles(G, v, visited, cyclic, path); G a Graph, v the vertex to
1662start. The parameter visited, cyclic and path should be 0.
1663RETURN: int
1664@*:     Maximal number of distinct cycles
1665PURPOSE: Calculate the maximal number of distinct cycles in a single path starting at v
1666ASSUME: Basering is a Letterplace ring
1667"
1668{
1669  // Mark the current vertex as visited
1670  visited[v] = 1;
1671
1672  // Store the current vertex in path
1673  if (path[1] == 0) {
1674    path[1] = v;
1675  } else {
1676    path[size(path) + 1] = v;
1677  }
1678
1679  int cycles = 0;
1680  for (int w = 1; w <= ncols(G); w++) {
1681    if (G[v,w] == 1) {
1682      if (visited[w] == 1) { // neuer zykel gefunden
1683        // 1. alle Knoten in path bis w ÃŒberprÃŒfen ob in cyclic
1684        for (int j = size(path); j >= 1; j--) {
1685          if(cyclic[path[j]] == 1) {
1686            // 1.1 falls ja return -1
1687            return (-1);
1688          }
1689          if (path[j] == w) {
1690            break;
1691          }
1692        }
1693
1694        // 2. ansonsten cycles++
1695        for (int j = size(path); j >= 1; j--) {
1696          // 2.2 Kanten in diesem Zykel entfernen; Knoten cyclic
1697          if (j == size(path)) { // Sonderfall bei der ersten Iteration
1698            cyclic[v] = 1;
1699            G[v, w] = 0;
1700          } else {
1701            cyclic[path[j]] = 1;
1702            G[path[j], path[j+1]] = 0;
1703          }
1704          if (path[j] == w) {
1705            break;
1706          }
1707        }
1708
1709        // 3. auf jedem dieser Knoten countCycles() aufrufen
1710        int maxCycleCount = 0;
1711        for (int j = size(path); j >= 1; j--) {
1712          int cycleCount = countCycles(G, path[j], visited, cyclic, path);
1713          if(cycleCount == -1) {
1714            return (-1);
1715          }
1716          if (cycleCount > maxCycleCount) {
1717            maxCycleCount = cycleCount;
1718          }
1719          if (path[j] == w) {
1720            break;
1721          }
1722        }
1723        if (maxCycleCount >= cycles) {
1724          cycles = maxCycleCount + 1;
1725        }
1726      } else {
1727        int cycleCount = countCycles(G, w, visited, cyclic, path);
1728        if (cycleCount == -1) {
1729          return(-1);
1730        }
1731        if (cycleCount > cycles) {
1732          cycles = cycleCount;
1733        }
1734      }
1735    }
1736  }
1737  // printf("Path: %s countCycles: %s", path, cycles); // DEBUG
1738  return(cycles);
1739}
1740
1741static proc lpUfGraph(ideal G, list #)
1742"USAGE: lpUfGraph(G); G a set of monomials in a letterplace ring, # an optional parameter to return the vertex list when set
1743RETURN: intmat
1744PURPOSE: Constructs the Ufnarovskij graph induced by G
1745@*      the adjacency matrix of the Ufnarovskij graph induced by G
1746ASSUME: - basering is a Letterplace ring
1747@*      - G are the leading monomials of a Groebner basis
1748"
1749{
1750  int l = maxDeg(G);
1751  list LG = lpId2ivLi(G);
1752  list SW = ivStandardWords(LG, l - 1); // vertices
1753  int n = size(SW);
1754  intmat UG[n][n]; // Ufnarovskij graph
1755  for (int i = 1; i <= n; i++) {
1756    for (int j = 1; j <= n; j++) {
1757      // [Studzinski page 76]
1758      intvec v = SW[i];
1759      intvec w = SW[j];
1760      intvec v_overlap;
1761      intvec w_overlap;
1762      //TODO how should the graph look like when l - 1 = 0 ?
1763      if (l - 1 == 0) {
1764        ERROR("Ufnarovskij graph not implemented for l = 1");
1765      }
1766      if (l - 1 > 1) {
1767        v_overlap = v[2 .. l-1];
1768        w_overlap = w[1 .. l-2];
1769      }
1770      intvec vw = v;
1771      vw[l] = w[l-1];
1772      if (v_overlap == w_overlap && !ivdivides(LG, vw)) {
1773        UG[i,j] = 1;
1774      }
1775    }
1776  }
1777  if (size(#) > 0) {
1778    if (typeof(#[1]) == "int") {
1779      if (#[1] == 1) {
1780        list ret = UG;
1781        ret[2] = ivL2lpI(SW); // the vertices
1782        return (ret);
1783      }
1784    }
1785  }
1786  return (UG);
1787}
1788
1789static proc maxDeg(ideal G)
1790{
1791  int l = 0;
1792  for (int i = 1; i <= size(G); i++) { // find the max degree in G
1793    int d = deg(G[i]);
1794    if (d > l) {
1795      l = d;
1796    }
1797  }
1798  return (l);
1799}
1800
1801static proc ivStandardWords(list G, int length)
1802"ASSUME: G is simplified
1803"
1804{
1805  if (length <= 0) {
1806    list words;
1807    if (length == 0 && !ivdivides(G,0)) {
1808      words[1] = 0; // iv = 0 means monom = 1
1809    }
1810    return (words); // no standard words
1811  }
1812  int lV = attrib(basering, "lV"); // variable count
1813  list prevWords = ivStandardWords(G, length - 1);
1814  list words;
1815  for (int i = 1; i <= lV; i++) {
1816    for (int j = 1; j <= size(prevWords); j++) {
1817      intvec word = prevWords[j];
1818      word[length] = i;
1819      // assumes that G is simplified!
1820      if (!ivdivides(G, word)) {
1821        words = insert(words, word);
1822      }
1823    }
1824  }
1825  return (words);
1826}
1827
1828static proc ivStandardWordsUpToLength(list G, int length)
1829"ASSUME: G is simplified
1830"
1831{
1832  list words = ivStandardWords(G,0);
1833  if (size(words) == 0) {return (words)}
1834  for (int i = 1; i <= length; i++) {
1835    words = words + ivStandardWords(G, i);
1836  }
1837  return (words);
1838}
1839
1840static proc ivdivides(list G, intvec iv) {
1841  for (int k = 1; k <= size(G); k++) {
1842    if (isIF(G[k], iv)) {
1843      return (1);
1844    } else {
1845      if (k == size(G)) {
1846        return (0);
1847      }
1848    }
1849  }
1850}
1851
1852static proc lpGraphOfNormalWords(ideal G)
1853"USAGE: lpGraphOfNormalWords(G); G a set of monomials in a letterplace ring
1854RETURN: intmat
1855PURPOSE: Constructs the graph of normal words induced by G
1856@*:      the adjacency matrix of the graph of normal words induced by G
1857ASSUME: - basering is a Letterplace ring
1858- G are the leading monomials of a Groebner basis
1859"
1860{
1861  // construct the Graph of normal words [Studzinski page 78]
1862  // construct set of vertices
1863  int v = attrib(basering,"lV"); int d = attrib(basering,"uptodeg");
1864  ideal V; poly p,q,w;
1865  ideal LG = lead(G);
1866  int i,j,k,b; intvec E,Et;
1867  for (i = 1; i <= v; i++){V = V, var(i);}
1868  for (i = 1; i <= size(LG); i++)
1869  {
1870    E = leadexp(LG[i]);
1871    if (E == intvec(0)) {V = V,monomial(intvec(0));}
1872    else
1873    {
1874      for (j = 1; j < d; j++)
1875      {
1876        Et = E[(j*v+1)..(d*v)];
1877        if (Et == intvec(0)) {break;}
1878        else {V = V, monomial(Et);}
1879      }
1880    }
1881  }
1882  V = simplify(V,2+4);
1883  printf("V = %p", V);
1884
1885
1886  // construct incidence matrix
1887
1888  list LV = lpId2ivLi(V);
1889  intvec Ip,Iw;
1890  int n = size(V);
1891  intmat T[n+1][n];
1892  for (i = 1; i <= n; i++)
1893  {
1894    // printf("for1 (i=%p, n=%p)", i, n);
1895    p = V[i]; Ip = lp2iv(p);
1896    for (j = 1; j <= n; j++)
1897    {
1898      // printf("for2 (j=%p, n=%p)", j, n);
1899      k = 1; b = 1;
1900      q = V[j];
1901      w = lpNF(lpMult(p,q),LG);
1902      if (w <> 0)
1903      {
1904        Iw = lp2iv(w);
1905        while (k <= n)
1906        {
1907          // printf("while (k=%p, n=%p)", k, n);
1908          if (isPF(LV[k],Iw) > 0)
1909          {if (isPF(LV[k],Ip) == 0) {b = 0; k = n+1;} else {k++;}
1910          }
1911          else {k++;}
1912        }
1913        T[i,j] = b;
1914        //  print("Incidence Matrix:");
1915        // print(T);
1916      }
1917    }
1918  }
1919  return(T);
1920}
1921
1922static proc lpNorGkDim(ideal G)
1923"USAGE: lpNorGkDim(G); G an ideal in a letterplace ring
1924RETURN: int
1925PURPOSE: Determines the Gelfand Kirillov dimension of A/<G>
1926@*:     -1 means it is infinite
1927ASSUME: - basering is a Letterplace ring
1928- G is a Groebner basis
1929"
1930{
1931  return(growthAlg(lpGraphOfNormalWords(G)));
1932}
1933
1934proc lpGkDim(ideal G, list#)
1935"USAGE: lpGkDim(G); G an ideal in a letterplace ring, method an
1936@*       optional integer. method = 0 uses the Ufnarovskij Graph
1937@*       and method = 1 uses the Graph of normal words to determine
1938@*       the Gelfand Kirillov dimension
1939RETURN: int
1940PURPOSE: Determines the Gelfand Kirillov dimension of A/<G>
1941@*      -1 means it is positive infinite
1942@*      -2 means it is negative infinite
1943ASSUME: - basering is a Letterplace ring
1944- G is a Groebner basis
1945"
1946{
1947  int method = 0;
1948  if (size(#) > 0) {
1949    if (typeof(#[1])=="int") {
1950      method = #[1];
1951    }
1952  }
1953
1954  if (method == 0) {
1955    return (lpUfGkDim(G));
1956  } else {
1957    return (lpNorGkDim(G));
1958  }
1959}
1960example
1961{
1962  "EXAMPLE:"; echo = 2;
1963  ring r = 0,(x,y,z),dp;
1964  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
1965  R;
1966  setring R; // sets basering to Letterplace ring
1967  ideal I = z(1);//an example of infinite GK dimension
1968  lpGkDim(I);
1969  I = x(1),y(1),z(1); // gkDim = 0
1970  lpGkDim(I);
1971  I = x(1)*y(2), x(1)*z(2), z(1)*y(2), z(1)*z(2);//gkDim = 2
1972  lpGkDim(I);
1973}
1974
1975proc lpGlDimBound(ideal G)
1976"USAGE: lpGlDimBound(I); I an ideal
1977RETURN: int, an upper bound for the global dimension, -1 means infinity
1978PURPOSE: computing an upper bound for the global dimension
1979ASSUME: - basering is a Letterplace ring, G is a reduced Gröbner Basis
1980EXAMPLE: example lpGlDimBound; shows example
1981NOTE: if I = LM(I), then the global dimension is equal the Gelfand
1982@*    Kirillov dimension if it is finite
1983@*    Global dimension should be 0 for A/G = K and 1 for A/G = K<x1...xn>
1984"
1985{
1986  G = simplify(G,2); // remove zero generators
1987  // NOTE: Gl should be 0 for A/G = K and 1 for A/G = K<x1...xn>
1988  // G1 contains generators with single variable in LM
1989  ideal G1;
1990  for (int i = 1; i <= size(G); i++) {
1991    if (ord(G[i]) < 2) { // single variable in LM
1992      G1 = insertGenerator(G1,G[i]);
1993    }
1994  }
1995  G1 = simplify(G1,2); // remove zero generators
1996
1997  // G = NF(G,G1)
1998  for (int i = 1; i <= ncols(G); i++) { // do not use size() here
1999    G[i] = lpNF(G[i],G1);
2000  }
2001  G = simplify(G,2); // remove zero generators
2002
2003  // delete variables in LM(G1) from the ring
2004  def save = basering;
2005  ring R = basering;
2006  if (size(G1) > 0) {
2007    while (size(G1) > 0) {
2008      if (attrib(R, "lV") > 1) {
2009        ring R = lpDelVar(lp2iv(G1[1])[1]);
2010        ideal G1 = imap(save,G1);
2011        G1 = simplify(G1, 2); // remove zero generators
2012      } else {
2013        // only the field is left (no variables)
2014        return(0);
2015      }
2016    }
2017    ideal G = imap(save, G); // put this here, because when save == R this call would make G = 0
2018  }
2019
2020  // Li p. 184 if G = LM(G), then I = LM(I) and thus glDim = gkDim if it's finite
2021  for (int i = 1; i <= size(G); i++) {
2022    if (G[i] != lead(G[i])) {
2023      break;
2024    } else {
2025      if (i == size(G)) { // if last iteration
2026        print("Using gk dim"); // DEBUG
2027        int gkDim = lpGkDim(G);
2028        if (gkDim >= 0) {
2029          return (gkDim);
2030        }
2031      }
2032    }
2033  }
2034
2035  intmat GNC = lpGraphOfNChains(G);
2036
2037  // assuming GNC is connected
2038
2039  // TODO: maybe loop+cycle checking could be done more efficiently?
2040  if (!imHasLoops(GNC) && imIsUpRightTriangle(topologicalSort(GNC))) {
2041    // GNC is a DAG
2042    intmat GNCk = GNC;
2043    intmat zero[1][ncols(GNCk)];
2044    int k = 1;
2045    // while first row isn't empty
2046    while (GNCk[1,1..(ncols(GNCk))] != zero[1,1..(ncols(zero))]) {
2047      GNCk = GNCk * GNC;
2048      k++;
2049    }
2050    // k-1 = number of edges in longest path starting from 1
2051    return (k-1);
2052  } else {
2053    // GNC contains loops/cycles => there is always an n-chain
2054    return (-1); // infinity
2055  }
2056}
2057example
2058{
2059  "EXAMPLE:"; echo = 2;
2060  ring r = 0,(x,y),dp;
2061  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2062  setring R; // sets basering to Letterplace ring
2063  ideal G = x(1)*x(2), y(1)*y(2),x(1)*y(2)*x(3); // ideal G contains a
2064  //Groebner basis
2065  lpGlDimBound(G); // invokes procedure with Groebner basis G
2066}
2067
2068static proc imHasLoops(intmat A) {
2069  int n = ncols(A);
2070  for (int i = 1; i < n; i++) {
2071    if (A[i,i] == 1) {
2072      return (1);
2073    }
2074  }
2075  return (0);
2076}
2077
2078static proc lpGraphOfNChains(ideal G) // G must be reduced
2079{
2080  list LG = lpId2ivLi(lead(G));
2081  int n = attrib(basering, "lV");
2082  int degbound = attrib(basering, "uptodeg");
2083
2084  list V;
2085  for (int i = 0; i <= n; i++) {
2086    V[i+1] = i; // add 1 and all variables
2087  }
2088  for (int i = 1; i <= size(LG); i++) {
2089    intvec u = LG[i];
2090    for (int j = 2; j <= size(u); j++) {
2091      intvec v = u[j..size(u)];
2092      if (!contains(V, v)) {
2093        V = insert(V, v, size(V)); // add subword j..size
2094      }
2095    }
2096  }
2097  int nV = size(V);
2098  intmat GNC[nV][nV]; // graph of n-chains
2099
2100  // for vertex 1
2101  for (int i = 2; i <= n + 1; i++) {
2102    GNC[1,i] = 1; // 1 has an edge to all variables
2103  }
2104
2105  // for the other vertices
2106  for (int i = 2; i <= nV; i++) {
2107    for (int j = 2; j <= nV; j++) {
2108      intvec uv = V[i],V[j];
2109
2110      if (contains(LG, uv)) {
2111        GNC[i,j] = 1;
2112      } else {
2113        // Li p. 177
2114        // search for a right divisor 'w' of uv in G
2115        // then check if G doesn't divide the subword uv-1
2116
2117        // look for a right divisor in LG
2118        for (int k = 1; k <= size(LG); k++) {
2119          if (isSF(LG[k], uv)) {
2120            // w = LG[k]
2121            if(!ivdivides(LG, uv[1..(size(uv)-1)])) {
2122              // G doesn't divide uv-1
2123              GNC[i,j] = 1;
2124              break;
2125            }
2126          }
2127        }
2128      }
2129    }
2130  }
2131
2132  return(GNC);
2133}
2134
2135static proc contains(list L, def item)
2136{
2137  for (int i = 1; i <= size(L); i++) {
2138    if (L[i] == item) {
2139      return (1);
2140    }
2141  }
2142  return (0);
2143}
2144
2145
2146proc ivDHilbert(list L, int n, list #)
2147"USAGE: ivDHilbert(L,n[,degbound]); L a list of intmats, n an integer,
2148@*      degbound an optional integer
2149RETURN: list
2150PURPOSE:Computing the K-dimension and the Hilbert series
2151ASSUME: - basering is a Letterplace ring
2152@*      - all rows of each intmat correspond to a Letterplace monomial
2153@*      - if you specify a different degree bound degbound,
2154@*        degbound <= attrib(basering,uptodeg) holds
2155NOTE: - If L is the list returned, then L[1] is an integer corresponding to the
2156@*      dimension, L[2] is an intvec which contains the coefficients of the
2157@*      Hilbert series
2158@*    - If degbound is set, there will be a degree bound added. By default there
2159@*      is no degree bound
2160@*    - n is the number of variables
2161@*    - If I = L[2] is the intvec returned, then I[k] is the (k-1)-th coefficient of
2162@*      the Hilbert series.
2163@*    - If the K-dimension is known to be infinite, a degree bound is needed
2164EXAMPLE: example ivDHilbert; shows examples
2165"
2166{int degbound = 0;
2167  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] > 0){degbound = #[1];}}}
2168  checkAssumptions(degbound,L);
2169  intvec H; int i,dimen;
2170  H = ivHilbert(L,n,degbound);
2171  for (i = 1; i <= size(H); i++){dimen = dimen + H[i];}
2172  L = dimen,H;
2173  return(L);
2174}
2175example
2176{
2177  "EXAMPLE:"; echo = 2;
2178  ring r = 0,(x,y),dp;
2179  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2180  R;
2181  setring R; // sets basering to Letterplace ring
2182  //some intmats, which contain monomials in intvec representation as rows
2183  intmat I1 [2][2] = 1,1,2,2; intmat I2 [1][3]  = 1,2,1;
2184  intmat J1 [1][2] =  1,1; intmat J2 [2][3] = 2,1,2,1,2,1;
2185  print(I1);
2186  print(I2);
2187  print(J1);
2188  print(J2);
2189  list G = I1,I2; // ideal, which is already a Groebner basis
2190  list I = J1,J2; // ideal, which is already a Groebner basis
2191  //the procedure without a degree bound
2192  ivDHilbert(G,2);
2193  // the procedure with degree bound 5
2194  ivDHilbert(I,2,5);
2195}
2196
2197proc ivDHilbertSickle(list L, int n, list #)
2198"USAGE: ivDHilbertSickle(L,n[,degbound]); L a list of intmats, n an integer,
2199@*      degbound an optional integer
2200RETURN: list
2201PURPOSE:Computing K-dimension, Hilbert series and mistletoes
2202ASSUME: - basering is a Letterplace ring.
2203@*      - All rows of each intmat correspond to a Letterplace monomial.
2204@*      - If you specify a different degree bound degbound,
2205@*        degbound <= attrib(basering,uptodeg) holds.
2206NOTE: - If L is the list returned, then L[1] is an integer, L[2] is an intvec
2207@*      which contains the coefficients of the Hilbert series and L[3]
2208@*      is a list, containing the mistletoes as intvecs.
2209@*    - If degbound is set, a degree bound will be added. By default there
2210@*      is no degree bound.
2211@*    - n is the number of variables.
2212@*    - If I = L[2] is the intvec returned, then I[k] is the (k-1)-th
2213@*      coefficient of the Hilbert series.
2214@*    - If the K-dimension is known to be infinite, a degree bound is needed
2215EXAMPLE: example ivDHilbertSickle; shows examples
2216"
2217{int degbound = 0;
2218  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] > 0){degbound = #[1];}}}
2219  checkAssumptions(degbound,L);
2220  int i,dimen; list R;
2221  R = ivSickleHil(L,n,degbound);
2222  for (i = 1; i <= size(R[1]); i++){dimen = dimen + R[1][i];}
2223  R[3] = R[2]; R[2] = R[1]; R[1] = dimen;
2224  return(R);
2225}
2226example
2227{
2228  "EXAMPLE:"; echo = 2;
2229  ring r = 0,(x,y),dp;
2230  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2231  R;
2232  setring R; // sets basering to Letterplace ring
2233  //some intmats, which contain monomials in intvec representation as rows
2234  intmat I1 [2][2] = 1,1,2,2; intmat I2 [1][3]  = 1,2,1;
2235  intmat J1 [1][2] =  1,1; intmat J2 [2][3] = 2,1,2,1,2,1;
2236  print(I1);
2237  print(I2);
2238  print(J1);
2239  print(J2);
2240  list G = I1,I2;// ideal, which is already a Groebner basis
2241  list I = J1,J2; // ideal, which is already a Groebner basis
2242  ivDHilbertSickle(G,2); // invokes the procedure without a degree bound
2243  ivDHilbertSickle(I,2,3); // invokes the procedure with degree bound 3
2244}
2245
2246proc ivDimCheck(list L, int n)
2247"USAGE: ivDimCheck(L,n); L a list of intmats, n an integer
2248RETURN: int, 0 if the dimension is finite, or 1 otherwise
2249PURPOSE:Decides, whether the K-dimension is finite or not
2250ASSUME: - basering is a Letterplace ring.
2251@*      - All rows of each intmat correspond to a Letterplace monomial.
2252NOTE:   - n is the number of variables.
2253EXAMPLE: example ivDimCheck; shows examples
2254"
2255{checkAssumptions(0,L);
2256  int i,r;
2257  intvec P,H;
2258  for (i = 1; i <= size(L); i++)
2259  {P[i] = ncols(L[i]);
2260    if (P[i] == 1) {if (isInMat(H,L[i]) > 0) {ERROR("Quotient algebra is trivial");}}
2261  }
2262  if (size(L) == 0) {ERROR("GB is empty, quotient algebra corresponds to free algebra");}
2263  kill H;
2264  intmat S; int sd,ld; intvec V;
2265  sd = P[1]; ld = P[1];
2266  for (i = 2; i <= size(P); i++)
2267  {if (P[i] < sd) {sd = P[i];}
2268    if (P[i] > ld) {ld = P[i];}
2269  }
2270  sd = (sd - 1); ld = ld - 1;
2271  if (ld == 0) { return(allVars(L,P,n));}
2272  if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
2273  else {S = createStartMat(sd,n);}
2274  module M;
2275  for (i = 1; i <= nrows(S); i++)
2276  {V = S[i,1..ncols(S)];
2277    if (findCycle(V,L,P,n,ld,M)) {r = 1; break;}
2278  }
2279  return(r);
2280}
2281example
2282{
2283  "EXAMPLE:"; echo = 2;
2284  ring r = 0,(x,y),dp;
2285  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2286  R;
2287  setring R; // sets basering to Letterplace ring
2288  //some intmats, which contain monomials in intvec representation as rows
2289  intmat I1 [2][2] = 1,1,2,2; intmat I2 [1][3]  = 1,2,1;
2290  intmat J1 [1][2] =  1,1; intmat J2 [2][3] = 2,1,2,1,2,1;
2291  print(I1);
2292  print(I2);
2293  print(J1);
2294  print(J2);
2295  list G = I1,I2;// ideal, which is already a Groebner basis
2296  list I = J1,J2; // ideal, which is already a Groebner basis and which
2297  ivDimCheck(G,2); // invokes the procedure, factor is of finite K-dimension
2298  ivDimCheck(I,2); // invokes the procedure, factor is not of finite K-dimension
2299}
2300
2301proc ivHilbert(list L, int n, list #)
2302"USAGE: ivHilbert(L,n[,degbound]); L a list of intmats, n an integer,
2303@*      degbound an optional integer
2304RETURN: intvec, containing the coefficients of the Hilbert series
2305PURPOSE:Computing the Hilbert series
2306ASSUME: - basering is a Letterplace ring.
2307@*      - all rows of each intmat correspond to a Letterplace monomial
2308@*      - if you specify a different degree bound degbound,
2309@*       degbound <= attrib(basering,uptodeg) holds.
2310NOTE: - If degbound is set, a degree bound  will be added. By default there
2311@*      is no degree bound.
2312@*    - n is the number of variables.
2313@*    - If I is returned, then I[k] is the (k-1)-th coefficient of the Hilbert
2314@*      series.
2315@*    - If the K-dimension is known to be infinite, a degree bound is needed
2316EXAMPLE: example ivHilbert; shows examples
2317"
2318{int degbound = 0;
2319  if (size(#) > 0) {if (typeof(#[1])=="int"){if (#[1] > 0) {degbound = #[1];}}}
2320  intvec P,H; int i;
2321  for (i = 1; i <= size(L); i++)
2322  {P[i] = ncols(L[i]);
2323    if (P[i] == 1) {if ( isInMat(H,L[i]) > 0) {ERROR("Quotient algebra is trivial");}}
2324  }
2325  if (size(L) == 0) {ERROR("GB is empty, quotient algebra corresponds to free algebra");}
2326  H[1] = 1;
2327  checkAssumptions(degbound,L);
2328  if (degbound == 0)
2329  {int sd;
2330    intmat S;
2331    sd = P[1];
2332    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
2333    sd = (sd - 1);
2334    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
2335    else {S = createStartMat(sd,n);}
2336    if (intvec(S) == 0) {return(H);}
2337    for (i = 1; i <= sd; i++) {H = H,(n^i);}
2338    for (i = 1; i <= nrows(S); i++)
2339    {intvec St = S[i,1..ncols(S)];
2340      H = findHCoeff(St,n,L,P,H);
2341      kill St;
2342    }
2343    return(H);
2344  }
2345  else
2346  {for (i = 1; i <= size(P); i++)
2347    {if (P[i] > degbound) {ERROR("degreebound is too small, GB contains elements of higher degree");}}
2348    int sd;
2349    intmat S;
2350    sd = P[1];
2351    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
2352    sd = (sd - 1);
2353    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
2354    else {S = createStartMat(sd,n);}
2355    if (intvec(S) == 0) {return(H);}
2356    for (i = 1; i <= sd; i++) {H = H,(n^i);}
2357    for (i = 1; i <= nrows(S); i++)
2358    {intvec St = S[i,1..ncols(S)];
2359      H = findHCoeff(St,n,L,P,H,degbound);
2360      kill St;
2361    }
2362    return(H);
2363  }
2364}
2365example
2366{
2367  "EXAMPLE:"; echo = 2;
2368  ring r = 0,(x,y),dp;
2369  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2370  R;
2371  setring R; // sets basering to Letterplace ring
2372  //some intmats, which contain monomials in intvec representation as rows
2373  intmat I1 [2][2] = 1,1,2,2; intmat I2 [1][3]  = 1,2,1;
2374  intmat J1 [1][2] =  1,1; intmat J2 [2][3] = 2,1,2,1,2,1;
2375  print(I1);
2376  print(I2);
2377  print(J1);
2378  print(J2);
2379  list G = I1,I2; // ideal, which is already a Groebner basis
2380  list I = J1,J2; // ideal, which is already a Groebner basis
2381  ivHilbert(G,2); // invokes the procedure without any degree bound
2382  ivHilbert(I,2,5); // invokes the procedure with degree bound 5
2383}
2384
2385
2386proc ivKDim(list L, int n, list #)
2387"USAGE: ivKDim(L,n[,degbound]); L a list of intmats,
2388@*      n an integer, degbound an optional integer
2389RETURN: int, the K-dimension of A/<L>
2390PURPOSE:Computing the K-dimension of A/<L>
2391ASSUME: - basering is a Letterplace ring.
2392@*      - all rows of each intmat correspond to a Letterplace monomial
2393@*      - if you specify a different degree bound degbound,
2394@*        degbound <= attrib(basering,uptodeg) holds.
2395NOTE: - If degbound is set, a degree bound will be added. By default there
2396@*      is no degree bound.
2397@*    - n is the number of variables.
2398@*    - If the K-dimension is known to be infinite, a degree bound is needed
2399EXAMPLE: example ivKDim; shows examples
2400"
2401{int degbound = 0;
2402  if (size(#) > 0) {if (typeof(#[1])=="int"){if (#[1] > 0) {degbound = #[1];}}}
2403  intvec P,H; int i;
2404  for (i = 1; i <= size(L); i++)
2405  {P[i] = ncols(L[i]);
2406    if (P[i] == 1) {if ( isInMat(H,L[i]) > 0) {ERROR("Quotient algebra is trivial");}}
2407  }
2408  if (size(L) == 0) {ERROR("GB is empty, quotient algebra corresponds to free algebra");}
2409  kill H;
2410  checkAssumptions(degbound,L);
2411  if (degbound == 0)
2412  {int sd; int dimen = 1;
2413    intmat S;
2414    sd = P[1];
2415    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
2416    sd = (sd - 1);
2417    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
2418    else {S = createStartMat(sd,n);}
2419    if (intvec(S) == 0) {return(dimen);}
2420    for (i = 1; i <= sd; i++) {dimen = dimen +(n^i);}
2421    for (i = 1; i <= nrows(S); i++)
2422    {intvec St = S[i,1..ncols(S)];
2423      dimen = dimen + findDimen(St,n,L,P);
2424      kill St;
2425    }
2426    return(dimen);
2427  }
2428  else
2429  {for (i = 1; i <= size(P); i++)
2430    {if (P[i] > degbound) {ERROR("degreebound is too small, GB contains elements of higher degree");}}
2431    int sd; int dimen = 1;
2432    intmat S;
2433    sd = P[1];
2434    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
2435    sd = (sd - 1);
2436    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
2437    else {S = createStartMat(sd,n);}
2438    if (intvec(S) == 0) {return(dimen);}
2439    for (i = 1; i <= sd; i++) {dimen = dimen +(n^i);}
2440    for (i = 1; i <= nrows(S); i++)
2441    {intvec St = S[i,1..ncols(S)];
2442      dimen = dimen + findDimen(St,n,L,P, degbound);
2443      kill St;
2444    }
2445    return(dimen);
2446  }
2447}
2448example
2449{
2450  "EXAMPLE:"; echo = 2;
2451  ring r = 0,(x,y),dp;
2452  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2453  R;
2454  setring R; // sets basering to Letterplace ring
2455  //some intmats, which contain monomials in intvec representation as rows
2456  intmat I1 [2][2] = 1,1,2,2; intmat I2 [1][3]  = 1,2,1;
2457  intmat J1 [1][2] =  1,1; intmat J2 [2][3] = 2,1,2,1,2,1;
2458  print(I1);
2459  print(I2);
2460  print(J1);
2461  print(J2);
2462  list G = I1,I2; // ideal, which is already a Groebner basis
2463  list I = J1,J2; // ideal, which is already a Groebner basis
2464  ivKDim(G,2); // invokes the procedure without any degree bound
2465  ivKDim(I,2,5); // invokes the procedure with degree bound 5
2466}
2467
2468proc ivMis2Base(list M)
2469"USAGE: ivMis2Base(M); M a list of intvecs
2470RETURN: ideal, a K-base of the given algebra
2471PURPOSE:Computing the K-base out of given mistletoes
2472ASSUME: - The mistletoes have to be ordered lexicographically -> OrdMisLex.
2473@*        Otherwise there might some elements missing.
2474@*      - basering is a Letterplace ring.
2475@*      - mistletoes are stored as intvecs, as described in the overview
2476EXAMPLE: example ivMis2Base; shows examples
2477"
2478{
2479  //checkAssumptions(0,M);
2480  intvec L,A;
2481  if (size(M) == 0){ERROR("There are no mistletoes, so it appears your dimension is infinite!");}
2482  if (isInList(L,M) > 0) {print("1 is a mistletoe, therefore 1 is the only basis element"); return(list(intvec(0)));}
2483  int i,j,d,s;
2484  list Rt;
2485  Rt[1] = intvec(0);
2486  L = M[1];
2487  for (i = size(L); 1 <= i; i--) {Rt = insert(Rt,intvec(L[1..i]));}
2488  for (i = 2; i <= size(M); i++)
2489  {A = M[i]; L = M[i-1];
2490    s = size(A);
2491    if (s > size(L))
2492    {d = size(L);
2493      for (j = s; j > d; j--) {Rt = insert(Rt,intvec(A[1..j]));}
2494      A = A[1..d];
2495    }
2496    if (size(L) > s){L = L[1..s];}
2497    while (A <> L)
2498    {Rt = insert(Rt, intvec(A));
2499      if (size(A) > 1)
2500      {A = A[1..(size(A)-1)];
2501        L = L[1..(size(L)-1)];
2502      }
2503      else {break;}
2504    }
2505  }
2506  return(Rt);
2507}
2508example
2509{
2510  "EXAMPLE:"; echo = 2;
2511  ring r = 0,(x,y),dp;
2512  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2513  R;
2514  setring R; // sets basering to Letterplace ring
2515  intvec i1 = 1,2; intvec i2 = 2,1,2;
2516  // the mistletoes are xy and yxy, which are already ordered lexicographically
2517  list L = i1,i2;
2518  ivMis2Base(L); // returns the basis of the factor algebra
2519}
2520
2521
2522proc ivMis2Dim(list M)
2523"USAGE: ivMis2Dim(M); M a list of intvecs
2524RETURN: int, the K-dimension of the given algebra
2525PURPOSE:Computing the K-dimension out of given mistletoes
2526ASSUME: - The mistletoes have to be ordered lexicographically -> OrdMisLex.
2527@*        Otherwise the returned value may differ from the K-dimension.
2528@*      - basering is a Letterplace ring.
2529EXAMPLE: example ivMis2Dim; shows examples
2530"
2531{checkAssumptions(0,M);
2532  intvec L;
2533  if (size(M) == 0){ERROR("There are no mistletoes, so it appears your dimension is infinite!");}
2534  if (isInList(L,M) > 0) {print("1 is a mistletoe, therefore dim = 1"); return(1);}
2535  int i,j,d,s;
2536  j = 1;
2537  d = 1 + size(M[1]);
2538  for (i = 1; i < size(M); i++)
2539  {s = size(M[i]); if (s > size(M[i+1])){s = size(M[i+1]);}
2540    while ((M[i][j] == M[i+1][j]) && (j <= s)){j = j + 1;}
2541    d = d + size(M[i+1])- j + 1;
2542  }
2543  return(d);
2544}
2545example
2546{
2547  "EXAMPLE:"; echo = 2;
2548  ring r = 0,(x,y),dp;
2549  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2550  R;
2551  setring R; // sets basering to Letterplace ring
2552  intvec i1 = 1,2; intvec i2 = 2,1,2;
2553  // the mistletoes are xy and yxy, which are already ordered lexicographically
2554  list L = i1,i2;
2555  ivMis2Dim(L); // returns the dimension of the factor algebra
2556}
2557
2558proc ivOrdMisLex(list M)
2559"USAGE: ivOrdMisLex(M); M a list of intvecs
2560RETURN: list, containing the ordered intvecs of M
2561PURPOSE:Orders a given set of mistletoes lexicographically
2562ASSUME: - basering is a Letterplace ring.
2563- intvecs correspond to monomials
2564NOTE:   - This is preprocessing, it's not needed if the mistletoes are returned
2565@*        from the sickle algorithm.
2566@*      - Each entry of the list returned is an intvec.
2567EXAMPLE: example ivOrdMisLex; shows examples
2568"
2569{checkAssumptions(0,M);
2570  return(sort(M)[1]);
2571}
2572example
2573{
2574  "EXAMPLE:"; echo = 2;
2575  ring r = 0,(x,y),dp;
2576  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2577  setring R; // sets basering to Letterplace ring
2578  intvec i1 = 1,2,1; intvec i2 = 2,2,1; intvec i3 = 1,1; intvec i4 = 2,1,1,1;
2579  // the corresponding monomials are xyx,y^2x,x^2,yx^3
2580  list M = i1,i2,i3,i4;
2581  M;
2582  ivOrdMisLex(M);// orders the list of monomials
2583}
2584
2585proc ivSickle(list L, int n, list #)
2586"USAGE: ivSickle(L,n,[degbound]); L a list of intmats, n an int, degbound an
2587@*      optional integer
2588RETURN: list, containing intvecs, the mistletoes of A/<L>
2589PURPOSE:Computing the mistletoes for a given Groebner basis L
2590ASSUME: - basering is a Letterplace ring.
2591@*      - all rows of each intmat correspond to a Letterplace monomial
2592@*      - if you specify a different degree bound degbound,
2593@*        degbound <= attrib(basering,uptodeg) holds.
2594NOTE: - If degbound is set, a degree bound will be added. By default there
2595@*      is no degree bound.
2596@*    - n is the number of variables.
2597@*    - If the K-dimension is known to be infinite, a degree bound is needed
2598EXAMPLE: example ivSickle; shows examples
2599"
2600{list M;
2601  int degbound = 0;
2602  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] > 0){degbound = #[1];}}}
2603  int i;
2604  intvec P,H;
2605  for (i = 1; i <= size(L); i++)
2606  {P[i] = ncols(L[i]);
2607    if (P[i] == 1) {if (isInMat(H,L[i]) > 0) {ERROR("Quotient algebra is trivial");}}
2608  }
2609  if (size(L) == 0) {ERROR("GB is empty, quotient algebra corresponds to free algebra");}
2610  kill H;
2611  checkAssumptions(degbound,L);
2612  if (degbound == 0)
2613  {intmat S; int sd;
2614    sd = P[1];
2615    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
2616    sd = (sd - 1);
2617    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
2618    else {S = createStartMat(sd,n);}
2619    if (intvec(S) == 0) {return(list (intvec(0)));}
2620    for (i = 1; i <= nrows(S); i++)
2621    {intvec St = S[i,1..ncols(S)];
2622      M = M + findmistletoes(St,n,L,P);
2623      kill St;
2624    }
2625    return(M);
2626  }
2627  else
2628  {for (i = 1; i <= size(P); i++)
2629    {if (P[i] > degbound) {ERROR("degreebound is too small, GB contains elements of higher degree");}}
2630    intmat S; int sd;
2631    sd = P[1];
2632    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
2633    sd = (sd - 1);
2634    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
2635    else {S = createStartMat(sd,n);}
2636    if (intvec(S) == 0) {return(list (intvec(0)));}
2637    for (i = 1; i <= nrows(S); i++)
2638    {intvec St = S[i,1..ncols(S)];
2639      M = M + findmistletoes(St,n,L,P,degbound);
2640      kill St;
2641    }
2642    return(M);
2643  }
2644}
2645example
2646{
2647  "EXAMPLE:"; echo = 2;
2648  ring r = 0,(x,y),dp;
2649  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2650  setring R; // sets basering to Letterplace ring
2651  //some intmats, which contain monomials in intvec representation as rows
2652  intmat I1 [2][2] = 1,1,2,2; intmat I2 [1][3]  = 1,2,1;
2653  intmat J1 [1][2] =  1,1; intmat J2 [2][3] = 2,1,2,1,2,1;
2654  print(I1);
2655  print(I2);
2656  print(J1);
2657  print(J2);
2658  list G = I1,I2; // ideal, which is already a Groebner basis
2659  list I =  J1,J2; // ideal, which is already a Groebner basis
2660  ivSickle(G,2); // invokes the procedure without any degree bound
2661  ivSickle(I,2,5); // invokes the procedure with degree bound 5
2662}
2663
2664proc ivSickleDim(list L, int n, list #)
2665"USAGE: ivSickleDim(L,n[,degbound]); L a list of intmats, n an integer, degbound
2666@*      an optional integer
2667RETURN: list
2668PURPOSE:Computing mistletoes and the K-dimension
2669ASSUME: - basering is a Letterplace ring.
2670@*      - all rows of each intmat correspond to a Letterplace monomial
2671@*      - if you specify a different degree bound degbound,
2672@*        degbound <= attrib(basering,uptodeg) holds.
2673NOTE: - If L is the list returned, then L[1] is an integer, L[2] is a list,
2674@*      containing the mistletoes as intvecs.
2675@*    - If degbound is set, a degree bound will be added. By default there
2676@*      is no degree bound.
2677@*    - n is the number of variables.
2678@*    - If the K-dimension is known to be infinite, a degree bound is needed
2679EXAMPLE: example ivSickleDim; shows examples
2680"
2681{list M;
2682  int degbound = 0;
2683  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] > 0){degbound = #[1];}}}
2684  int i,dimen; list R;
2685  intvec P,H;
2686  for (i = 1; i <= size(L); i++)
2687  {P[i] = ncols(L[i]);
2688    if (P[i] == 1) {if (isInMat(H,L[i]) > 0) {ERROR("Quotient algebra is trivial, dimension equals zero");}}
2689  }
2690  if (size(L) == 0) {ERROR("GB is empty, quotient algebra corresponds to free algebra");}
2691  kill H;
2692  checkAssumptions(degbound,L);
2693  if (degbound == 0)
2694  {int sd; dimen = 1;
2695    intmat S;
2696    sd = P[1];
2697    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
2698    sd = (sd - 1);
2699    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
2700    else {S = createStartMat(sd,n);}
2701    if (intvec(S) == 0) {return(list(dimen,list(intvec(0))));}
2702    for (i = 1; i <= sd; i++) {dimen = dimen +(n^i);}
2703    R[1] = dimen;
2704    for (i = 1; i <= nrows(S); i++)
2705    {intvec St = S[i,1..ncols(S)];
2706      R = findMisDim(St,n,L,P,R);
2707      kill St;
2708    }
2709    return(R);
2710  }
2711  else
2712  {for (i = 1; i <= size(P); i++)
2713    {if (P[i] > degbound) {ERROR("degreebound is too small, GB contains elements of higher degree");}}
2714    int sd; dimen = 1;
2715    intmat S;
2716    sd = P[1];
2717    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
2718    sd = (sd - 1);
2719    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
2720    else {S = createStartMat(sd,n);}
2721    if (intvec(S) == 0) {return(list(dimen,list(intvec(0))));}
2722    for (i = 1; i <= sd; i++) {dimen = dimen +(n^i);}
2723    R[1] = dimen;
2724    for (i = 1; i <= nrows(S); i++)
2725    {intvec St = S[i,1..ncols(S)];
2726      R = findMisDim(St,n,L,P,R,degbound);
2727      kill St;
2728    }
2729    return(R);
2730  }
2731}
2732example
2733{
2734  "EXAMPLE:"; echo = 2;
2735  ring r = 0,(x,y),dp;
2736  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2737  setring R; // sets basering to Letterplace ring
2738  //some intmats, which contain monomials in intvec representation as rows
2739  intmat I1 [2][2] = 1,1,2,2; intmat I2 [1][3]  = 1,2,1;
2740  intmat J1 [1][2] =  1,1; intmat J2 [2][3] = 2,1,2,1,2,1;
2741  print(I1);
2742  print(I2);
2743  print(J1);
2744  print(J2);
2745  list G = I1,I2;// ideal, which is already a Groebner basis
2746  list I =  J1,J2; // ideal, which is already a Groebner basis
2747  ivSickleDim(G,2); // invokes the procedure without any degree bound
2748  ivSickleDim(I,2,5); // invokes the procedure with degree bound 5
2749}
2750
2751proc ivSickleHil(list L, int n, list #)
2752"USAGE:ivSickleHil(L,n[,degbound]); L a list of intmats, n an integer,
2753@*     degbound an optional integer
2754RETURN: list
2755PURPOSE:Computing the mistletoes and the Hilbert series
2756ASSUME: - basering is a Letterplace ring.
2757@*      - all rows of each intmat correspond to a Letterplace monomial
2758@*      - if you specify a different degree bound degbound,
2759@*        degbound <= attrib(basering,uptodeg) holds.
2760NOTE: - If L is the list returned, then L[1] is an intvec, L[2] is a list,
2761@*      containing the mistletoes as intvecs.
2762@*    - If degbound is set, a degree bound will be added. By default there
2763@*      is no degree bound.
2764@*    - n is the number of variables.
2765@*    - If I = L[1] is the intvec returned, then I[k] is the (k-1)-th
2766@*      coefficient of the Hilbert series.
2767@*    - If the K-dimension is known to be infinite, a degree bound is needed
2768EXAMPLE: example ivSickleHil; shows examples
2769"
2770{int degbound = 0;
2771  if (size(#) > 0) {if (typeof(#[1])=="int"){if (#[1] > 0) {degbound = #[1];}}}
2772  intvec P,H; int i; list R;
2773  for (i = 1; i <= size(L); i++)
2774  {P[i] = ncols(L[i]);
2775    if (P[i] == 1) {if ( isInMat(H,L[i]) > 0) {ERROR("Quotient algebra is trivial");}}
2776  }
2777  if (size(L) == 0) {ERROR("GB is empty, quotient algebra corresponds to free algebra");}
2778  H[1] = 1;
2779  checkAssumptions(degbound,L);
2780  if (degbound == 0)
2781  {int sd;
2782    intmat S;
2783    sd = P[1];
2784    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
2785    sd = (sd - 1);
2786    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
2787    else {S = createStartMat(sd,n);}
2788    if (intvec(S) == 0) {return(list(H,list(intvec (0))));}
2789    for (i = 1; i <= sd; i++) {H = H,(n^i);}
2790    R[1] = H; kill H;
2791    for (i = 1; i <= nrows(S); i++)
2792    {intvec St = S[i,1..ncols(S)];
2793      R = findHCoeffMis(St,n,L,P,R);
2794      kill St;
2795    }
2796    return(R);
2797  }
2798  else
2799  {for (i = 1; i <= size(P); i++)
2800    {if (P[i] > degbound) {ERROR("degreebound is too small, GB contains elements of higher degree");}}
2801    int sd;
2802    intmat S;
2803    sd = P[1];
2804    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
2805    sd = (sd - 1);
2806    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
2807    else {S = createStartMat(sd,n);}
2808    if (intvec(S) == 0) {return(list(H,list(intvec(0))));}
2809    for (i = 1; i <= sd; i++) {H = H,(n^i);}
2810    R[1] = H; kill H;
2811    for (i = 1; i <= nrows(S); i++)
2812    {intvec St = S[i,1..ncols(S)];
2813      R = findHCoeffMis(St,n,L,P,R,degbound);
2814      kill St;
2815    }
2816    return(R);
2817  }
2818}
2819example
2820{
2821  "EXAMPLE:"; echo = 2;
2822  ring r = 0,(x,y),dp;
2823  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2824  setring R; // sets basering to Letterplace ring
2825  //some intmats, which contain monomials in intvec representation as rows
2826  intmat I1[2][2] = 1,1,2,2; intmat I2[1][3]  = 1,2,1;
2827  intmat J1[1][2] =  1,1; intmat J2[2][3] = 2,1,2,1,2,1;
2828  print(I1);
2829  print(I2);
2830  print(J1);
2831  print(J2);
2832  list G = I1,I2;// ideal, which is already a Groebner basis
2833  list I =  J1,J2; // ideal, which is already a Groebner basis
2834  ivSickleHil(G,2); // invokes the procedure without any degree bound
2835  ivSickleHil(I,2,5); // invokes the procedure with degree bound 5
2836}
2837
2838proc lpDHilbert(ideal G, list #)
2839"USAGE: lpDHilbert(G[,degbound,n]); G an ideal, degbound, n optional integers
2840RETURN: list
2841PURPOSE:Computing K-dimension and Hilbert series, starting with a lp-ideal
2842ASSUME: - basering is a Letterplace ring.
2843@*      - if you specify a different degree bound degbound,
2844@*        degbound <= attrib(basering,uptodeg) holds.
2845NOTE: - If L is the list returned, then L[1] is an integer corresponding to the
2846@*      dimension, L[2] is an intvec which contains the coefficients of the
2847@*      Hilbert series
2848@*    - If degbound is set, there will be a degree bound added. 0 means no
2849@*      degree bound. Default: attrib(basering,uptodeg).
2850@*    - n can be set to a different number of variables.
2851@*      Default: n = attrib(basering, lV).
2852@*    - If I = L[2] is the intvec returned, then I[k] is the (k-1)-th
2853@*      coefficient of the Hilbert series.
2854@*    - If the K-dimension is known to be infinite, a degree bound is needed
2855EXAMPLE: example lpDHilbert; shows examples
2856"
2857{int degbound = attrib(basering,"uptodeg");int n = attrib(basering, "lV");
2858  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] >= 0){degbound = #[1];}}}
2859  if (size(#) > 1){if (typeof(#[1])=="int"){if (#[2] > 0){n = #[2];}}}
2860  list L;
2861  L = lp2ivId(normalize(lead(G)));
2862  return(ivDHilbert(L,n,degbound));
2863}
2864example
2865{
2866  "EXAMPLE:"; echo = 2;
2867  ring r = 0,(x,y),dp;
2868  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2869  setring R; // sets basering to Letterplace ring
2870  ideal G = x(1)*x(2), y(1)*y(2),x(1)*y(2)*x(3); // ideal G contains a
2871  //Groebner basis
2872  lpDHilbert(G,5,2); // invokes procedure with degree bound 5 and 2 variables
2873  // note that the optional parameters are not necessary, due to the finiteness
2874  // of the K-dimension of the factor algebra
2875  lpDHilbert(G); // procedure with ring parameters
2876  lpDHilbert(G,0); // procedure without degreebound
2877}
2878
2879proc lpDHilbertSickle(ideal G, list #)
2880"USAGE: lpDHilbertSickle(G[,degbound,n]); G an ideal, degbound, n optional
2881@*      integers
2882RETURN: list
2883PURPOSE:Computing K-dimension, Hilbert series and mistletoes at once
2884ASSUME: - basering is a Letterplace ring.
2885@*      - if you specify a different degree bound degbound,
2886@*        degbound <= attrib(basering,uptodeg) holds.
2887NOTE: - If L is the list returned, then L[1] is an integer, the K-dimension,
2888@*      L[2] is an intvec, the Hilbert series and L[3] is an ideal,
2889@*      the mistletoes
2890@*    - If degbound is set, there will be a degree bound added. 0 means no
2891@*      degree bound. Default: attrib(basering,uptodeg).
2892@*    - n can be set to a different number of variables.
2893@*      Default: n = attrib(basering, lV).
2894@*    - If I = L[1] is the intvec returned, then I[k] is the (k-1)-th
2895@*      coefficient of the Hilbert series.
2896@*    - If the K-dimension is known to be infinite, a degree bound is needed
2897EXAMPLE: example lpDHilbertSickle; shows examples
2898"
2899{int degbound = attrib(basering,"uptodeg");int n = attrib(basering, "lV");
2900  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] >= 0){degbound = #[1];}}}
2901  if (size(#) > 1){if (typeof(#[1])=="int"){if (#[2] > 0){n = #[2];}}}
2902  list L;
2903  L = lp2ivId(normalize(lead(G)));
2904  L = ivDHilbertSickle(L,n,degbound);
2905  L[3] =  ivL2lpI(L[3]);
2906  return(L);
2907}
2908example
2909{
2910  "EXAMPLE:"; echo = 2;
2911  ring r = 0,(x,y),dp;
2912  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2913  setring R; // sets basering to Letterplace ring
2914  ideal G = x(1)*x(2), y(1)*y(2),x(1)*y(2)*x(3); // ideal G contains a
2915  //Groebner basis
2916  lpDHilbertSickle(G,5,2); //invokes procedure with degree bound 5 and 2 variables
2917  // note that the optional parameters are not necessary, due to the finiteness
2918  // of the K-dimension of the factor algebra
2919  lpDHilbertSickle(G); // procedure with ring parameters
2920  lpDHilbertSickle(G,0); // procedure without degreebound
2921}
2922
2923proc lpHilbert(ideal G, list #)
2924"USAGE: lpHilbert(G[,degbound,n]); G an ideal, degbound, n optional integers
2925RETURN: intvec, containing the coefficients of the Hilbert series
2926PURPOSE:Computing the Hilbert series
2927ASSUME: - basering is a Letterplace ring.
2928@*      - if you specify a different degree bound degbound,
2929@*        degbound <= attrib(basering,uptodeg) holds.
2930NOTE: - If degbound is set, there will be a degree bound added. 0 means no
2931@*      degree bound. Default: attrib(basering,uptodeg).
2932@*    - n is the number of variables, which can be set to a different number.
2933@*      Default: attrib(basering, lV).
2934@*    - If I is returned, then I[k] is the (k-1)-th coefficient of the Hilbert
2935@*      series.
2936@*    - If the K-dimension is known to be infinite, a degree bound is needed
2937EXAMPLE: example lpHilbert; shows examples
2938"
2939{int degbound = attrib(basering,"uptodeg");int n = attrib(basering, "lV");
2940  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] >= 0){degbound = #[1];}}}
2941  if (size(#) > 1){if (typeof(#[1])=="int"){if (#[2] > 0){n = #[2];}}}
2942  list L;
2943  L = lp2ivId(normalize(lead(G)));
2944  return(ivHilbert(L,n,degbound));
2945}
2946example
2947{
2948  "EXAMPLE:"; echo = 2;
2949  ring r = 0,(x,y),dp;
2950  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2951  setring R; // sets basering to Letterplace ring
2952  ideal G = x(1)*x(2), y(1)*y(2),x(1)*y(2)*x(3); // ideal G contains a
2953  //Groebner basis
2954  lpHilbert(G,5,2); // invokes procedure with degree bound 5 and 2 variables
2955  // note that the optional parameters are not necessary, due to the finiteness
2956  // of the K-dimension of the factor algebra
2957  lpDHilbert(G); // procedure with ring parameters
2958  lpDHilbert(G,0); // procedure without degreebound
2959}
2960
2961proc lpDimCheck(ideal G)
2962"USAGE: lpDimCheck(G);
2963RETURN: int, 1 if K-dimension of the factor algebra is infinite, 0 otherwise
2964PURPOSE:Checking a factor algebra for finiteness of the K-dimension
2965ASSUME: - basering is a Letterplace ring.
2966EXAMPLE: example lpDimCheck; shows examples
2967"
2968{int n = attrib(basering,"lV");
2969  list L;
2970  ideal R;
2971  R = normalize(lead(G));
2972  L = lp2ivId(R);
2973  return(ivDimCheck(L,n));
2974}
2975example
2976{
2977  "EXAMPLE:"; echo = 2;
2978  ring r = 0,(x,y),dp;
2979  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2980  setring R; // sets basering to Letterplace ring
2981  ideal G = x(1)*x(2), y(1)*y(2),x(1)*y(2)*x(3);
2982  // Groebner basis
2983  ideal I = x(1)*x(2), y(1)*x(2)*y(3), x(1)*y(2)*x(3);
2984  // Groebner basis
2985  lpDimCheck(G); // invokes procedure, factor algebra is of finite K-dimension
2986  lpDimCheck(I); // invokes procedure, factor algebra is of infinite Kdimension
2987}
2988
2989proc lpKDim(ideal G, list #)
2990"USAGE: lpKDim(G[,degbound, n]); G an ideal, degbound, n optional integers
2991RETURN: int, the K-dimension of the factor algebra
2992PURPOSE:Computing the K-dimension of a factor algebra, given via an ideal
2993ASSUME: - basering is a Letterplace ring
2994@*      - if you specify a different degree bound degbound,
2995@*        degbound <= attrib(basering,uptodeg) holds.
2996NOTE: - If degbound is set, there will be a degree bound added. 0 means no
2997@*      degree bound. Default: attrib(basering, uptodeg).
2998@*    - n is the number of variables, which can be set to a different number.
2999@*      Default: attrib(basering, lV).
3000@*    - If the K-dimension is known to be infinite, a degree bound is needed
3001EXAMPLE: example lpKDim; shows examples
3002"
3003{int degbound = attrib(basering, "uptodeg");int n = attrib(basering, "lV");
3004  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] >= 0){degbound = #[1];}}}
3005  if (size(#) > 1){if (typeof(#[1])=="int"){if (#[2] > 0){n = #[2];}}}
3006  list L;
3007  L = lp2ivId(normalize(lead(G)));
3008  return(ivKDim(L,n,degbound));
3009}
3010example
3011{
3012  "EXAMPLE:"; echo = 2;
3013  ring r = 0,(x,y),dp;
3014  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
3015  setring R; // sets basering to Letterplace ring
3016  ideal G = x(1)*x(2), y(1)*y(2),x(1)*y(2)*x(3);
3017  // ideal G contains a Groebner basis
3018  lpKDim(G); //procedure invoked with ring parameters
3019  // the factor algebra is finite, so the degree bound given by the Letterplace
3020  // ring is not necessary
3021  lpKDim(G,0); // procedure without any degree bound
3022}
3023
3024proc lpMis2Base(ideal M)
3025"USAGE: lpMis2Base(M); M an ideal
3026RETURN: ideal, a K-basis of the factor algebra
3027PURPOSE:Computing a K-basis out of given mistletoes
3028ASSUME: - basering is a Letterplace ring. G is a Letterplace ideal.
3029@*      - M contains only monomials
3030NOTE:   - The mistletoes have to be ordered lexicographically -> OrdMisLex.
3031EXAMPLE: example lpMis2Base; shows examples
3032"
3033{list L;
3034  L = lpId2ivLi(M);
3035  return(ivL2lpI(ivMis2Base(L)));
3036}
3037example
3038{
3039  "EXAMPLE:"; echo = 2;
3040  ring r = 0,(x,y),dp;
3041  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
3042  setring R; // sets basering to Letterplace ring
3043  ideal L = x(1)*y(2),y(1)*x(2)*y(3);
3044  // ideal containing the mistletoes
3045  lpMis2Base(L); // returns the K-basis of the factor algebra
3046}
3047
3048proc lpMis2Dim(ideal M)
3049"USAGE: lpMis2Dim(M); M an ideal
3050RETURN: int, the K-dimension of the factor algebra
3051PURPOSE:Computing the K-dimension out of given mistletoes
3052ASSUME: - basering is a Letterplace ring.
3053@*      - M contains only monomials
3054NOTE:   - The mistletoes have to be ordered lexicographically -> OrdMisLex.
3055EXAMPLE: example lpMis2Dim; shows examples
3056"
3057{list L;
3058  L = lpId2ivLi(M);
3059  return(ivMis2Dim(L));
3060}
3061example
3062{
3063  "EXAMPLE:"; echo = 2;
3064  ring r = 0,(x,y),dp;
3065  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
3066  setring R; // sets basering to Letterplace ring
3067  ideal L = x(1)*y(2),y(1)*x(2)*y(3);
3068  // ideal containing the mistletoes
3069  lpMis2Dim(L); // returns the K-dimension of the factor algebra
3070}
3071
3072proc lpOrdMisLex(ideal M)
3073"USAGE: lpOrdMisLex(M); M an ideal of mistletoes
3074RETURN: ideal, containing the mistletoes, ordered lexicographically
3075PURPOSE:A given set of mistletoes is ordered lexicographically
3076ASSUME: - basering is a Letterplace ring.
3077NOTE:   This is preprocessing, it is not needed if the mistletoes are returned
3078@*      from the sickle algorithm.
3079EXAMPLE: example lpOrdMisLex; shows examples
3080"
3081{return(ivL2lpI(sort(lpId2ivLi(M))[1]));}
3082example
3083{
3084  "EXAMPLE:"; echo = 2;
3085  ring r = 0,(x,y),dp;
3086  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
3087  setring R; // sets basering to Letterplace ring
3088  ideal M = x(1)*y(2)*x(3), y(1)*y(2)*x(3), x(1)*x(2), y(1)*x(2)*x(3)*x(4);
3089  // some monomials
3090  lpOrdMisLex(M); // orders the monomials lexicographically
3091}
3092
3093proc lpSickle(ideal G,  list #)
3094"USAGE: lpSickle(G[,degbound,n]); G an ideal, degbound, n optional integers
3095RETURN: ideal
3096PURPOSE:Computing the mistletoes of K[X]/<G>
3097ASSUME: - basering is a Letterplace ring.
3098@*      - if you specify a different degree bound degbound,
3099@*        degbound <= attrib(basering,uptodeg) holds.
3100NOTE: - If degbound is set, there will be a degree bound added. 0 means no
3101@*      degree bound. Default: attrib(basering,uptodeg).
3102@*    - n is the number of variables, which can be set to a different number.
3103@*      Default: attrib(basering, lV).
3104@*    - If the K-dimension is known to be infinite, a degree bound is needed
3105EXAMPLE: example lpSickle; shows examples
3106"
3107{int degbound = attrib(basering,"uptodeg"); int n = attrib(basering, "lV");
3108  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] >= 0){degbound = #[1];}}}
3109  if (size(#) > 1){if (typeof(#[1])=="int"){if (#[2] > 0){n = #[2];}}}
3110  list L; ideal R;
3111  R = normalize(lead(G));
3112  L = lp2ivId(R);
3113  L = ivSickle(L,n,degbound);
3114  R = ivL2lpI(L);
3115  return(R);
3116}
3117example
3118{
3119  "EXAMPLE:"; echo = 2;
3120  ring r = 0,(x,y),dp;
3121  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
3122  setring R; // sets basering to Letterplace ring
3123  ideal G = x(1)*x(2), y(1)*y(2),x(1)*y(2)*x(3); // ideal G contains a
3124  //Groebner basis
3125  lpSickle(G); //invokes the procedure with ring parameters
3126  // the factor algebra is finite, so the degree bound given by the Letterplace
3127  // ring is not necessary
3128  lpSickle(G,0); // procedure without any degree bound
3129}
3130
3131proc lpSickleDim(ideal G, list #)
3132"USAGE: lpSickleDim(G[,degbound,n]); G an ideal, degbound, n optional integers
3133RETURN: list
3134PURPOSE:Computing the K-dimension and the mistletoes
3135ASSUME: - basering is a Letterplace ring.
3136@*      - if you specify a different degree bound degbound,
3137@*        degbound <= attrib(basering,uptodeg) holds.
3138NOTE: - If L is the list returned, then L[1] is an integer, the K-dimension,
3139@*      L[2] is an ideal, the mistletoes.
3140@*    - If degbound is set, there will be a degree bound added. 0 means no
3141@*      degree bound. Default: attrib(basering,uptodeg).
3142@*    - n is the number of variables, which can be set to a different number.
3143@*      Default: attrib(basering, lV).
3144@*    - If the K-dimension is known to be infinite, a degree bound is needed
3145EXAMPLE: example lpSickleDim; shows examples
3146"
3147{int degbound = attrib(basering,"uptodeg");int n = attrib(basering, "lV");
3148  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] >= 0){degbound = #[1];}}}
3149  if (size(#) > 1){if (typeof(#[1])=="int"){if (#[2] > 0){n = #[2];}}}
3150  list L;
3151  L = lp2ivId(normalize(lead(G)));
3152  L = ivSickleDim(L,n,degbound);
3153  L[2] = ivL2lpI(L[2]);
3154  return(L);
3155}
3156example
3157{
3158  "EXAMPLE:"; echo = 2;
3159  ring r = 0,(x,y),dp;
3160  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
3161  setring R; // sets basering to Letterplace ring
3162  ideal G = x(1)*x(2), y(1)*y(2),x(1)*y(2)*x(3); // ideal G contains a
3163  //Groebner basis
3164  lpSickleDim(G); // invokes the procedure with ring parameters
3165  // the factor algebra is finite, so the degree bound given by the Letterplace
3166  // ring is not necessary
3167  lpSickleDim(G,0); // procedure without any degree bound
3168}
3169
3170proc lpSickleHil(ideal G, list #)
3171"USAGE: lpSickleHil(G);
3172RETURN: list
3173PURPOSE:Computing the Hilbert series and the mistletoes
3174ASSUME: - basering is a Letterplace ring.
3175@*      - if you specify a different degree bound degbound,
3176@*        degbound <= attrib(basering,uptodeg) holds.
3177NOTE: - If L is the list returned, then L[1] is an intvec, corresponding to the
3178@*      Hilbert series, L[2] is an ideal, the mistletoes.
3179@*    - If degbound is set, there will be a degree bound added. 0 means no
3180@*      degree bound. Default: attrib(basering,uptodeg).
3181@*    - n is the number of variables, which can be set to a different number.
3182@*      Default: attrib(basering, lV).
3183@*    - If I = L[1] is the intvec returned, then I[k] is the (k-1)-th
3184@*      coefficient of the Hilbert series.
3185@*    - If the K-dimension is known to be infinite, a degree bound is needed
3186EXAMPLE: example lpSickleHil; shows examples
3187"
3188{int degbound = attrib(basering,"uptodeg");int n = attrib(basering, "lV");
3189  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] >= 0){degbound = #[1];}}}
3190  if (size(#) > 1){if (typeof(#[1])=="int"){if (#[2] > 0){n = #[2];}}}
3191  list L;
3192  L = lp2ivId(normalize(lead(G)));
3193  L = ivSickleHil(L,n,degbound);
3194  L[2] =  ivL2lpI(L[2]);
3195  return(L);
3196}
3197example
3198{
3199  "EXAMPLE:"; echo = 2;
3200  ring r = 0,(x,y),dp;
3201  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
3202  setring R; // sets basering to Letterplace ring
3203  ideal G = x(1)*x(2), y(1)*y(2),x(1)*y(2)*x(3); // ideal G contains a
3204  //Groebner basis
3205  lpSickleHil(G); // invokes the procedure with ring parameters
3206  // the factor algebra is finite, so the degree bound given by the Letterplace
3207  // ring is not necessary
3208  lpSickleHil(G,0); // procedure without any degree bound
3209}
3210
3211proc sickle(ideal G, list #)
3212"USAGE: sickle(G[,m, d, h, degbound]); G an ideal; m,d,h,degbound optional
3213@*      integers
3214RETURN: list
3215PURPOSE:Allowing the user to access all procs with one command
3216ASSUME: - basering is a Letterplace ring.
3217@*      - if you specify a different degree bound degbound,
3218@*        degbound <= attrib(basering,uptodeg) holds.
3219NOTE:   The returned object will always be a list, but the entries of the
3220@*      returned list may be very different
3221@* case m=1,d=1,h=1: see lpDHilbertSickle
3222@* case m=1,d=1,h=0: see lpSickleDim
3223@* case m=1,d=0,h=1: see lpSickleHil
3224@* case m=1,d=0,h=0: see lpSickle (this is the default case)
3225@* case m=0,d=1,h=1: see lpDHilbert
3226@* case m=0,d=1,h=0: see lpKDim
3227@* case m=0,d=0,h=1: see lpHilbert
3228@* case m=0,d=0,h=0: returns an error
3229@*    - If degbound is set, there will be a degree bound added. 0 means no
3230@*      degree bound. Default: attrib(basering,uptodeg).
3231@*    - If the K-dimension is known to be infinite, a degree bound is needed
3232EXAMPLE: example sickle; shows examples
3233"
3234{int m,d,h,degbound;
3235  m = 1; d = 0; h = 0; degbound = attrib(basering,"uptodeg");
3236  if (size(#) > 0) {if (typeof(#[1])=="int"){if (#[1] < 1) {m = 0;}}}
3237  if (size(#) > 1) {if (typeof(#[1])=="int"){if (#[2] > 0) {d = 1;}}}
3238  if (size(#) > 2) {if (typeof(#[1])=="int"){if (#[3] > 0) {h = 1;}}}
3239  if (size(#) > 3) {if (typeof(#[1])=="int"){if (#[4] >= 0) {degbound = #[4];}}}
3240  if (m == 1)
3241  {if (d == 0)
3242    {if (h == 0) {return(lpSickle(G,degbound,attrib(basering,"lV")));}
3243      else        {return(lpSickleHil(G,degbound,attrib(basering,"lV")));}
3244    }
3245    else
3246    {if (h == 0) {return(lpSickleDim(G,degbound,attrib(basering,"lV")));}
3247      else {return(lpDHilbertSickle(G,degbound,attrib(basering,"lV")));}
3248    }
3249  }
3250  else
3251  {if (d == 0)
3252    {if (h == 0) {ERROR("You request to do nothing, so relax and do so");}
3253      else        {return(lpHilbert(G,degbound,attrib(basering,"lV")));}
3254    }
3255    else
3256    {if (h == 0) {return(lpKDim(G,degbound,attrib(basering,"lV")));}
3257      else {return(lpDHilbert(G,degbound,attrib(basering,"lV")));}
3258    }
3259  }
3260}
3261example
3262{
3263  "EXAMPLE:"; echo = 2;
3264  ring r = 0,(x,y),dp;
3265  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
3266  setring R; // sets basering to Letterplace ring
3267  ideal G = x(1)*x(2), y(1)*y(2),x(1)*y(2)*x(3);
3268  // G contains a Groebner basis
3269  sickle(G,1,1,1); // computes mistletoes, K-dimension and the Hilbert series
3270  sickle(G,1,0,0); // computes mistletoes only
3271  sickle(G,0,1,0); // computes K-dimension only
3272  sickle(G,0,0,1); // computes Hilbert series only
3273}
3274
3275///////////////////////////////////////////////////////////////////////////////
3276/* vl: new stuff for conversion to Magma and to SD
3277todo: doc, example
3278 */
3279proc extractVars(r)
3280{
3281  int i = 1;
3282  int j = 1;
3283  string candidate;
3284  list result = list();
3285  for (i = 1; i<=nvars(r);i++)
3286  {
3287    candidate = string(var(i))[1,find(string(var(i)),"(")-1];
3288    if (!inList(result, candidate))
3289    {
3290      result = insert(result,candidate,size(result));
3291    }
3292  }
3293  return(result);
3294}
3295
3296proc letterPlacePoly2MagmaString(poly h)
3297{
3298  int pos;
3299  string s = string(h);
3300  while(find(s,"("))
3301  {
3302    pos = find(s,"(");
3303    while(s[pos]!=")")
3304    {
3305      s = s[1,pos-1]+s[pos+1,size(s)-pos];
3306    }
3307    if (size(s)!=pos)
3308    {
3309      s = s[1,pos-1]+s[pos+1,size(s)-pos]; // The last (")")
3310    }
3311    else
3312    {
3313      s = s[1,pos-1];
3314    }
3315  }
3316  return(s);
3317}
3318
3319proc letterPlaceIdeal2SD(ideal I, int upToDeg)
3320{
3321  int i;
3322  print("Don't forget to fill in the formal Data in the file");
3323  string result = "<?xml version=\"1.0\"?>"+newline+"<FREEALGEBRA createdAt=\"\" createdBy=\"Singular\" id=\"FREEALGEBRA/\">"+newline;
3324  result = result + "<vars>"+string(extractVars(basering))+"</vars>"+newline;
3325  result = result + "<basis>"+newline;
3326  for (i = 1;i<=size(I);i++)
3327  {
3328    result = result + "<poly>"+letterPlacePoly2MagmaString(I[i])+"</poly>"+newline;
3329  }
3330  result = result + "</basis>"+newline;
3331  result = result + "<uptoDeg>"+ string(upToDeg)+"</uptoDeg>"+newline;
3332  result = result + "<Comment></Comment>"+newline;
3333  result = result + "<Version></Version>"+newline;
3334  result = result + "</FREEALGEBRA>";
3335  return(result);
3336}
3337
3338
3339///////////////////////////////////////////////////////////////////////////////
3340
3341
3342proc tst_fpadim()
3343{
3344  example ivDHilbert;
3345  example ivDHilbertSickle;
3346  example ivDimCheck;
3347  example ivHilbert;
3348  example ivKDim;
3349  example ivMis2Base;
3350  example ivMis2Dim;
3351  example ivOrdMisLex;
3352  example ivSickle;
3353  example ivSickleHil;
3354  example ivSickleDim;
3355  example lpDHilbert;
3356  example lpDHilbertSickle;
3357  example lpHilbert;
3358  example lpDimCheck;
3359  example lpKDim;
3360  example lpMis2Base;
3361  example lpMis2Dim;
3362  example lpOrdMisLex;
3363  example lpSickle;
3364  example lpSickleHil;
3365  example lpSickleDim;
3366  example sickle;
3367  example ivL2lpI;
3368  example iv2lp;
3369  example iv2lpList;
3370  example iv2lpMat;
3371  example lp2iv;
3372  example lp2ivId;
3373  example lpId2ivLi;
3374  example lpGkDim;
3375  example lpGlDimBound;
3376  example lpSubstitute;
3377}
3378
3379
3380/*proc lpSubstituteExpandRing(poly f, list s1, list s2) {*/
3381/*int minDegBound = calcSubstDegBound(f,s1,s2);*/
3382/**/
3383/*def R = basering; // curr lp ring*/
3384/*setring ORIGINALRING; // non lp ring TODO*/
3385/*def R1 = makeLetterplaceRing(minDegBound);*/
3386/*setring R1;*/
3387/**/
3388/*poly g = lpSubstitute(imap(R,f), imap(R,s1), imap(R,s2));*/
3389/**/
3390/*return (R1); // return the new ring*/
3391/*}*/
3392
3393proc lpSubstitute(poly f, ideal s1, ideal s2, list #)
3394"USAGE: lpSubstitute(f,s1,s2[,G]); f letterplace polynomial, s1 list (ideal) of variables
3395@*      to replace, s2 list (ideal) of polynomials to replace with, G optional ideal to
3396@*      reduce with.
3397RETURN: poly, the substituted polynomial
3398ASSUME: - basering is a Letterplace ring
3399@*      - G is a groebner basis,
3400@*      - the current ring has a sufficient degbound (can be calculated with
3401    @*    calcSubstDegBound())
3402EXAMPLE: example lpSubstitute; shows examples
3403"
3404{
3405  ideal G;
3406  if (size(#) > 0) {
3407    if (typeof(#[1])=="ideal") {
3408      G = #[1];
3409    }
3410  }
3411
3412  poly fs;
3413  for (int i = 1; i <= size(f); i++) {
3414    poly fis = leadcoef(f[i]);
3415    intvec ivfi = lp2iv(f[i]);
3416    for (int j = 1; j <= size(ivfi); j++) {
3417      int varindex = ivfi[j];
3418      int subindex = lpIndexOf(s1, var(varindex));
3419      if (subindex > 0) {
3420        s2[subindex] = lpNF(s2[subindex],G);
3421        fis = lpMult(fis, s2[subindex]);
3422      } else {
3423        fis = lpMult(fis, lpNF(iv2lp(varindex),G));
3424      }
3425      /*fis = lpNF(fis,G);*/
3426    }
3427    fs = fs + fis;
3428  }
3429  fs = lpNF(fs, G);
3430  return (fs);
3431}
3432example {
3433  LIB "fpadim.lib";
3434  ring r = 0,(x,y,z),dp;
3435  def R = makeLetterplaceRing(4);
3436  setring R;
3437
3438  ideal G = x(1)*y(2); // optional
3439
3440  poly f = 3*x(1)*x(2)+y(1)*x(2);
3441  ideal s1 = x(1), y(1);
3442  ideal s2 = y(1)*z(2)*z(3), x(1);
3443
3444  // the substitution probably needs a higher degbound
3445  int minDegBound = calcSubstDegBounds(f,s1,s2);
3446  setring r;
3447  def R1 = makeLetterplaceRing(minDegBound);
3448  setring R1;
3449
3450  // the last parameter is optional
3451  lpSubstitute(imap(R,f), imap(R,s1), imap(R,s2), imap(R,G));
3452}
3453example {
3454  LIB "fpadim.lib";
3455  ring r = 0,(x,y,z),dp;
3456  def R = makeLetterplaceRing(4);
3457  setring R;
3458
3459  poly f = 3*x(1)*x(2)+y(1)*x(2);
3460  poly g = z(1)*x(2)+y(1);
3461  poly h = 7*x(1)*z(2)+x(1);
3462  ideal I = f,g,h;
3463  ideal s1 = x(1), y(1);
3464  ideal s2 = y(1)*z(2)*z(3), x(1);
3465
3466  int minDegBound = calcSubstDegBounds(I,s1,s2);
3467  setring r;
3468  def R1 = makeLetterplaceRing(minDegBound);
3469  setring R1;
3470
3471  ideal I = imap(R,I);
3472  ideal s1 = imap(R,s1);
3473  ideal s2 = imap(R,s2);
3474  for (int i = 1; i <= size(I); i++) {
3475    lpSubstitute(I[i], s1, s2);
3476  }
3477}
3478
3479static proc lpIndexOf(ideal I, poly p) {
3480  for (int i = 1; i <= size(I); i++) {
3481    if (I[i] == p) {
3482      return (i);
3483    }
3484  }
3485  return (-1);
3486}
3487
3488static proc ivIndexOf(list L, intvec iv) {
3489  for (int i = 1; i <= size(L); i++) {
3490    if (L[i] == iv) {
3491      return (i);
3492    }
3493  }
3494  return (-1);
3495}
3496
3497
3498proc calcSubstDegBound(poly f, ideal s1, ideal s2)
3499"USAGE: calcSubstDegBound(f,s1,s2); f letterplace polynomial, s1 list (ideal) of variables
3500@*      to replace, s2 list (ideal) of polynomials to replace with
3501RETURN: int, the min degbound required to perform the substitution
3502ASSUME: - basering is a Letterplace ring
3503EXAMPLE: example lpSubstitute; shows examples
3504"
3505{
3506  int maxDegBound = 0;
3507  for (int i = 1; i <= size(f); i++) {
3508    intvec ivfi = lp2iv(f[i]);
3509    int tmpDegBound;
3510    for (int j = 1; j <= size(ivfi); j++) {
3511      int varindex = ivfi[j];
3512      int subindex = lpIndexOf(s1, var(varindex));
3513      if (subindex > 0) {
3514        tmpDegBound = tmpDegBound + deg(s2[subindex]);
3515      } else {
3516        tmpDegBound = tmpDegBound + 1;
3517      }
3518    }
3519    if (tmpDegBound > maxDegBound) {
3520      maxDegBound = tmpDegBound;
3521    }
3522  }
3523
3524  // increase degbound by 50% when ideal is provided
3525  // needed for lpNF
3526  maxDegBound = maxDegBound + maxDegBound/2;
3527
3528  return (maxDegBound);
3529}
3530
3531// convenience method
3532proc calcSubstDegBounds(ideal I, ideal s1, ideal s2)
3533"USAGE: calcSubstDegBounds(I,s1,s2); I list (ideal) of letterplace polynomials, s1 list (ideal)
3534@*      of variables to replace, s2 list (ideal) of polynomials to replace with
3535RETURN: int, the min degbound required to perform all of the substitutions
3536ASSUME: - basering is a Letterplace ring
3537EXAMPLE: example lpSubstitute; shows examples
3538"
3539{
3540  int maxDegBound = 0;
3541  for (int i = 1; i <= size(I); i++) {
3542    int tmpDegBound = calcSubstDegBound(I[i], s1, s2, #);
3543    if (tmpDegBound > maxDegBound) {
3544      maxDegBound = tmpDegBound;
3545    }
3546  }
3547  return (maxDegBound);
3548}
3549
3550
3551/*
3552   Here are some examples one may try. Just copy them into your console.
3553   These are relations for braid groups, up to degree d:
3554
3555
3556   LIB "fpadim.lib";
3557   ring r = 0,(x,y,z),dp;
3558   int d =10; // degree
3559   def R = makeLetterplaceRing(d);
3560   setring R;
3561   ideal I = y(1)*x(2)*y(3) - z(1)*y(2)*z(3), x(1)*y(2)*x(3) - z(1)*x(2)*y(3),
3562   z(1)*x(2)*z(3) - y(1)*z(2)*x(3), x(1)*x(2)*x(3) + y(1)*y(2)*y(3) +
3563   z(1)*z(2)*z(3) + x(1)*y(2)*z(3);
3564   option(prot);
3565   option(redSB);option(redTail);option(mem);
3566   ideal J = system("freegb",I,d,3);
3567   lpDimCheck(J);
3568   sickle(J,1,1,1,d);//Computes mistletoes, K-dimension and the Hilbert series
3569
3570
3571
3572   LIB "fpadim.lib";
3573   ring r = 0,(x,y,z),dp;
3574   int d =11; // degree
3575   def R = makeLetterplaceRing(d);
3576   setring R;
3577   ideal I = y(1)*x(2)*y(3) - z(1)*y(2)*z(3), x(1)*y(2)*z(3) - z(1)*x(2)*y(3),
3578   z(1)*x(2)*z(3) - y(1)*z(2)*x(3), x(1)*x(2)*x(3) + y(1)*y(2)*y(3) +
3579   z(1)*z(2)*z(3) + x(1)*y(2)*z(3);
3580   option(prot);
3581   option(redSB);option(redTail);option(mem);
3582   ideal J = system("freegb",I,d,3);
3583   lpDimCheck(J);
3584   sickle(J,1,1,1,d);
3585
3586
3587
3588   LIB "fpadim.lib";
3589   ring r = 0,(x,y,z),dp;
3590   int d  = 6; // degree
3591   def R  = makeLetterplaceRing(d);
3592   setring R;
3593   ideal I = y(1)*x(2)*y(3) - z(1)*y(2)*z(3), x(1)*y(2)*x(3) - z(1)*x(2)*y(3),
3594   z(1)*x(2)*z(3) - y(1)*z(2)*x(3), x(1)*x(2)*x(3) -2*y(1)*y(2)*y(3) + 3*z(1)*z(2)*z(3) -4*x(1)*y(2)*z(3) + 5*x(1)*z(2)*z(3)- 6*x(1)*y(2)*y(3) +7*x(1)*x(2)*z(3) - 8*x(1)*x(2)*y(3);
3595   option(prot);
3596   option(redSB);option(redTail);option(mem);
3597   ideal J = system("freegb",I,d,3);
3598   lpDimCheck(J);
3599   sickle(J,1,1,1,d);
3600 */
3601
3602/*
3603   Here are some examples, which can also be found in [studzins]:
3604
3605// takes up to 880Mb of memory
3606LIB "fpadim.lib";
3607ring r = 0,(x,y,z),dp;
3608int d =10; // degree
3609def R = makeLetterplaceRing(d);
3610setring R;
3611ideal I =
3612z(1)*z(2)*z(3)*z(4) + y(1)*x(2)*y(3)*x(4) - x(1)*y(2)*y(3)*x(4) - 3*z(1)*y(2)*x(3)*z(4), x(1)*x(2)*x(3) + y(1)*x(2)*y(3) - x(1)*y(2)*x(3), z(1)*y(2)*x(3)-x(1)*y(2)*z(3) + z(1)*x(2)*z(3);
3613option(prot);
3614option(redSB);option(redTail);option(mem);
3615ideal J = system("freegb",I,d,nvars(r));
3616lpDimCheck(J);
3617sickle(J,1,1,1,d); // dimension is 24872
3618
3619
3620LIB "fpadim.lib";
3621ring r = 0,(x,y,z),dp;
3622int d =10; // degree
3623def R = makeLetterplaceRing(d);
3624setring R;
3625ideal I = x(1)*y(2) + y(1)*z(2), x(1)*x(2) + x(1)*y(2) - y(1)*x(2) - y(1)*y(2);
3626option(prot);
3627option(redSB);option(redTail);option(mem);
3628ideal J = system("freegb",I,d,3);
3629lpDimCheck(J);
3630sickle(J,1,1,1,d);
3631 */
3632
3633
3634/*
3635   Example for computing GK dimension:
3636   returns a ring which contains an ideal I
3637   run gkDim(I) inside this ring and it should return 2n (the GK dimension
3638   of n-th Weyl algebra including evaluation operators).
3639
3640   proc createWeylEx(int n, int d)
3641   "
3642   "
3643   {
3644   int baseringdef;
3645   if (defined(basering)) // if a basering is defined, it should be saved for later use
3646   {
3647   def save = basering;
3648   baseringdef = 1;
3649   }
3650   ring r = 0,(d(1..n),x(1..n),e(1..n)),dp;
3651   def R = makeLetterplaceRing(d);
3652   setring R;
3653   ideal I; int i,j;
3654
3655   for (i = 1; i <= n; i++)
3656   {
3657   for (j = i+1; j<= n; j++)
3658   {
3659   I[size(I)+1] = lpMult(var(i),var(j));
3660   }
3661   }
3662
3663   for (i = 1; i <= n; i++)
3664   {
3665   for (j = i+1; j<= n; j++)
3666   {
3667   I[size(I)+1] = lpMult(var(n+i),var(n+j));
3668   }
3669   }
3670   for (i = 1; i <= n; i++)
3671   {
3672   for (j = 1; j<= n; j++)
3673   {
3674   I[size(I)+1] = lpMult(var(i),var(n+j));
3675   }
3676   }
3677   for (i = 1; i <= n; i++)
3678   {
3679   for (j = 1; j<= n; j++)
3680   {
3681   I[size(I)+1] = lpMult(var(i),var(2*n+j));
3682   }
3683   }
3684   for (i = 1; i <= n; i++)
3685   {
3686   for (j = 1; j<= n; j++)
3687   {
3688   I[size(I)+1] = lpMult(var(2*n+i),var(n+j));
3689   }
3690   }
3691   for (i = 1; i <= n; i++)
3692   {
3693   for (j = 1; j<= n; j++)
3694   {
3695   I[size(I)+1] = lpMult(var(2*n+i),var(2*n+j));
3696   }
3697   }
3698   I = simplify(I,2+4);
3699   I = letplaceGBasis(I);
3700   export(I);
3701   if (baseringdef == 1) {setring save;}
3702   return(R);
3703   }
3704
3705proc TestGKAuslander3()
3706{
3707  ring r = (0,q),(z,x,y),(dp(1),dp(2));
3708  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
3709  R; setring R; // sets basering to Letterplace ring
3710  ideal I;
3711  I = q*x(1)*y(2) - y(1)*x(2), z(1)*y(2) - y(1)*z(2), z(1)*x(2) - x(1)*z(2);
3712  I = letplaceGBasis(I);
3713  lpGkDim(I); // must be 3
3714  I = x(1)*y(2)*z(3) - y(1)*x(2), z(1)*y(2) - y(1)*z(2), z(1)*x(2) - x(1)*z(2);//gkDim = 2
3715  I = letplaceGBasis(I); // not finite BUT contains a poly in x,y only
3716  lpGkDim(I); // must be 4
3717
3718  ring r = 0,(y,x,z),dp;
3719  def R = makeLetterplaceRing(10); // constructs a Letterplace ring
3720  R; setring R; // sets basering to Letterplace ring
3721  ideal I;
3722  I = x(1)*y(2)*z(3) - y(1)*x(2), z(1)*y(2) - y(1)*z(2), z(1)*x(2) - x(1)*z(2);//gkDim = 2
3723  I = letplaceGBasis(I); // computed as it would be homogenized; infinite
3724  poly p = x(1)*y(2)*y(3)*x(4)-y(1)*x(2)*x(3)*y(4);
3725  lpNF(p, I); // 0 as expected
3726
3727  // with inverse of z
3728  ring r = 0,(iz,z,x,y),dp;
3729  def R = makeLetterplaceRing(11); // constructs a Letterplace ring
3730  R; setring R; // sets basering to Letterplace ring
3731  ideal I;
3732  I = x(1)*y(2)*z(3) - y(1)*x(2), z(1)*y(2) - y(1)*z(2), z(1)*x(2) - x(1)*z(2),
3733    iz(1)*y(2) - y(1)*iz(2), iz(1)*x(2) - x(1)*iz(2), iz(1)*z(2)-1, z(1)*iz(2) -1;
3734  I = letplaceGBasis(I); //
3735  setring r;
3736  def R2 = makeLetterplaceRing(23); // constructs a Letterplace ring
3737  setring R2; // sets basering to Letterplace ring
3738  ideal I = imap(R,I);
3739  lpGkDim(I);
3740
3741
3742  ring r = 0,(t,z,x,y),(dp(2),dp(2));
3743  def R = makeLetterplaceRing(20); // constructs a Letterplace ring
3744  R; setring R; // sets basering to Letterplace ring
3745  ideal I;
3746  I = x(1)*y(2)*z(3) - y(1)*x(2)*t(3), z(1)*y(2) - y(1)*z(2), z(1)*x(2) - x(1)*z(2),
3747    t(1)*y(2) - y(1)*t(2), t(1)*x(2) - x(1)*t(2), t(1)*z(2) - z(1)*t(2);//gkDim = 2
3748  I = letplaceGBasis(I); // computed as it would be homogenized; infinite
3749  LIB "elim.lib";
3750  ideal Inoz = nselect(I,intvec(2,6,10,14,18,22,26,30));
3751  for(int i=1; i<=20; i++)
3752  {
3753    Inoz=subst(Inoz,t(i),1);
3754  }
3755  ideal J = x(1)*y(2)*y(3)*x(4)-y(1)*x(2)*x(3)*y(4);
3756  J = letplaceGBasis(J);
3757
3758  poly p = x(1)*y(2)*y(3)*x(4)-y(1)*x(2)*x(3)*y(4);
3759  lpNF(p, I); // 0 as expected
3760
3761  ring r2 = 0,(x,y),dp;
3762  def R2 = makeLetterplaceRing(50); // constructs a Letterplace ring
3763  setring R2;
3764  ideal J = x(1)*y(2)*y(3)*x(4)-y(1)*x(2)*x(3)*y(4);
3765  J = letplaceGBasis(J);
3766}
3767
3768*/
3769
3770
3771/*   actual work:
3772// downup algebra A
3773LIB "fpadim.lib";
3774ring r = (0,a,b,g),(x,y),Dp;
3775def R = makeLetterplaceRing(6); // constructs a Letterplace ring
3776setring R;
3777poly F1 = g*x(1);
3778poly F2 = g*y(1);
3779ideal J = x(1)*x(2)*y(3)-a*x(1)*y(2)*x(3) - b*y(1)*x(2)*x(3) - F1,
3780x(1)*y(2)*y(3)-a*y(1)*x(2)*y(3) - b*y(1)*y(2)*x(3) - F2;
3781J = letplaceGBasis(J);
3782lpGkDim(J); // 3 == correct
3783
3784// downup algebra B
3785LIB "fpadim.lib";
3786ring r = (0,a,b,g, p(1..7),q(1..7)),(x,y),Dp;
3787def R = makeLetterplaceRing(6); // constructs a Letterplace ring
3788setring R;
3789ideal imn = 1, y(1)*y(2)*y(3), x(1)*y(2), y(1)*x(2), x(1)*x(2), y(1)*y(2), x(1), y(1);
3790int i;
3791poly F1, F2;
3792for(i=1;i<=7;i++)
3793{
3794F1 = F1 + p(i)*imn[i];
3795F2 = F2 + q(i)*imn[i];
3796}
3797ideal J = x(1)*x(2)*y(3)-a*x(1)*y(2)*x(3) - b*y(1)*x(2)*x(3) - F1,
3798x(1)*y(2)*y(3)-a*y(1)*x(2)*y(3) - b*y(1)*y(2)*x(3) - F2;
3799J = letplaceGBasis(J);
3800lpGkDim(J); // 3 == correct
3801
3802 */
Note: See TracBrowser for help on using the repository browser.