source: git/Singular/LIB/fpadim.lib @ 927cae

spielwiese
Last change on this file since 927cae was 927cae, checked in by Karim Abou Zeid <karim23697@…>, 6 years ago
Fix issues with 0-ring
  • Property mode set to 100644
File size: 113.0 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
1177    if (leadmonom(G[i]) == 1) {
1178      ERROR("noetherianity not defined for 0-ring")
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  // check special case 1
1312  int l = 0;
1313  for (int i = 1; i <= size(G); i++) {
1314    // find the max degree in G
1315    int d = deg(G[i]);
1316    if (d > l) {
1317      l = d;
1318    }
1319
1320    // also if G is the whole ring
1321    if (leadmonom(G[i]) == 1) {
1322      ERROR("primeness not defined for 0-ring")
1323    }
1324  }
1325  // if longest word has length 1 we handle it as a special case
1326  if (l == 1) {
1327    return(1);
1328  }
1329
1330  list VUG = lpUfGraph(G, 1);
1331  intmat UG = VUG[1]; // the Ufnarovskij graph
1332  ideal V = VUG[2]; // the vertices of UG (standard words with length = l-1)
1333
1334  list LG = lpId2ivLi(G);
1335  list SW = ivStandardWordsUpToLength(LG, maxDeg(G));
1336  list LV = lpId2ivLi(V);
1337
1338  // delete the 0 in SW
1339  int indexofzero = ivIndexOf(SW, 0);
1340  if (indexofzero > 0) { // should be always true when |SW| > 0
1341    SW = delete(SW, indexofzero);
1342  }
1343
1344  // check if each monomial in SW is cyclic
1345  for (int i = 1; i <= size(SW); i++) {
1346    if (!isCyclicInUfGraph(UG, LV, SW[i])) {
1347      return (0);
1348    }
1349  }
1350
1351  return (1);
1352}
1353
1354// checks whether a monomial is a cyclic monomial
1355proc isCyclicInUfGraph(intmat UG, list LV, intvec u)
1356{
1357  if (ncols(UG) == 0) {return (0);} // UG is empty
1358  if (u == 0) {return (0);} // 0 is never cyclic
1359
1360  int l = size(LV[1]) + 1;
1361
1362  int s = size(u);
1363  if (s <= l - 1) {
1364    for (int i = 1; i <= size(LV); i++) {
1365      // for all vertices where u is a suffix
1366      if(isSF(u, LV[i])) {
1367        if (existsRoute(UG, i, i)) {
1368          return (1);
1369        }
1370      }
1371    }
1372  } else { // size(u) > l - 1
1373    int m = s - l + 1;
1374
1375    // there must be a route from v0 to vm
1376    intvec v0 = u[1..(l-1)]; // first in route of u
1377    intvec vm = u[m+1..m+(l-1)]; // last in route of u
1378
1379    int iv0 = ivIndexOf(LV, v0);
1380    int ivm = ivIndexOf(LV, vm);
1381    if (iv0 <= 0 || ivm <= 0) {
1382      ERROR("u is not a standard word");
1383    }
1384
1385    return (existsRoute(UG, ivm, iv0));
1386  }
1387
1388  return (0);
1389}
1390
1391proc lpIsPrime(ideal G)
1392"USAGE: lpIsPrime(G); G an ideal in a Letterplace ring
1393RETURN: boolean
1394PURPOSE: Check whether R/<G> is prime, where R is the basering
1395ASSUME: - basering is a Letterplace ring
1396@*      - G is a Groebner basis
1397"
1398{
1399  G = lead(G);
1400  G = simplify(G, 2+4+8);
1401
1402  // check special case 1
1403  int l = 0;
1404  for (int i = 1; i <= size(G); i++) {
1405    // find the max degree in G
1406    int d = deg(G[i]);
1407    if (d > l) {
1408      l = d;
1409    }
1410
1411    // also if G is the whole ring
1412    if (leadmonom(G[i]) == 1) {
1413      ERROR("primeness not defined for 0-ring")
1414    }
1415  }
1416  // if longest word has length 1 we handle it as a special case
1417  if (l == 1) {
1418    return(1);
1419  }
1420
1421  list VUG = lpUfGraph(G, 1);
1422  intmat UG = VUG[1]; // the Ufnarovskij graph
1423  ideal V = VUG[2]; // the vertices of UG (standard words with length = l-1)
1424
1425  list LG = lpId2ivLi(G);
1426  list LV = lpId2ivLi(V);
1427
1428  int n = ncols(UG);
1429
1430  // 1) for each vi vj there exists a route from vi to vj (means UG is connected)
1431  for (int i = 1; i <= n; i++) {
1432    for (int j = 1; j <= n; j++) {
1433      if (!existsRoute(UG, i, j)) {
1434        return (0);
1435      }
1436    }
1437  }
1438
1439  // 2) any standard word with length < l-1 is a suffix of a vertex
1440  list SW = ivStandardWordsUpToLength(LG, maxDeg(G) - 2); // < maxDeg - 1
1441  if (size(SW) > 0 && size(LV) == 0) {return (0);}
1442  for (int i = 1; i <= size(SW); i++) {
1443    // check if SW[i] is a suffix of some LV
1444    for (int j = 1; j <= size(LV); j++) {
1445      if (!isSF(SW[i], LV[j])) {
1446        if (j == size(LV)) {
1447          return (0);
1448        }
1449      } else {
1450        break;
1451      }
1452    }
1453  }
1454
1455  return (1);
1456}
1457example {
1458  "EXAMPLE:"; echo = 2;
1459  ring r = 0,(x,y),dp;
1460  def R = makeLetterplaceRing(5);
1461  setring R;
1462  ideal G = x(1)*x(2), y(1)*y(2); // K<x,y>/<xx,yy> is prime
1463  lpIsPrime(G);
1464}
1465
1466static proc existsRoute(intmat G, int v, int u, list #)
1467"USAGE: existsRoute(G,v,u); G a graph, v and u vertices
1468NOTE: don't pass anything to # (internal use for recursion)
1469@*    routes always have at least one edge
1470"
1471{
1472  int n = ncols(G);
1473
1474  // init visited
1475  intvec visited;
1476  if (size(#) > 0) {
1477    if (v == u) {return (1);} // don't check on first call so |route| >= 1 holds
1478    visited = #[1];
1479  } else { // first call
1480    visited[n] = 0;
1481  }
1482
1483  // mark current vertex as visited
1484  visited[v] = 1;
1485
1486  // recursive DFS
1487  for (int i = 1; i <= n; i++) {
1488    if (G[v,i] && (!visited[i] || i == u)) { // i == u to allow routes from u to u
1489      if (existsRoute(G, i, u, visited)) {
1490        return (1);
1491      }
1492    }
1493  }
1494
1495  return (0);
1496}
1497
1498static proc lpUfGkDim(ideal G)
1499{
1500  G = lead(G);
1501  G = simplify(G, 2+4+8);
1502
1503  // check special case 1
1504  int l = 0;
1505  for (int i = 1; i <= size(G); i++) {
1506    // find the max degree in G
1507    int d = deg(G[i]);
1508    if (d > l) {
1509      l = d;
1510    }
1511
1512    // also if G is the whole ring return minus infinity
1513    if (leadmonom(G[i]) == 1) {
1514      ERROR("Gk-Dim not defined for 0-ring")
1515    }
1516  }
1517  // if longest word has length 1 we handle it as a special case
1518  if (l == 1) {
1519    int n = attrib(basering, "lV"); // variable count
1520    int k = size(G);
1521    if (k == n) { // V = {1} no edges
1522      return(0);
1523    }
1524    if (k == n-1) { // V = {1} with loop
1525      return(1);
1526    }
1527    if (k <= n-2) { // V = {1} with more than one loop
1528      return(-1);
1529    }
1530  }
1531
1532  int t = rtimer; // DEBUG
1533  intmat UG = lpUfGraph(G);
1534  printf("lpUfGraph took %p", rtimer - t); // DEBUG
1535
1536  // check special case 2
1537  intmat zero[nrows(UG)][ncols(UG)];
1538  if (UG == zero) {
1539    return (0);
1540  }
1541
1542  // check special case 3
1543  UG = topologicalSort(UG);
1544
1545  if (imIsUpRightTriangle(UG)) {
1546    UG = eliminateZerosUpTriangle(UG);
1547    if (ncols(UG) == 0 || nrows(UG) == 0) { // when the diagonal was zero
1548      return (0)
1549    }
1550    return(UfGraphURTNZDGrowth(UG));
1551  }
1552
1553  // otherwise count cycles in the Ufnarovskij Graph
1554  int t = rtimer; // DEBUG
1555  int gkdim = UfGraphGrowth(UG);
1556  printf("UfGraphGrowth took %p", rtimer - t); // DEBUG
1557  return(gkdim);
1558}
1559
1560static proc UfGraphURTNZDGrowth(intmat UG) {
1561  // URTNZD = upper right triangle non zero diagonal
1562  for (int i = 1; i <= ncols(UG); i++) {
1563    UG[i,i] = 0; // remove all loops
1564  }
1565  intmat UGk = UG;
1566  intmat zero[nrows(UGk)][ncols(UGk)];
1567  int k = 1;
1568  while (UGk != zero) {
1569    UGk = UGk * UG;
1570    k++;
1571  }
1572  return (k);
1573}
1574
1575proc imIsUpRightTriangle(intmat M) {
1576  for (int i = 1; i <= nrows(M); i++) {
1577    for (int j = 1; j < i; j++) {
1578      if(M[i,j] != 0) { return (0); }
1579    }
1580  }
1581  return (1);
1582}
1583
1584static proc eliminateZerosUpTriangle(intmat G) {
1585  // G is expected to be an upper triangle matrix
1586  for (int i = ncols(G); i >= 1; i--) { // loop order is important because we delete entries
1587    if (G[i,i] == 0) { // i doesn't have a cycle
1588      for (int j = 1; j < i; j++) {
1589        if (G[j,i] == 1) { // j has an edge to i
1590          for (int k = i + 1; k <= nrows(G); k++) {
1591            if (G[i,k] == 1) {
1592              G[j,k] = G[i,k]; // give j all edges from i
1593            }
1594          }
1595        }
1596      }
1597      G = imDelRowCol(G,i,i); // remove vertex i
1598    }
1599  }
1600  return (G);
1601}
1602
1603static proc imDelRowCol(intmat M, int row, int col) {
1604  // row and col are expected to be > 0
1605  int nr = nrows(M);
1606  int nc = ncols(M);
1607  intmat Mdel[nr - 1][nc - 1];
1608  for (int i = 1; i <= nr; i++) {
1609    for (int j = 1; j <= nc; j++) {
1610      if(i != row && j != col) {
1611        int newi = i;
1612        int newj = j;
1613        if (i > row) { newi = i - 1; }
1614        if (j > col) { newj = j - 1; }
1615        Mdel[newi,newj] = M[i,j];
1616      }
1617    }
1618  }
1619  return (Mdel);
1620}
1621
1622static proc topologicalSort(intmat G) {
1623  // NOTE: ignores loops
1624  // NOTE: this takes O(|V^3|), can be optimized
1625  int n = ncols(G);
1626  for (int i = 1; i <= n; i++) { // only use the submat at i
1627    // find a vertex v in the submat at i with no incoming edges
1628    int v;
1629    for (int j = i; j <= n; j++) {
1630      int incoming = 0;
1631      for (int k = i; k <= n; k++) {
1632        if (k != j && G[k,j] == 1) {
1633          incoming = 1;
1634        }
1635      }
1636      if (incoming == 0) {
1637        v = j;
1638        break;
1639      } else {
1640        if (j == n) {
1641          // G contains at least one cycle, abort
1642          return (G);
1643        }
1644      }
1645    }
1646
1647    // swap v and i
1648    if (v != i) {
1649      G = imPermcol(G, v, i);
1650      G = imPermrow(G, v, i);
1651    }
1652  }
1653  return (G);
1654}
1655
1656static proc imPermcol (intmat A, int c1, int c2)
1657{
1658  intmat B = A;
1659  int k = nrows(B);
1660  B[1..k,c1] = A[1..k,c2];
1661  B[1..k,c2] = A[1..k,c1];
1662  return (B);
1663}
1664
1665static proc imPermrow (intmat A, int r1, int r2)
1666{
1667  intmat B = A;
1668  int k = ncols(B);
1669  B[r1,1..k] = A[r2,1..k];
1670  B[r2,1..k] = A[r1,1..k];
1671  return (B);
1672}
1673
1674static proc UfGraphGrowth(intmat UG)
1675{
1676  int n = ncols(UG); // number of vertices
1677  // iterate through all vertices
1678
1679  intvec visited;
1680  visited[n] = 0;
1681
1682  intvec cyclic;
1683  cyclic[n] = 0;
1684
1685  int maxCycleCount = 0;
1686  for (int v = 1; v <= n; v++) {
1687    int cycleCount = countCycles(UG, v, visited, cyclic, 0);
1688    if (cycleCount == -1) {
1689      return(-1);
1690    }
1691    if (cycleCount > maxCycleCount) {
1692      maxCycleCount = cycleCount;
1693    }
1694  }
1695  return(maxCycleCount);
1696}
1697
1698static proc countCycles(intmat G, int v, intvec visited, intvec cyclic, intvec path)
1699"USAGE: countCycles(G, v, visited, cyclic, path); G a Graph, v the vertex to
1700start. The parameter visited, cyclic and path should be 0.
1701RETURN: int
1702@*:     Maximal number of distinct cycles
1703PURPOSE: Calculate the maximal number of distinct cycles in a single path starting at v
1704ASSUME: Basering is a Letterplace ring
1705"
1706{
1707  // Mark the current vertex as visited
1708  visited[v] = 1;
1709
1710  // Store the current vertex in path
1711  if (path[1] == 0) {
1712    path[1] = v;
1713  } else {
1714    path[size(path) + 1] = v;
1715  }
1716
1717  int cycles = 0;
1718  for (int w = 1; w <= ncols(G); w++) {
1719    if (G[v,w] == 1) {
1720      if (visited[w] == 1) { // neuer zykel gefunden
1721        // 1. alle Knoten in path bis w ÃŒberprÃŒfen ob in cyclic
1722        for (int j = size(path); j >= 1; j--) {
1723          if(cyclic[path[j]] == 1) {
1724            // 1.1 falls ja return -1
1725            return (-1);
1726          }
1727          if (path[j] == w) {
1728            break;
1729          }
1730        }
1731
1732        // 2. ansonsten cycles++
1733        for (int j = size(path); j >= 1; j--) {
1734          // 2.2 Kanten in diesem Zykel entfernen; Knoten cyclic
1735          if (j == size(path)) { // Sonderfall bei der ersten Iteration
1736            cyclic[v] = 1;
1737            G[v, w] = 0;
1738          } else {
1739            cyclic[path[j]] = 1;
1740            G[path[j], path[j+1]] = 0;
1741          }
1742          if (path[j] == w) {
1743            break;
1744          }
1745        }
1746
1747        // 3. auf jedem dieser Knoten countCycles() aufrufen
1748        int maxCycleCount = 0;
1749        for (int j = size(path); j >= 1; j--) {
1750          int cycleCount = countCycles(G, path[j], visited, cyclic, path);
1751          if(cycleCount == -1) {
1752            return (-1);
1753          }
1754          if (cycleCount > maxCycleCount) {
1755            maxCycleCount = cycleCount;
1756          }
1757          if (path[j] == w) {
1758            break;
1759          }
1760        }
1761        if (maxCycleCount >= cycles) {
1762          cycles = maxCycleCount + 1;
1763        }
1764      } else {
1765        int cycleCount = countCycles(G, w, visited, cyclic, path);
1766        if (cycleCount == -1) {
1767          return(-1);
1768        }
1769        if (cycleCount > cycles) {
1770          cycles = cycleCount;
1771        }
1772      }
1773    }
1774  }
1775  // printf("Path: %s countCycles: %s", path, cycles); // DEBUG
1776  return(cycles);
1777}
1778
1779static proc lpUfGraph(ideal G, list #)
1780"USAGE: lpUfGraph(G); G a set of monomials in a letterplace ring, # an optional parameter to return the vertex list when set
1781RETURN: intmat
1782PURPOSE: Constructs the Ufnarovskij graph induced by G
1783@*      the adjacency matrix of the Ufnarovskij graph induced by G
1784ASSUME: - basering is a Letterplace ring
1785@*      - G are the leading monomials of a Groebner basis
1786"
1787{
1788  int l = maxDeg(G);
1789  list LG = lpId2ivLi(G);
1790  list SW = ivStandardWords(LG, l - 1); // vertices
1791  int n = size(SW);
1792  intmat UG[n][n]; // Ufnarovskij graph
1793  for (int i = 1; i <= n; i++) {
1794    for (int j = 1; j <= n; j++) {
1795      // [Studzinski page 76]
1796      intvec v = SW[i];
1797      intvec w = SW[j];
1798      intvec v_overlap;
1799      intvec w_overlap;
1800      //TODO how should the graph look like when l - 1 = 0 ?
1801      if (l - 1 == 0) {
1802        ERROR("Ufnarovskij graph not implemented for l = 1");
1803      }
1804      if (l - 1 > 1) {
1805        v_overlap = v[2 .. l-1];
1806        w_overlap = w[1 .. l-2];
1807      }
1808      intvec vw = v;
1809      vw[l] = w[l-1];
1810      if (v_overlap == w_overlap && !ivdivides(LG, vw)) {
1811        UG[i,j] = 1;
1812      }
1813    }
1814  }
1815  if (size(#) > 0) {
1816    if (typeof(#[1]) == "int") {
1817      if (#[1] == 1) {
1818        list ret = UG;
1819        ret[2] = ivL2lpI(SW); // the vertices
1820        return (ret);
1821      }
1822    }
1823  }
1824  return (UG);
1825}
1826
1827static proc maxDeg(ideal G)
1828{
1829  int l = 0;
1830  for (int i = 1; i <= size(G); i++) { // find the max degree in G
1831    int d = deg(G[i]);
1832    if (d > l) {
1833      l = d;
1834    }
1835  }
1836  return (l);
1837}
1838
1839static proc ivStandardWords(list G, int length)
1840"ASSUME: G is simplified
1841"
1842{
1843  if (length <= 0) {
1844    list words;
1845    if (length == 0 && !ivdivides(G,0)) {
1846      words[1] = 0; // iv = 0 means monom = 1
1847    }
1848    return (words); // no standard words
1849  }
1850  int lV = attrib(basering, "lV"); // variable count
1851  list prevWords = ivStandardWords(G, length - 1);
1852  list words;
1853  for (int i = 1; i <= lV; i++) {
1854    for (int j = 1; j <= size(prevWords); j++) {
1855      intvec word = prevWords[j];
1856      word[length] = i;
1857      // assumes that G is simplified!
1858      if (!ivdivides(G, word)) {
1859        words = insert(words, word);
1860      }
1861    }
1862  }
1863  return (words);
1864}
1865
1866static proc ivStandardWordsUpToLength(list G, int length)
1867"ASSUME: G is simplified
1868"
1869{
1870  list words = ivStandardWords(G,0);
1871  if (size(words) == 0) {return (words)}
1872  for (int i = 1; i <= length; i++) {
1873    words = words + ivStandardWords(G, i);
1874  }
1875  return (words);
1876}
1877
1878static proc ivdivides(list G, intvec iv) {
1879  for (int k = 1; k <= size(G); k++) {
1880    if (isIF(G[k], iv)) {
1881      return (1);
1882    } else {
1883      if (k == size(G)) {
1884        return (0);
1885      }
1886    }
1887  }
1888}
1889
1890static proc lpGraphOfNormalWords(ideal G)
1891"USAGE: lpGraphOfNormalWords(G); G a set of monomials in a letterplace ring
1892RETURN: intmat
1893PURPOSE: Constructs the graph of normal words induced by G
1894@*:      the adjacency matrix of the graph of normal words induced by G
1895ASSUME: - basering is a Letterplace ring
1896- G are the leading monomials of a Groebner basis
1897"
1898{
1899  // construct the Graph of normal words [Studzinski page 78]
1900  // construct set of vertices
1901  int v = attrib(basering,"lV"); int d = attrib(basering,"uptodeg");
1902  ideal V; poly p,q,w;
1903  ideal LG = lead(G);
1904  int i,j,k,b; intvec E,Et;
1905  for (i = 1; i <= v; i++){V = V, var(i);}
1906  for (i = 1; i <= size(LG); i++)
1907  {
1908    E = leadexp(LG[i]);
1909    if (E == intvec(0)) {V = V,monomial(intvec(0));}
1910    else
1911    {
1912      for (j = 1; j < d; j++)
1913      {
1914        Et = E[(j*v+1)..(d*v)];
1915        if (Et == intvec(0)) {break;}
1916        else {V = V, monomial(Et);}
1917      }
1918    }
1919  }
1920  V = simplify(V,2+4);
1921  printf("V = %p", V);
1922
1923
1924  // construct incidence matrix
1925
1926  list LV = lpId2ivLi(V);
1927  intvec Ip,Iw;
1928  int n = size(V);
1929  intmat T[n+1][n];
1930  for (i = 1; i <= n; i++)
1931  {
1932    // printf("for1 (i=%p, n=%p)", i, n);
1933    p = V[i]; Ip = lp2iv(p);
1934    for (j = 1; j <= n; j++)
1935    {
1936      // printf("for2 (j=%p, n=%p)", j, n);
1937      k = 1; b = 1;
1938      q = V[j];
1939      w = lpNF(lpMult(p,q),LG);
1940      if (w <> 0)
1941      {
1942        Iw = lp2iv(w);
1943        while (k <= n)
1944        {
1945          // printf("while (k=%p, n=%p)", k, n);
1946          if (isPF(LV[k],Iw) > 0)
1947          {if (isPF(LV[k],Ip) == 0) {b = 0; k = n+1;} else {k++;}
1948          }
1949          else {k++;}
1950        }
1951        T[i,j] = b;
1952        //  print("Incidence Matrix:");
1953        // print(T);
1954      }
1955    }
1956  }
1957  return(T);
1958}
1959
1960static proc lpNorGkDim(ideal G)
1961"USAGE: lpNorGkDim(G); G an ideal in a letterplace ring
1962RETURN: int
1963PURPOSE: Determines the Gelfand Kirillov dimension of A/<G>
1964@*:     -1 means it is infinite
1965ASSUME: - basering is a Letterplace ring
1966- G is a Groebner basis
1967"
1968{
1969  return(growthAlg(lpGraphOfNormalWords(G)));
1970}
1971
1972proc lpGkDim(ideal G, list#)
1973"USAGE: lpGkDim(G); G an ideal in a letterplace ring, method an
1974@*       optional integer. method = 0 uses the Ufnarovskij Graph
1975@*       and method = 1 uses the Graph of normal words to determine
1976@*       the Gelfand Kirillov dimension
1977RETURN: int
1978PURPOSE: Determines the Gelfand Kirillov dimension of A/<G>
1979@*      -1 means it is positive infinite
1980ASSUME: - basering is a Letterplace ring
1981- G is a Groebner basis
1982"
1983{
1984  int method = 0;
1985  if (size(#) > 0) {
1986    if (typeof(#[1])=="int") {
1987      method = #[1];
1988    }
1989  }
1990
1991  if (method == 0) {
1992    return (lpUfGkDim(G));
1993  } else {
1994    return (lpNorGkDim(G));
1995  }
1996}
1997example
1998{
1999  "EXAMPLE:"; echo = 2;
2000  ring r = 0,(x,y,z),dp;
2001  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2002  R;
2003  setring R; // sets basering to Letterplace ring
2004  ideal I = z(1);//an example of infinite GK dimension
2005  lpGkDim(I);
2006  I = x(1),y(1),z(1); // gkDim = 0
2007  lpGkDim(I);
2008  I = x(1)*y(2), x(1)*z(2), z(1)*y(2), z(1)*z(2);//gkDim = 2
2009  lpGkDim(I);
2010}
2011
2012proc lpGlDimBound(ideal G)
2013"USAGE: lpGlDimBound(I); I an ideal
2014RETURN: int, an upper bound for the global dimension, -1 means infinity
2015PURPOSE: computing an upper bound for the global dimension
2016ASSUME: - basering is a Letterplace ring, G is a reduced Gröbner Basis
2017EXAMPLE: example lpGlDimBound; shows example
2018NOTE: if I = LM(I), then the global dimension is equal the Gelfand
2019@*    Kirillov dimension if it is finite
2020@*    Global dimension should be 0 for A/G = K and 1 for A/G = K<x1...xn>
2021"
2022{
2023  G = simplify(G,2); // remove zero generators
2024  // NOTE: Gl should be 0 for A/G = K and 1 for A/G = K<x1...xn>
2025  // G1 contains generators with single variable in LM
2026  ideal G1;
2027  for (int i = 1; i <= size(G); i++) {
2028    if (ord(G[i]) < 2) { // single variable in LM
2029      G1 = insertGenerator(G1,G[i]);
2030    }
2031  }
2032  G1 = simplify(G1,2); // remove zero generators
2033
2034  // G = NF(G,G1)
2035  for (int i = 1; i <= ncols(G); i++) { // do not use size() here
2036    G[i] = lpNF(G[i],G1);
2037  }
2038  G = simplify(G,2); // remove zero generators
2039
2040  // delete variables in LM(G1) from the ring
2041  def save = basering;
2042  ring R = basering;
2043  if (size(G1) > 0) {
2044    while (size(G1) > 0) {
2045      if (attrib(R, "lV") > 1) {
2046        ring R = lpDelVar(lp2iv(G1[1])[1]);
2047        ideal G1 = imap(save,G1);
2048        G1 = simplify(G1, 2); // remove zero generators
2049      } else {
2050        // only the field is left (no variables)
2051        return(0);
2052      }
2053    }
2054    ideal G = imap(save, G); // put this here, because when save == R this call would make G = 0
2055  }
2056
2057  // Li p. 184 if G = LM(G), then I = LM(I) and thus glDim = gkDim if it's finite
2058  for (int i = 1; i <= size(G); i++) {
2059    if (G[i] != lead(G[i])) {
2060      break;
2061    } else {
2062      if (i == size(G)) { // if last iteration
2063        print("Using gk dim"); // DEBUG
2064        int gkDim = lpGkDim(G);
2065        if (gkDim >= 0) {
2066          return (gkDim);
2067        }
2068      }
2069    }
2070  }
2071
2072  intmat GNC = lpGraphOfNChains(G);
2073
2074  // assuming GNC is connected
2075
2076  // TODO: maybe loop+cycle checking could be done more efficiently?
2077  if (!imHasLoops(GNC) && imIsUpRightTriangle(topologicalSort(GNC))) {
2078    // GNC is a DAG
2079    intmat GNCk = GNC;
2080    intmat zero[1][ncols(GNCk)];
2081    int k = 1;
2082    // while first row isn't empty
2083    while (GNCk[1,1..(ncols(GNCk))] != zero[1,1..(ncols(zero))]) {
2084      GNCk = GNCk * GNC;
2085      k++;
2086    }
2087    // k-1 = number of edges in longest path starting from 1
2088    return (k-1);
2089  } else {
2090    // GNC contains loops/cycles => there is always an n-chain
2091    return (-1); // infinity
2092  }
2093}
2094example
2095{
2096  "EXAMPLE:"; echo = 2;
2097  ring r = 0,(x,y),dp;
2098  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2099  setring R; // sets basering to Letterplace ring
2100  ideal G = x(1)*x(2), y(1)*y(2),x(1)*y(2)*x(3); // ideal G contains a
2101  //Groebner basis
2102  lpGlDimBound(G); // invokes procedure with Groebner basis G
2103}
2104
2105static proc imHasLoops(intmat A) {
2106  int n = ncols(A);
2107  for (int i = 1; i < n; i++) {
2108    if (A[i,i] == 1) {
2109      return (1);
2110    }
2111  }
2112  return (0);
2113}
2114
2115static proc lpGraphOfNChains(ideal G) // G must be reduced
2116{
2117  list LG = lpId2ivLi(lead(G));
2118  int n = attrib(basering, "lV");
2119  int degbound = attrib(basering, "uptodeg");
2120
2121  list V;
2122  for (int i = 0; i <= n; i++) {
2123    V[i+1] = i; // add 1 and all variables
2124  }
2125  for (int i = 1; i <= size(LG); i++) {
2126    intvec u = LG[i];
2127    for (int j = 2; j <= size(u); j++) {
2128      intvec v = u[j..size(u)];
2129      if (!contains(V, v)) {
2130        V = insert(V, v, size(V)); // add subword j..size
2131      }
2132    }
2133  }
2134  int nV = size(V);
2135  intmat GNC[nV][nV]; // graph of n-chains
2136
2137  // for vertex 1
2138  for (int i = 2; i <= n + 1; i++) {
2139    GNC[1,i] = 1; // 1 has an edge to all variables
2140  }
2141
2142  // for the other vertices
2143  for (int i = 2; i <= nV; i++) {
2144    for (int j = 2; j <= nV; j++) {
2145      intvec uv = V[i],V[j];
2146
2147      if (contains(LG, uv)) {
2148        GNC[i,j] = 1;
2149      } else {
2150        // Li p. 177
2151        // search for a right divisor 'w' of uv in G
2152        // then check if G doesn't divide the subword uv-1
2153
2154        // look for a right divisor in LG
2155        for (int k = 1; k <= size(LG); k++) {
2156          if (isSF(LG[k], uv)) {
2157            // w = LG[k]
2158            if(!ivdivides(LG, uv[1..(size(uv)-1)])) {
2159              // G doesn't divide uv-1
2160              GNC[i,j] = 1;
2161              break;
2162            }
2163          }
2164        }
2165      }
2166    }
2167  }
2168
2169  return(GNC);
2170}
2171
2172static proc contains(list L, def item)
2173{
2174  for (int i = 1; i <= size(L); i++) {
2175    if (L[i] == item) {
2176      return (1);
2177    }
2178  }
2179  return (0);
2180}
2181
2182
2183proc ivDHilbert(list L, int n, list #)
2184"USAGE: ivDHilbert(L,n[,degbound]); L a list of intmats, n an integer,
2185@*      degbound an optional integer
2186RETURN: list
2187PURPOSE:Computing the K-dimension and the Hilbert series
2188ASSUME: - basering is a Letterplace ring
2189@*      - all rows of each intmat correspond to a Letterplace monomial
2190@*      - if you specify a different degree bound degbound,
2191@*        degbound <= attrib(basering,uptodeg) holds
2192NOTE: - If L is the list returned, then L[1] is an integer corresponding to the
2193@*      dimension, L[2] is an intvec which contains the coefficients of the
2194@*      Hilbert series
2195@*    - If degbound is set, there will be a degree bound added. By default there
2196@*      is no degree bound
2197@*    - n is the number of variables
2198@*    - If I = L[2] is the intvec returned, then I[k] is the (k-1)-th coefficient of
2199@*      the Hilbert series.
2200@*    - If the K-dimension is known to be infinite, a degree bound is needed
2201EXAMPLE: example ivDHilbert; shows examples
2202"
2203{int degbound = 0;
2204  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] > 0){degbound = #[1];}}}
2205  checkAssumptions(degbound,L);
2206  intvec H; int i,dimen;
2207  H = ivHilbert(L,n,degbound);
2208  for (i = 1; i <= size(H); i++){dimen = dimen + H[i];}
2209  L = dimen,H;
2210  return(L);
2211}
2212example
2213{
2214  "EXAMPLE:"; echo = 2;
2215  ring r = 0,(x,y),dp;
2216  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2217  R;
2218  setring R; // sets basering to Letterplace ring
2219  //some intmats, which contain monomials in intvec representation as rows
2220  intmat I1 [2][2] = 1,1,2,2; intmat I2 [1][3]  = 1,2,1;
2221  intmat J1 [1][2] =  1,1; intmat J2 [2][3] = 2,1,2,1,2,1;
2222  print(I1);
2223  print(I2);
2224  print(J1);
2225  print(J2);
2226  list G = I1,I2; // ideal, which is already a Groebner basis
2227  list I = J1,J2; // ideal, which is already a Groebner basis
2228  //the procedure without a degree bound
2229  ivDHilbert(G,2);
2230  // the procedure with degree bound 5
2231  ivDHilbert(I,2,5);
2232}
2233
2234proc ivDHilbertSickle(list L, int n, list #)
2235"USAGE: ivDHilbertSickle(L,n[,degbound]); L a list of intmats, n an integer,
2236@*      degbound an optional integer
2237RETURN: list
2238PURPOSE:Computing K-dimension, Hilbert series and mistletoes
2239ASSUME: - basering is a Letterplace ring.
2240@*      - All rows of each intmat correspond to a Letterplace monomial.
2241@*      - If you specify a different degree bound degbound,
2242@*        degbound <= attrib(basering,uptodeg) holds.
2243NOTE: - If L is the list returned, then L[1] is an integer, L[2] is an intvec
2244@*      which contains the coefficients of the Hilbert series and L[3]
2245@*      is a list, containing the mistletoes as intvecs.
2246@*    - If degbound is set, a degree bound will be added. By default there
2247@*      is no degree bound.
2248@*    - n is the number of variables.
2249@*    - If I = L[2] is the intvec returned, then I[k] is the (k-1)-th
2250@*      coefficient of the Hilbert series.
2251@*    - If the K-dimension is known to be infinite, a degree bound is needed
2252EXAMPLE: example ivDHilbertSickle; shows examples
2253"
2254{int degbound = 0;
2255  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] > 0){degbound = #[1];}}}
2256  checkAssumptions(degbound,L);
2257  int i,dimen; list R;
2258  R = ivSickleHil(L,n,degbound);
2259  for (i = 1; i <= size(R[1]); i++){dimen = dimen + R[1][i];}
2260  R[3] = R[2]; R[2] = R[1]; R[1] = dimen;
2261  return(R);
2262}
2263example
2264{
2265  "EXAMPLE:"; echo = 2;
2266  ring r = 0,(x,y),dp;
2267  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2268  R;
2269  setring R; // sets basering to Letterplace ring
2270  //some intmats, which contain monomials in intvec representation as rows
2271  intmat I1 [2][2] = 1,1,2,2; intmat I2 [1][3]  = 1,2,1;
2272  intmat J1 [1][2] =  1,1; intmat J2 [2][3] = 2,1,2,1,2,1;
2273  print(I1);
2274  print(I2);
2275  print(J1);
2276  print(J2);
2277  list G = I1,I2;// ideal, which is already a Groebner basis
2278  list I = J1,J2; // ideal, which is already a Groebner basis
2279  ivDHilbertSickle(G,2); // invokes the procedure without a degree bound
2280  ivDHilbertSickle(I,2,3); // invokes the procedure with degree bound 3
2281}
2282
2283proc ivDimCheck(list L, int n)
2284"USAGE: ivDimCheck(L,n); L a list of intmats, n an integer
2285RETURN: int, 0 if the dimension is finite, or 1 otherwise
2286PURPOSE:Decides, whether the K-dimension is finite or not
2287ASSUME: - basering is a Letterplace ring.
2288@*      - All rows of each intmat correspond to a Letterplace monomial.
2289NOTE:   - n is the number of variables.
2290EXAMPLE: example ivDimCheck; shows examples
2291"
2292{checkAssumptions(0,L);
2293  int i,r;
2294  intvec P,H;
2295  for (i = 1; i <= size(L); i++)
2296  {P[i] = ncols(L[i]);
2297    if (P[i] == 1) {if (isInMat(H,L[i]) > 0) {ERROR("Quotient algebra is trivial");}}
2298  }
2299  if (size(L) == 0) {ERROR("GB is empty, quotient algebra corresponds to free algebra");}
2300  kill H;
2301  intmat S; int sd,ld; intvec V;
2302  sd = P[1]; ld = P[1];
2303  for (i = 2; i <= size(P); i++)
2304  {if (P[i] < sd) {sd = P[i];}
2305    if (P[i] > ld) {ld = P[i];}
2306  }
2307  sd = (sd - 1); ld = ld - 1;
2308  if (ld == 0) { return(allVars(L,P,n));}
2309  if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
2310  else {S = createStartMat(sd,n);}
2311  module M;
2312  for (i = 1; i <= nrows(S); i++)
2313  {V = S[i,1..ncols(S)];
2314    if (findCycle(V,L,P,n,ld,M)) {r = 1; break;}
2315  }
2316  return(r);
2317}
2318example
2319{
2320  "EXAMPLE:"; echo = 2;
2321  ring r = 0,(x,y),dp;
2322  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2323  R;
2324  setring R; // sets basering to Letterplace ring
2325  //some intmats, which contain monomials in intvec representation as rows
2326  intmat I1 [2][2] = 1,1,2,2; intmat I2 [1][3]  = 1,2,1;
2327  intmat J1 [1][2] =  1,1; intmat J2 [2][3] = 2,1,2,1,2,1;
2328  print(I1);
2329  print(I2);
2330  print(J1);
2331  print(J2);
2332  list G = I1,I2;// ideal, which is already a Groebner basis
2333  list I = J1,J2; // ideal, which is already a Groebner basis and which
2334  ivDimCheck(G,2); // invokes the procedure, factor is of finite K-dimension
2335  ivDimCheck(I,2); // invokes the procedure, factor is not of finite K-dimension
2336}
2337
2338proc ivHilbert(list L, int n, list #)
2339"USAGE: ivHilbert(L,n[,degbound]); L a list of intmats, n an integer,
2340@*      degbound an optional integer
2341RETURN: intvec, containing the coefficients of the Hilbert series
2342PURPOSE:Computing the Hilbert series
2343ASSUME: - basering is a Letterplace ring.
2344@*      - all rows of each intmat correspond to a Letterplace monomial
2345@*      - if you specify a different degree bound degbound,
2346@*       degbound <= attrib(basering,uptodeg) holds.
2347NOTE: - If degbound is set, a degree bound  will be added. By default there
2348@*      is no degree bound.
2349@*    - n is the number of variables.
2350@*    - If I is returned, then I[k] is the (k-1)-th coefficient of the Hilbert
2351@*      series.
2352@*    - If the K-dimension is known to be infinite, a degree bound is needed
2353EXAMPLE: example ivHilbert; shows examples
2354"
2355{int degbound = 0;
2356  if (size(#) > 0) {if (typeof(#[1])=="int"){if (#[1] > 0) {degbound = #[1];}}}
2357  intvec P,H; int i;
2358  for (i = 1; i <= size(L); i++)
2359  {P[i] = ncols(L[i]);
2360    if (P[i] == 1) {if ( isInMat(H,L[i]) > 0) {ERROR("Quotient algebra is trivial");}}
2361  }
2362  if (size(L) == 0) {ERROR("GB is empty, quotient algebra corresponds to free algebra");}
2363  H[1] = 1;
2364  checkAssumptions(degbound,L);
2365  if (degbound == 0)
2366  {int sd;
2367    intmat S;
2368    sd = P[1];
2369    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
2370    sd = (sd - 1);
2371    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
2372    else {S = createStartMat(sd,n);}
2373    if (intvec(S) == 0) {return(H);}
2374    for (i = 1; i <= sd; i++) {H = H,(n^i);}
2375    for (i = 1; i <= nrows(S); i++)
2376    {intvec St = S[i,1..ncols(S)];
2377      H = findHCoeff(St,n,L,P,H);
2378      kill St;
2379    }
2380    return(H);
2381  }
2382  else
2383  {for (i = 1; i <= size(P); i++)
2384    {if (P[i] > degbound) {ERROR("degreebound is too small, GB contains elements of higher degree");}}
2385    int sd;
2386    intmat S;
2387    sd = P[1];
2388    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
2389    sd = (sd - 1);
2390    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
2391    else {S = createStartMat(sd,n);}
2392    if (intvec(S) == 0) {return(H);}
2393    for (i = 1; i <= sd; i++) {H = H,(n^i);}
2394    for (i = 1; i <= nrows(S); i++)
2395    {intvec St = S[i,1..ncols(S)];
2396      H = findHCoeff(St,n,L,P,H,degbound);
2397      kill St;
2398    }
2399    return(H);
2400  }
2401}
2402example
2403{
2404  "EXAMPLE:"; echo = 2;
2405  ring r = 0,(x,y),dp;
2406  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2407  R;
2408  setring R; // sets basering to Letterplace ring
2409  //some intmats, which contain monomials in intvec representation as rows
2410  intmat I1 [2][2] = 1,1,2,2; intmat I2 [1][3]  = 1,2,1;
2411  intmat J1 [1][2] =  1,1; intmat J2 [2][3] = 2,1,2,1,2,1;
2412  print(I1);
2413  print(I2);
2414  print(J1);
2415  print(J2);
2416  list G = I1,I2; // ideal, which is already a Groebner basis
2417  list I = J1,J2; // ideal, which is already a Groebner basis
2418  ivHilbert(G,2); // invokes the procedure without any degree bound
2419  ivHilbert(I,2,5); // invokes the procedure with degree bound 5
2420}
2421
2422
2423proc ivKDim(list L, int n, list #)
2424"USAGE: ivKDim(L,n[,degbound]); L a list of intmats,
2425@*      n an integer, degbound an optional integer
2426RETURN: int, the K-dimension of A/<L>
2427PURPOSE:Computing the K-dimension of A/<L>
2428ASSUME: - basering is a Letterplace ring.
2429@*      - all rows of each intmat correspond to a Letterplace monomial
2430@*      - if you specify a different degree bound degbound,
2431@*        degbound <= attrib(basering,uptodeg) holds.
2432NOTE: - If degbound is set, a degree bound will be added. By default there
2433@*      is no degree bound.
2434@*    - n is the number of variables.
2435@*    - If the K-dimension is known to be infinite, a degree bound is needed
2436EXAMPLE: example ivKDim; shows examples
2437"
2438{int degbound = 0;
2439  if (size(#) > 0) {if (typeof(#[1])=="int"){if (#[1] > 0) {degbound = #[1];}}}
2440  intvec P,H; int i;
2441  for (i = 1; i <= size(L); i++)
2442  {P[i] = ncols(L[i]);
2443    if (P[i] == 1) {if ( isInMat(H,L[i]) > 0) {ERROR("Quotient algebra is trivial");}}
2444  }
2445  if (size(L) == 0) {ERROR("GB is empty, quotient algebra corresponds to free algebra");}
2446  kill H;
2447  checkAssumptions(degbound,L);
2448  if (degbound == 0)
2449  {int sd; int dimen = 1;
2450    intmat S;
2451    sd = P[1];
2452    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
2453    sd = (sd - 1);
2454    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
2455    else {S = createStartMat(sd,n);}
2456    if (intvec(S) == 0) {return(dimen);}
2457    for (i = 1; i <= sd; i++) {dimen = dimen +(n^i);}
2458    for (i = 1; i <= nrows(S); i++)
2459    {intvec St = S[i,1..ncols(S)];
2460      dimen = dimen + findDimen(St,n,L,P);
2461      kill St;
2462    }
2463    return(dimen);
2464  }
2465  else
2466  {for (i = 1; i <= size(P); i++)
2467    {if (P[i] > degbound) {ERROR("degreebound is too small, GB contains elements of higher degree");}}
2468    int sd; int dimen = 1;
2469    intmat S;
2470    sd = P[1];
2471    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
2472    sd = (sd - 1);
2473    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
2474    else {S = createStartMat(sd,n);}
2475    if (intvec(S) == 0) {return(dimen);}
2476    for (i = 1; i <= sd; i++) {dimen = dimen +(n^i);}
2477    for (i = 1; i <= nrows(S); i++)
2478    {intvec St = S[i,1..ncols(S)];
2479      dimen = dimen + findDimen(St,n,L,P, degbound);
2480      kill St;
2481    }
2482    return(dimen);
2483  }
2484}
2485example
2486{
2487  "EXAMPLE:"; echo = 2;
2488  ring r = 0,(x,y),dp;
2489  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2490  R;
2491  setring R; // sets basering to Letterplace ring
2492  //some intmats, which contain monomials in intvec representation as rows
2493  intmat I1 [2][2] = 1,1,2,2; intmat I2 [1][3]  = 1,2,1;
2494  intmat J1 [1][2] =  1,1; intmat J2 [2][3] = 2,1,2,1,2,1;
2495  print(I1);
2496  print(I2);
2497  print(J1);
2498  print(J2);
2499  list G = I1,I2; // ideal, which is already a Groebner basis
2500  list I = J1,J2; // ideal, which is already a Groebner basis
2501  ivKDim(G,2); // invokes the procedure without any degree bound
2502  ivKDim(I,2,5); // invokes the procedure with degree bound 5
2503}
2504
2505proc ivMis2Base(list M)
2506"USAGE: ivMis2Base(M); M a list of intvecs
2507RETURN: ideal, a K-base of the given algebra
2508PURPOSE:Computing the K-base out of given mistletoes
2509ASSUME: - The mistletoes have to be ordered lexicographically -> OrdMisLex.
2510@*        Otherwise there might some elements missing.
2511@*      - basering is a Letterplace ring.
2512@*      - mistletoes are stored as intvecs, as described in the overview
2513EXAMPLE: example ivMis2Base; shows examples
2514"
2515{
2516  //checkAssumptions(0,M);
2517  intvec L,A;
2518  if (size(M) == 0){ERROR("There are no mistletoes, so it appears your dimension is infinite!");}
2519  if (isInList(L,M) > 0) {print("1 is a mistletoe, therefore 1 is the only basis element"); return(list(intvec(0)));}
2520  int i,j,d,s;
2521  list Rt;
2522  Rt[1] = intvec(0);
2523  L = M[1];
2524  for (i = size(L); 1 <= i; i--) {Rt = insert(Rt,intvec(L[1..i]));}
2525  for (i = 2; i <= size(M); i++)
2526  {A = M[i]; L = M[i-1];
2527    s = size(A);
2528    if (s > size(L))
2529    {d = size(L);
2530      for (j = s; j > d; j--) {Rt = insert(Rt,intvec(A[1..j]));}
2531      A = A[1..d];
2532    }
2533    if (size(L) > s){L = L[1..s];}
2534    while (A <> L)
2535    {Rt = insert(Rt, intvec(A));
2536      if (size(A) > 1)
2537      {A = A[1..(size(A)-1)];
2538        L = L[1..(size(L)-1)];
2539      }
2540      else {break;}
2541    }
2542  }
2543  return(Rt);
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  ivMis2Base(L); // returns the basis of the factor algebra
2556}
2557
2558
2559proc ivMis2Dim(list M)
2560"USAGE: ivMis2Dim(M); M a list of intvecs
2561RETURN: int, the K-dimension of the given algebra
2562PURPOSE:Computing the K-dimension out of given mistletoes
2563ASSUME: - The mistletoes have to be ordered lexicographically -> OrdMisLex.
2564@*        Otherwise the returned value may differ from the K-dimension.
2565@*      - basering is a Letterplace ring.
2566EXAMPLE: example ivMis2Dim; shows examples
2567"
2568{checkAssumptions(0,M);
2569  intvec L;
2570  if (size(M) == 0){ERROR("There are no mistletoes, so it appears your dimension is infinite!");}
2571  if (isInList(L,M) > 0) {print("1 is a mistletoe, therefore dim = 1"); return(1);}
2572  int i,j,d,s;
2573  j = 1;
2574  d = 1 + size(M[1]);
2575  for (i = 1; i < size(M); i++)
2576  {s = size(M[i]); if (s > size(M[i+1])){s = size(M[i+1]);}
2577    while ((M[i][j] == M[i+1][j]) && (j <= s)){j = j + 1;}
2578    d = d + size(M[i+1])- j + 1;
2579  }
2580  return(d);
2581}
2582example
2583{
2584  "EXAMPLE:"; echo = 2;
2585  ring r = 0,(x,y),dp;
2586  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2587  R;
2588  setring R; // sets basering to Letterplace ring
2589  intvec i1 = 1,2; intvec i2 = 2,1,2;
2590  // the mistletoes are xy and yxy, which are already ordered lexicographically
2591  list L = i1,i2;
2592  ivMis2Dim(L); // returns the dimension of the factor algebra
2593}
2594
2595proc ivOrdMisLex(list M)
2596"USAGE: ivOrdMisLex(M); M a list of intvecs
2597RETURN: list, containing the ordered intvecs of M
2598PURPOSE:Orders a given set of mistletoes lexicographically
2599ASSUME: - basering is a Letterplace ring.
2600- intvecs correspond to monomials
2601NOTE:   - This is preprocessing, it's not needed if the mistletoes are returned
2602@*        from the sickle algorithm.
2603@*      - Each entry of the list returned is an intvec.
2604EXAMPLE: example ivOrdMisLex; shows examples
2605"
2606{checkAssumptions(0,M);
2607  return(sort(M)[1]);
2608}
2609example
2610{
2611  "EXAMPLE:"; echo = 2;
2612  ring r = 0,(x,y),dp;
2613  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2614  setring R; // sets basering to Letterplace ring
2615  intvec i1 = 1,2,1; intvec i2 = 2,2,1; intvec i3 = 1,1; intvec i4 = 2,1,1,1;
2616  // the corresponding monomials are xyx,y^2x,x^2,yx^3
2617  list M = i1,i2,i3,i4;
2618  M;
2619  ivOrdMisLex(M);// orders the list of monomials
2620}
2621
2622proc ivSickle(list L, int n, list #)
2623"USAGE: ivSickle(L,n,[degbound]); L a list of intmats, n an int, degbound an
2624@*      optional integer
2625RETURN: list, containing intvecs, the mistletoes of A/<L>
2626PURPOSE:Computing the mistletoes for a given Groebner basis L
2627ASSUME: - basering is a Letterplace ring.
2628@*      - all rows of each intmat correspond to a Letterplace monomial
2629@*      - if you specify a different degree bound degbound,
2630@*        degbound <= attrib(basering,uptodeg) holds.
2631NOTE: - If degbound is set, a degree bound will be added. By default there
2632@*      is no degree bound.
2633@*    - n is the number of variables.
2634@*    - If the K-dimension is known to be infinite, a degree bound is needed
2635EXAMPLE: example ivSickle; shows examples
2636"
2637{list M;
2638  int degbound = 0;
2639  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] > 0){degbound = #[1];}}}
2640  int i;
2641  intvec P,H;
2642  for (i = 1; i <= size(L); i++)
2643  {P[i] = ncols(L[i]);
2644    if (P[i] == 1) {if (isInMat(H,L[i]) > 0) {ERROR("Quotient algebra is trivial");}}
2645  }
2646  if (size(L) == 0) {ERROR("GB is empty, quotient algebra corresponds to free algebra");}
2647  kill H;
2648  checkAssumptions(degbound,L);
2649  if (degbound == 0)
2650  {intmat S; int sd;
2651    sd = P[1];
2652    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
2653    sd = (sd - 1);
2654    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
2655    else {S = createStartMat(sd,n);}
2656    if (intvec(S) == 0) {return(list (intvec(0)));}
2657    for (i = 1; i <= nrows(S); i++)
2658    {intvec St = S[i,1..ncols(S)];
2659      M = M + findmistletoes(St,n,L,P);
2660      kill St;
2661    }
2662    return(M);
2663  }
2664  else
2665  {for (i = 1; i <= size(P); i++)
2666    {if (P[i] > degbound) {ERROR("degreebound is too small, GB contains elements of higher degree");}}
2667    intmat S; int sd;
2668    sd = P[1];
2669    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
2670    sd = (sd - 1);
2671    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
2672    else {S = createStartMat(sd,n);}
2673    if (intvec(S) == 0) {return(list (intvec(0)));}
2674    for (i = 1; i <= nrows(S); i++)
2675    {intvec St = S[i,1..ncols(S)];
2676      M = M + findmistletoes(St,n,L,P,degbound);
2677      kill St;
2678    }
2679    return(M);
2680  }
2681}
2682example
2683{
2684  "EXAMPLE:"; echo = 2;
2685  ring r = 0,(x,y),dp;
2686  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2687  setring R; // sets basering to Letterplace ring
2688  //some intmats, which contain monomials in intvec representation as rows
2689  intmat I1 [2][2] = 1,1,2,2; intmat I2 [1][3]  = 1,2,1;
2690  intmat J1 [1][2] =  1,1; intmat J2 [2][3] = 2,1,2,1,2,1;
2691  print(I1);
2692  print(I2);
2693  print(J1);
2694  print(J2);
2695  list G = I1,I2; // ideal, which is already a Groebner basis
2696  list I =  J1,J2; // ideal, which is already a Groebner basis
2697  ivSickle(G,2); // invokes the procedure without any degree bound
2698  ivSickle(I,2,5); // invokes the procedure with degree bound 5
2699}
2700
2701proc ivSickleDim(list L, int n, list #)
2702"USAGE: ivSickleDim(L,n[,degbound]); L a list of intmats, n an integer, degbound
2703@*      an optional integer
2704RETURN: list
2705PURPOSE:Computing mistletoes and the K-dimension
2706ASSUME: - basering is a Letterplace ring.
2707@*      - all rows of each intmat correspond to a Letterplace monomial
2708@*      - if you specify a different degree bound degbound,
2709@*        degbound <= attrib(basering,uptodeg) holds.
2710NOTE: - If L is the list returned, then L[1] is an integer, L[2] is a list,
2711@*      containing the mistletoes as intvecs.
2712@*    - If degbound is set, a degree bound will be added. By default there
2713@*      is no degree bound.
2714@*    - n is the number of variables.
2715@*    - If the K-dimension is known to be infinite, a degree bound is needed
2716EXAMPLE: example ivSickleDim; shows examples
2717"
2718{list M;
2719  int degbound = 0;
2720  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] > 0){degbound = #[1];}}}
2721  int i,dimen; list R;
2722  intvec P,H;
2723  for (i = 1; i <= size(L); i++)
2724  {P[i] = ncols(L[i]);
2725    if (P[i] == 1) {if (isInMat(H,L[i]) > 0) {ERROR("Quotient algebra is trivial, dimension equals zero");}}
2726  }
2727  if (size(L) == 0) {ERROR("GB is empty, quotient algebra corresponds to free algebra");}
2728  kill H;
2729  checkAssumptions(degbound,L);
2730  if (degbound == 0)
2731  {int sd; dimen = 1;
2732    intmat S;
2733    sd = P[1];
2734    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
2735    sd = (sd - 1);
2736    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
2737    else {S = createStartMat(sd,n);}
2738    if (intvec(S) == 0) {return(list(dimen,list(intvec(0))));}
2739    for (i = 1; i <= sd; i++) {dimen = dimen +(n^i);}
2740    R[1] = dimen;
2741    for (i = 1; i <= nrows(S); i++)
2742    {intvec St = S[i,1..ncols(S)];
2743      R = findMisDim(St,n,L,P,R);
2744      kill St;
2745    }
2746    return(R);
2747  }
2748  else
2749  {for (i = 1; i <= size(P); i++)
2750    {if (P[i] > degbound) {ERROR("degreebound is too small, GB contains elements of higher degree");}}
2751    int sd; dimen = 1;
2752    intmat S;
2753    sd = P[1];
2754    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
2755    sd = (sd - 1);
2756    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
2757    else {S = createStartMat(sd,n);}
2758    if (intvec(S) == 0) {return(list(dimen,list(intvec(0))));}
2759    for (i = 1; i <= sd; i++) {dimen = dimen +(n^i);}
2760    R[1] = dimen;
2761    for (i = 1; i <= nrows(S); i++)
2762    {intvec St = S[i,1..ncols(S)];
2763      R = findMisDim(St,n,L,P,R,degbound);
2764      kill St;
2765    }
2766    return(R);
2767  }
2768}
2769example
2770{
2771  "EXAMPLE:"; echo = 2;
2772  ring r = 0,(x,y),dp;
2773  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2774  setring R; // sets basering to Letterplace ring
2775  //some intmats, which contain monomials in intvec representation as rows
2776  intmat I1 [2][2] = 1,1,2,2; intmat I2 [1][3]  = 1,2,1;
2777  intmat J1 [1][2] =  1,1; intmat J2 [2][3] = 2,1,2,1,2,1;
2778  print(I1);
2779  print(I2);
2780  print(J1);
2781  print(J2);
2782  list G = I1,I2;// ideal, which is already a Groebner basis
2783  list I =  J1,J2; // ideal, which is already a Groebner basis
2784  ivSickleDim(G,2); // invokes the procedure without any degree bound
2785  ivSickleDim(I,2,5); // invokes the procedure with degree bound 5
2786}
2787
2788proc ivSickleHil(list L, int n, list #)
2789"USAGE:ivSickleHil(L,n[,degbound]); L a list of intmats, n an integer,
2790@*     degbound an optional integer
2791RETURN: list
2792PURPOSE:Computing the mistletoes and the Hilbert series
2793ASSUME: - basering is a Letterplace ring.
2794@*      - all rows of each intmat correspond to a Letterplace monomial
2795@*      - if you specify a different degree bound degbound,
2796@*        degbound <= attrib(basering,uptodeg) holds.
2797NOTE: - If L is the list returned, then L[1] is an intvec, L[2] is a list,
2798@*      containing the mistletoes as intvecs.
2799@*    - If degbound is set, a degree bound will be added. By default there
2800@*      is no degree bound.
2801@*    - n is the number of variables.
2802@*    - If I = L[1] is the intvec returned, then I[k] is the (k-1)-th
2803@*      coefficient of the Hilbert series.
2804@*    - If the K-dimension is known to be infinite, a degree bound is needed
2805EXAMPLE: example ivSickleHil; shows examples
2806"
2807{int degbound = 0;
2808  if (size(#) > 0) {if (typeof(#[1])=="int"){if (#[1] > 0) {degbound = #[1];}}}
2809  intvec P,H; int i; list R;
2810  for (i = 1; i <= size(L); i++)
2811  {P[i] = ncols(L[i]);
2812    if (P[i] == 1) {if ( isInMat(H,L[i]) > 0) {ERROR("Quotient algebra is trivial");}}
2813  }
2814  if (size(L) == 0) {ERROR("GB is empty, quotient algebra corresponds to free algebra");}
2815  H[1] = 1;
2816  checkAssumptions(degbound,L);
2817  if (degbound == 0)
2818  {int sd;
2819    intmat S;
2820    sd = P[1];
2821    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
2822    sd = (sd - 1);
2823    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
2824    else {S = createStartMat(sd,n);}
2825    if (intvec(S) == 0) {return(list(H,list(intvec (0))));}
2826    for (i = 1; i <= sd; i++) {H = H,(n^i);}
2827    R[1] = H; kill H;
2828    for (i = 1; i <= nrows(S); i++)
2829    {intvec St = S[i,1..ncols(S)];
2830      R = findHCoeffMis(St,n,L,P,R);
2831      kill St;
2832    }
2833    return(R);
2834  }
2835  else
2836  {for (i = 1; i <= size(P); i++)
2837    {if (P[i] > degbound) {ERROR("degreebound is too small, GB contains elements of higher degree");}}
2838    int sd;
2839    intmat S;
2840    sd = P[1];
2841    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
2842    sd = (sd - 1);
2843    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
2844    else {S = createStartMat(sd,n);}
2845    if (intvec(S) == 0) {return(list(H,list(intvec(0))));}
2846    for (i = 1; i <= sd; i++) {H = H,(n^i);}
2847    R[1] = H; kill H;
2848    for (i = 1; i <= nrows(S); i++)
2849    {intvec St = S[i,1..ncols(S)];
2850      R = findHCoeffMis(St,n,L,P,R,degbound);
2851      kill St;
2852    }
2853    return(R);
2854  }
2855}
2856example
2857{
2858  "EXAMPLE:"; echo = 2;
2859  ring r = 0,(x,y),dp;
2860  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2861  setring R; // sets basering to Letterplace ring
2862  //some intmats, which contain monomials in intvec representation as rows
2863  intmat I1[2][2] = 1,1,2,2; intmat I2[1][3]  = 1,2,1;
2864  intmat J1[1][2] =  1,1; intmat J2[2][3] = 2,1,2,1,2,1;
2865  print(I1);
2866  print(I2);
2867  print(J1);
2868  print(J2);
2869  list G = I1,I2;// ideal, which is already a Groebner basis
2870  list I =  J1,J2; // ideal, which is already a Groebner basis
2871  ivSickleHil(G,2); // invokes the procedure without any degree bound
2872  ivSickleHil(I,2,5); // invokes the procedure with degree bound 5
2873}
2874
2875proc lpDHilbert(ideal G, list #)
2876"USAGE: lpDHilbert(G[,degbound,n]); G an ideal, degbound, n optional integers
2877RETURN: list
2878PURPOSE:Computing K-dimension and Hilbert series, starting with a lp-ideal
2879ASSUME: - basering is a Letterplace ring.
2880@*      - if you specify a different degree bound degbound,
2881@*        degbound <= attrib(basering,uptodeg) holds.
2882NOTE: - If L is the list returned, then L[1] is an integer corresponding to the
2883@*      dimension, L[2] is an intvec which contains the coefficients of the
2884@*      Hilbert series
2885@*    - If degbound is set, there will be a degree bound added. 0 means no
2886@*      degree bound. Default: attrib(basering,uptodeg).
2887@*    - n can be set to a different number of variables.
2888@*      Default: n = attrib(basering, lV).
2889@*    - If I = L[2] is the intvec returned, then I[k] is the (k-1)-th
2890@*      coefficient of the Hilbert series.
2891@*    - If the K-dimension is known to be infinite, a degree bound is needed
2892EXAMPLE: example lpDHilbert; shows examples
2893"
2894{int degbound = attrib(basering,"uptodeg");int n = attrib(basering, "lV");
2895  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] >= 0){degbound = #[1];}}}
2896  if (size(#) > 1){if (typeof(#[1])=="int"){if (#[2] > 0){n = #[2];}}}
2897  list L;
2898  L = lp2ivId(normalize(lead(G)));
2899  return(ivDHilbert(L,n,degbound));
2900}
2901example
2902{
2903  "EXAMPLE:"; echo = 2;
2904  ring r = 0,(x,y),dp;
2905  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2906  setring R; // sets basering to Letterplace ring
2907  ideal G = x(1)*x(2), y(1)*y(2),x(1)*y(2)*x(3); // ideal G contains a
2908  //Groebner basis
2909  lpDHilbert(G,5,2); // invokes procedure with degree bound 5 and 2 variables
2910  // note that the optional parameters are not necessary, due to the finiteness
2911  // of the K-dimension of the factor algebra
2912  lpDHilbert(G); // procedure with ring parameters
2913  lpDHilbert(G,0); // procedure without degreebound
2914}
2915
2916proc lpDHilbertSickle(ideal G, list #)
2917"USAGE: lpDHilbertSickle(G[,degbound,n]); G an ideal, degbound, n optional
2918@*      integers
2919RETURN: list
2920PURPOSE:Computing K-dimension, Hilbert series and mistletoes at once
2921ASSUME: - basering is a Letterplace ring.
2922@*      - if you specify a different degree bound degbound,
2923@*        degbound <= attrib(basering,uptodeg) holds.
2924NOTE: - If L is the list returned, then L[1] is an integer, the K-dimension,
2925@*      L[2] is an intvec, the Hilbert series and L[3] is an ideal,
2926@*      the mistletoes
2927@*    - If degbound is set, there will be a degree bound added. 0 means no
2928@*      degree bound. Default: attrib(basering,uptodeg).
2929@*    - n can be set to a different number of variables.
2930@*      Default: n = attrib(basering, lV).
2931@*    - If I = L[1] is the intvec returned, then I[k] is the (k-1)-th
2932@*      coefficient of the Hilbert series.
2933@*    - If the K-dimension is known to be infinite, a degree bound is needed
2934EXAMPLE: example lpDHilbertSickle; shows examples
2935"
2936{int degbound = attrib(basering,"uptodeg");int n = attrib(basering, "lV");
2937  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] >= 0){degbound = #[1];}}}
2938  if (size(#) > 1){if (typeof(#[1])=="int"){if (#[2] > 0){n = #[2];}}}
2939  list L;
2940  L = lp2ivId(normalize(lead(G)));
2941  L = ivDHilbertSickle(L,n,degbound);
2942  L[3] =  ivL2lpI(L[3]);
2943  return(L);
2944}
2945example
2946{
2947  "EXAMPLE:"; echo = 2;
2948  ring r = 0,(x,y),dp;
2949  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2950  setring R; // sets basering to Letterplace ring
2951  ideal G = x(1)*x(2), y(1)*y(2),x(1)*y(2)*x(3); // ideal G contains a
2952  //Groebner basis
2953  lpDHilbertSickle(G,5,2); //invokes procedure with degree bound 5 and 2 variables
2954  // note that the optional parameters are not necessary, due to the finiteness
2955  // of the K-dimension of the factor algebra
2956  lpDHilbertSickle(G); // procedure with ring parameters
2957  lpDHilbertSickle(G,0); // procedure without degreebound
2958}
2959
2960proc lpHilbert(ideal G, list #)
2961"USAGE: lpHilbert(G[,degbound,n]); G an ideal, degbound, n optional integers
2962RETURN: intvec, containing the coefficients of the Hilbert series
2963PURPOSE:Computing the Hilbert series
2964ASSUME: - basering is a Letterplace ring.
2965@*      - if you specify a different degree bound degbound,
2966@*        degbound <= attrib(basering,uptodeg) holds.
2967NOTE: - If degbound is set, there will be a degree bound added. 0 means no
2968@*      degree bound. Default: attrib(basering,uptodeg).
2969@*    - n is the number of variables, which can be set to a different number.
2970@*      Default: attrib(basering, lV).
2971@*    - If I is returned, then I[k] is the (k-1)-th coefficient of the Hilbert
2972@*      series.
2973@*    - If the K-dimension is known to be infinite, a degree bound is needed
2974EXAMPLE: example lpHilbert; shows examples
2975"
2976{int degbound = attrib(basering,"uptodeg");int n = attrib(basering, "lV");
2977  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] >= 0){degbound = #[1];}}}
2978  if (size(#) > 1){if (typeof(#[1])=="int"){if (#[2] > 0){n = #[2];}}}
2979  list L;
2980  L = lp2ivId(normalize(lead(G)));
2981  return(ivHilbert(L,n,degbound));
2982}
2983example
2984{
2985  "EXAMPLE:"; echo = 2;
2986  ring r = 0,(x,y),dp;
2987  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2988  setring R; // sets basering to Letterplace ring
2989  ideal G = x(1)*x(2), y(1)*y(2),x(1)*y(2)*x(3); // ideal G contains a
2990  //Groebner basis
2991  lpHilbert(G,5,2); // invokes procedure with degree bound 5 and 2 variables
2992  // note that the optional parameters are not necessary, due to the finiteness
2993  // of the K-dimension of the factor algebra
2994  lpDHilbert(G); // procedure with ring parameters
2995  lpDHilbert(G,0); // procedure without degreebound
2996}
2997
2998proc lpDimCheck(ideal G)
2999"USAGE: lpDimCheck(G);
3000RETURN: int, 1 if K-dimension of the factor algebra is infinite, 0 otherwise
3001PURPOSE:Checking a factor algebra for finiteness of the K-dimension
3002ASSUME: - basering is a Letterplace ring.
3003EXAMPLE: example lpDimCheck; shows examples
3004"
3005{int n = attrib(basering,"lV");
3006  list L;
3007  ideal R;
3008  R = normalize(lead(G));
3009  L = lp2ivId(R);
3010  return(ivDimCheck(L,n));
3011}
3012example
3013{
3014  "EXAMPLE:"; echo = 2;
3015  ring r = 0,(x,y),dp;
3016  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
3017  setring R; // sets basering to Letterplace ring
3018  ideal G = x(1)*x(2), y(1)*y(2),x(1)*y(2)*x(3);
3019  // Groebner basis
3020  ideal I = x(1)*x(2), y(1)*x(2)*y(3), x(1)*y(2)*x(3);
3021  // Groebner basis
3022  lpDimCheck(G); // invokes procedure, factor algebra is of finite K-dimension
3023  lpDimCheck(I); // invokes procedure, factor algebra is of infinite Kdimension
3024}
3025
3026proc lpKDim(ideal G, list #)
3027"USAGE: lpKDim(G[,degbound, n]); G an ideal, degbound, n optional integers
3028RETURN: int, the K-dimension of the factor algebra
3029PURPOSE:Computing the K-dimension of a factor algebra, given via an ideal
3030ASSUME: - basering is a Letterplace ring
3031@*      - if you specify a different degree bound degbound,
3032@*        degbound <= attrib(basering,uptodeg) holds.
3033NOTE: - If degbound is set, there will be a degree bound added. 0 means no
3034@*      degree bound. Default: attrib(basering, uptodeg).
3035@*    - n is the number of variables, which can be set to a different number.
3036@*      Default: attrib(basering, lV).
3037@*    - If the K-dimension is known to be infinite, a degree bound is needed
3038EXAMPLE: example lpKDim; shows examples
3039"
3040{int degbound = attrib(basering, "uptodeg");int n = attrib(basering, "lV");
3041  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] >= 0){degbound = #[1];}}}
3042  if (size(#) > 1){if (typeof(#[1])=="int"){if (#[2] > 0){n = #[2];}}}
3043  list L;
3044  L = lp2ivId(normalize(lead(G)));
3045  return(ivKDim(L,n,degbound));
3046}
3047example
3048{
3049  "EXAMPLE:"; echo = 2;
3050  ring r = 0,(x,y),dp;
3051  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
3052  setring R; // sets basering to Letterplace ring
3053  ideal G = x(1)*x(2), y(1)*y(2),x(1)*y(2)*x(3);
3054  // ideal G contains a Groebner basis
3055  lpKDim(G); //procedure invoked with ring parameters
3056  // the factor algebra is finite, so the degree bound given by the Letterplace
3057  // ring is not necessary
3058  lpKDim(G,0); // procedure without any degree bound
3059}
3060
3061proc lpMis2Base(ideal M)
3062"USAGE: lpMis2Base(M); M an ideal
3063RETURN: ideal, a K-basis of the factor algebra
3064PURPOSE:Computing a K-basis out of given mistletoes
3065ASSUME: - basering is a Letterplace ring. G is a Letterplace ideal.
3066@*      - M contains only monomials
3067NOTE:   - The mistletoes have to be ordered lexicographically -> OrdMisLex.
3068EXAMPLE: example lpMis2Base; shows examples
3069"
3070{list L;
3071  L = lpId2ivLi(M);
3072  return(ivL2lpI(ivMis2Base(L)));
3073}
3074example
3075{
3076  "EXAMPLE:"; echo = 2;
3077  ring r = 0,(x,y),dp;
3078  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
3079  setring R; // sets basering to Letterplace ring
3080  ideal L = x(1)*y(2),y(1)*x(2)*y(3);
3081  // ideal containing the mistletoes
3082  lpMis2Base(L); // returns the K-basis of the factor algebra
3083}
3084
3085proc lpMis2Dim(ideal M)
3086"USAGE: lpMis2Dim(M); M an ideal
3087RETURN: int, the K-dimension of the factor algebra
3088PURPOSE:Computing the K-dimension out of given mistletoes
3089ASSUME: - basering is a Letterplace ring.
3090@*      - M contains only monomials
3091NOTE:   - The mistletoes have to be ordered lexicographically -> OrdMisLex.
3092EXAMPLE: example lpMis2Dim; shows examples
3093"
3094{list L;
3095  L = lpId2ivLi(M);
3096  return(ivMis2Dim(L));
3097}
3098example
3099{
3100  "EXAMPLE:"; echo = 2;
3101  ring r = 0,(x,y),dp;
3102  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
3103  setring R; // sets basering to Letterplace ring
3104  ideal L = x(1)*y(2),y(1)*x(2)*y(3);
3105  // ideal containing the mistletoes
3106  lpMis2Dim(L); // returns the K-dimension of the factor algebra
3107}
3108
3109proc lpOrdMisLex(ideal M)
3110"USAGE: lpOrdMisLex(M); M an ideal of mistletoes
3111RETURN: ideal, containing the mistletoes, ordered lexicographically
3112PURPOSE:A given set of mistletoes is ordered lexicographically
3113ASSUME: - basering is a Letterplace ring.
3114NOTE:   This is preprocessing, it is not needed if the mistletoes are returned
3115@*      from the sickle algorithm.
3116EXAMPLE: example lpOrdMisLex; shows examples
3117"
3118{return(ivL2lpI(sort(lpId2ivLi(M))[1]));}
3119example
3120{
3121  "EXAMPLE:"; echo = 2;
3122  ring r = 0,(x,y),dp;
3123  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
3124  setring R; // sets basering to Letterplace ring
3125  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);
3126  // some monomials
3127  lpOrdMisLex(M); // orders the monomials lexicographically
3128}
3129
3130proc lpSickle(ideal G,  list #)
3131"USAGE: lpSickle(G[,degbound,n]); G an ideal, degbound, n optional integers
3132RETURN: ideal
3133PURPOSE:Computing the mistletoes of K[X]/<G>
3134ASSUME: - basering is a Letterplace ring.
3135@*      - if you specify a different degree bound degbound,
3136@*        degbound <= attrib(basering,uptodeg) holds.
3137NOTE: - If degbound is set, there will be a degree bound added. 0 means no
3138@*      degree bound. Default: attrib(basering,uptodeg).
3139@*    - n is the number of variables, which can be set to a different number.
3140@*      Default: attrib(basering, lV).
3141@*    - If the K-dimension is known to be infinite, a degree bound is needed
3142EXAMPLE: example lpSickle; shows examples
3143"
3144{int degbound = attrib(basering,"uptodeg"); int n = attrib(basering, "lV");
3145  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] >= 0){degbound = #[1];}}}
3146  if (size(#) > 1){if (typeof(#[1])=="int"){if (#[2] > 0){n = #[2];}}}
3147  list L; ideal R;
3148  R = normalize(lead(G));
3149  L = lp2ivId(R);
3150  L = ivSickle(L,n,degbound);
3151  R = ivL2lpI(L);
3152  return(R);
3153}
3154example
3155{
3156  "EXAMPLE:"; echo = 2;
3157  ring r = 0,(x,y),dp;
3158  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
3159  setring R; // sets basering to Letterplace ring
3160  ideal G = x(1)*x(2), y(1)*y(2),x(1)*y(2)*x(3); // ideal G contains a
3161  //Groebner basis
3162  lpSickle(G); //invokes the procedure with ring parameters
3163  // the factor algebra is finite, so the degree bound given by the Letterplace
3164  // ring is not necessary
3165  lpSickle(G,0); // procedure without any degree bound
3166}
3167
3168proc lpSickleDim(ideal G, list #)
3169"USAGE: lpSickleDim(G[,degbound,n]); G an ideal, degbound, n optional integers
3170RETURN: list
3171PURPOSE:Computing the K-dimension and the mistletoes
3172ASSUME: - basering is a Letterplace ring.
3173@*      - if you specify a different degree bound degbound,
3174@*        degbound <= attrib(basering,uptodeg) holds.
3175NOTE: - If L is the list returned, then L[1] is an integer, the K-dimension,
3176@*      L[2] is an ideal, the mistletoes.
3177@*    - If degbound is set, there will be a degree bound added. 0 means no
3178@*      degree bound. Default: attrib(basering,uptodeg).
3179@*    - n is the number of variables, which can be set to a different number.
3180@*      Default: attrib(basering, lV).
3181@*    - If the K-dimension is known to be infinite, a degree bound is needed
3182EXAMPLE: example lpSickleDim; shows examples
3183"
3184{int degbound = attrib(basering,"uptodeg");int n = attrib(basering, "lV");
3185  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] >= 0){degbound = #[1];}}}
3186  if (size(#) > 1){if (typeof(#[1])=="int"){if (#[2] > 0){n = #[2];}}}
3187  list L;
3188  L = lp2ivId(normalize(lead(G)));
3189  L = ivSickleDim(L,n,degbound);
3190  L[2] = ivL2lpI(L[2]);
3191  return(L);
3192}
3193example
3194{
3195  "EXAMPLE:"; echo = 2;
3196  ring r = 0,(x,y),dp;
3197  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
3198  setring R; // sets basering to Letterplace ring
3199  ideal G = x(1)*x(2), y(1)*y(2),x(1)*y(2)*x(3); // ideal G contains a
3200  //Groebner basis
3201  lpSickleDim(G); // invokes the procedure with ring parameters
3202  // the factor algebra is finite, so the degree bound given by the Letterplace
3203  // ring is not necessary
3204  lpSickleDim(G,0); // procedure without any degree bound
3205}
3206
3207proc lpSickleHil(ideal G, list #)
3208"USAGE: lpSickleHil(G);
3209RETURN: list
3210PURPOSE:Computing the Hilbert series and the mistletoes
3211ASSUME: - basering is a Letterplace ring.
3212@*      - if you specify a different degree bound degbound,
3213@*        degbound <= attrib(basering,uptodeg) holds.
3214NOTE: - If L is the list returned, then L[1] is an intvec, corresponding to the
3215@*      Hilbert series, L[2] is an ideal, the mistletoes.
3216@*    - If degbound is set, there will be a degree bound added. 0 means no
3217@*      degree bound. Default: attrib(basering,uptodeg).
3218@*    - n is the number of variables, which can be set to a different number.
3219@*      Default: attrib(basering, lV).
3220@*    - If I = L[1] is the intvec returned, then I[k] is the (k-1)-th
3221@*      coefficient of the Hilbert series.
3222@*    - If the K-dimension is known to be infinite, a degree bound is needed
3223EXAMPLE: example lpSickleHil; shows examples
3224"
3225{int degbound = attrib(basering,"uptodeg");int n = attrib(basering, "lV");
3226  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] >= 0){degbound = #[1];}}}
3227  if (size(#) > 1){if (typeof(#[1])=="int"){if (#[2] > 0){n = #[2];}}}
3228  list L;
3229  L = lp2ivId(normalize(lead(G)));
3230  L = ivSickleHil(L,n,degbound);
3231  L[2] =  ivL2lpI(L[2]);
3232  return(L);
3233}
3234example
3235{
3236  "EXAMPLE:"; echo = 2;
3237  ring r = 0,(x,y),dp;
3238  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
3239  setring R; // sets basering to Letterplace ring
3240  ideal G = x(1)*x(2), y(1)*y(2),x(1)*y(2)*x(3); // ideal G contains a
3241  //Groebner basis
3242  lpSickleHil(G); // invokes the procedure with ring parameters
3243  // the factor algebra is finite, so the degree bound given by the Letterplace
3244  // ring is not necessary
3245  lpSickleHil(G,0); // procedure without any degree bound
3246}
3247
3248proc sickle(ideal G, list #)
3249"USAGE: sickle(G[,m, d, h, degbound]); G an ideal; m,d,h,degbound optional
3250@*      integers
3251RETURN: list
3252PURPOSE:Allowing the user to access all procs with one command
3253ASSUME: - basering is a Letterplace ring.
3254@*      - if you specify a different degree bound degbound,
3255@*        degbound <= attrib(basering,uptodeg) holds.
3256NOTE:   The returned object will always be a list, but the entries of the
3257@*      returned list may be very different
3258@* case m=1,d=1,h=1: see lpDHilbertSickle
3259@* case m=1,d=1,h=0: see lpSickleDim
3260@* case m=1,d=0,h=1: see lpSickleHil
3261@* case m=1,d=0,h=0: see lpSickle (this is the default case)
3262@* case m=0,d=1,h=1: see lpDHilbert
3263@* case m=0,d=1,h=0: see lpKDim
3264@* case m=0,d=0,h=1: see lpHilbert
3265@* case m=0,d=0,h=0: returns an error
3266@*    - If degbound is set, there will be a degree bound added. 0 means no
3267@*      degree bound. Default: attrib(basering,uptodeg).
3268@*    - If the K-dimension is known to be infinite, a degree bound is needed
3269EXAMPLE: example sickle; shows examples
3270"
3271{int m,d,h,degbound;
3272  m = 1; d = 0; h = 0; degbound = attrib(basering,"uptodeg");
3273  if (size(#) > 0) {if (typeof(#[1])=="int"){if (#[1] < 1) {m = 0;}}}
3274  if (size(#) > 1) {if (typeof(#[1])=="int"){if (#[2] > 0) {d = 1;}}}
3275  if (size(#) > 2) {if (typeof(#[1])=="int"){if (#[3] > 0) {h = 1;}}}
3276  if (size(#) > 3) {if (typeof(#[1])=="int"){if (#[4] >= 0) {degbound = #[4];}}}
3277  if (m == 1)
3278  {if (d == 0)
3279    {if (h == 0) {return(lpSickle(G,degbound,attrib(basering,"lV")));}
3280      else        {return(lpSickleHil(G,degbound,attrib(basering,"lV")));}
3281    }
3282    else
3283    {if (h == 0) {return(lpSickleDim(G,degbound,attrib(basering,"lV")));}
3284      else {return(lpDHilbertSickle(G,degbound,attrib(basering,"lV")));}
3285    }
3286  }
3287  else
3288  {if (d == 0)
3289    {if (h == 0) {ERROR("You request to do nothing, so relax and do so");}
3290      else        {return(lpHilbert(G,degbound,attrib(basering,"lV")));}
3291    }
3292    else
3293    {if (h == 0) {return(lpKDim(G,degbound,attrib(basering,"lV")));}
3294      else {return(lpDHilbert(G,degbound,attrib(basering,"lV")));}
3295    }
3296  }
3297}
3298example
3299{
3300  "EXAMPLE:"; echo = 2;
3301  ring r = 0,(x,y),dp;
3302  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
3303  setring R; // sets basering to Letterplace ring
3304  ideal G = x(1)*x(2), y(1)*y(2),x(1)*y(2)*x(3);
3305  // G contains a Groebner basis
3306  sickle(G,1,1,1); // computes mistletoes, K-dimension and the Hilbert series
3307  sickle(G,1,0,0); // computes mistletoes only
3308  sickle(G,0,1,0); // computes K-dimension only
3309  sickle(G,0,0,1); // computes Hilbert series only
3310}
3311
3312///////////////////////////////////////////////////////////////////////////////
3313/* vl: new stuff for conversion to Magma and to SD
3314todo: doc, example
3315 */
3316proc extractVars(r)
3317{
3318  int i = 1;
3319  int j = 1;
3320  string candidate;
3321  list result = list();
3322  for (i = 1; i<=nvars(r);i++)
3323  {
3324    candidate = string(var(i))[1,find(string(var(i)),"(")-1];
3325    if (!inList(result, candidate))
3326    {
3327      result = insert(result,candidate,size(result));
3328    }
3329  }
3330  return(result);
3331}
3332
3333proc letterPlacePoly2MagmaString(poly h)
3334{
3335  int pos;
3336  string s = string(h);
3337  while(find(s,"("))
3338  {
3339    pos = find(s,"(");
3340    while(s[pos]!=")")
3341    {
3342      s = s[1,pos-1]+s[pos+1,size(s)-pos];
3343    }
3344    if (size(s)!=pos)
3345    {
3346      s = s[1,pos-1]+s[pos+1,size(s)-pos]; // The last (")")
3347    }
3348    else
3349    {
3350      s = s[1,pos-1];
3351    }
3352  }
3353  return(s);
3354}
3355
3356proc letterPlaceIdeal2SD(ideal I, int upToDeg)
3357{
3358  int i;
3359  print("Don't forget to fill in the formal Data in the file");
3360  string result = "<?xml version=\"1.0\"?>"+newline+"<FREEALGEBRA createdAt=\"\" createdBy=\"Singular\" id=\"FREEALGEBRA/\">"+newline;
3361  result = result + "<vars>"+string(extractVars(basering))+"</vars>"+newline;
3362  result = result + "<basis>"+newline;
3363  for (i = 1;i<=size(I);i++)
3364  {
3365    result = result + "<poly>"+letterPlacePoly2MagmaString(I[i])+"</poly>"+newline;
3366  }
3367  result = result + "</basis>"+newline;
3368  result = result + "<uptoDeg>"+ string(upToDeg)+"</uptoDeg>"+newline;
3369  result = result + "<Comment></Comment>"+newline;
3370  result = result + "<Version></Version>"+newline;
3371  result = result + "</FREEALGEBRA>";
3372  return(result);
3373}
3374
3375
3376///////////////////////////////////////////////////////////////////////////////
3377
3378
3379proc tst_fpadim()
3380{
3381  example ivDHilbert;
3382  example ivDHilbertSickle;
3383  example ivDimCheck;
3384  example ivHilbert;
3385  example ivKDim;
3386  example ivMis2Base;
3387  example ivMis2Dim;
3388  example ivOrdMisLex;
3389  example ivSickle;
3390  example ivSickleHil;
3391  example ivSickleDim;
3392  example lpDHilbert;
3393  example lpDHilbertSickle;
3394  example lpHilbert;
3395  example lpDimCheck;
3396  example lpKDim;
3397  example lpMis2Base;
3398  example lpMis2Dim;
3399  example lpOrdMisLex;
3400  example lpSickle;
3401  example lpSickleHil;
3402  example lpSickleDim;
3403  example sickle;
3404  example ivL2lpI;
3405  example iv2lp;
3406  example iv2lpList;
3407  example iv2lpMat;
3408  example lp2iv;
3409  example lp2ivId;
3410  example lpId2ivLi;
3411  example lpGkDim;
3412  example lpGlDimBound;
3413  example lpSubstitute;
3414}
3415
3416
3417/*proc lpSubstituteExpandRing(poly f, list s1, list s2) {*/
3418/*int minDegBound = calcSubstDegBound(f,s1,s2);*/
3419/**/
3420/*def R = basering; // curr lp ring*/
3421/*setring ORIGINALRING; // non lp ring TODO*/
3422/*def R1 = makeLetterplaceRing(minDegBound);*/
3423/*setring R1;*/
3424/**/
3425/*poly g = lpSubstitute(imap(R,f), imap(R,s1), imap(R,s2));*/
3426/**/
3427/*return (R1); // return the new ring*/
3428/*}*/
3429
3430proc lpSubstitute(poly f, ideal s1, ideal s2, list #)
3431"USAGE: lpSubstitute(f,s1,s2[,G]); f letterplace polynomial, s1 list (ideal) of variables
3432@*      to replace, s2 list (ideal) of polynomials to replace with, G optional ideal to
3433@*      reduce with.
3434RETURN: poly, the substituted polynomial
3435ASSUME: - basering is a Letterplace ring
3436@*      - G is a groebner basis,
3437@*      - the current ring has a sufficient degbound (can be calculated with
3438    @*    calcSubstDegBound())
3439EXAMPLE: example lpSubstitute; shows examples
3440"
3441{
3442  ideal G;
3443  if (size(#) > 0) {
3444    if (typeof(#[1])=="ideal") {
3445      G = #[1];
3446    }
3447  }
3448
3449  poly fs;
3450  for (int i = 1; i <= size(f); i++) {
3451    poly fis = leadcoef(f[i]);
3452    intvec ivfi = lp2iv(f[i]);
3453    for (int j = 1; j <= size(ivfi); j++) {
3454      int varindex = ivfi[j];
3455      int subindex = lpIndexOf(s1, var(varindex));
3456      if (subindex > 0) {
3457        s2[subindex] = lpNF(s2[subindex],G);
3458        fis = lpMult(fis, s2[subindex]);
3459      } else {
3460        fis = lpMult(fis, lpNF(iv2lp(varindex),G));
3461      }
3462      /*fis = lpNF(fis,G);*/
3463    }
3464    fs = fs + fis;
3465  }
3466  fs = lpNF(fs, G);
3467  return (fs);
3468}
3469example {
3470  LIB "fpadim.lib";
3471  ring r = 0,(x,y,z),dp;
3472  def R = makeLetterplaceRing(4);
3473  setring R;
3474
3475  ideal G = x(1)*y(2); // optional
3476
3477  poly f = 3*x(1)*x(2)+y(1)*x(2);
3478  ideal s1 = x(1), y(1);
3479  ideal s2 = y(1)*z(2)*z(3), x(1);
3480
3481  // the substitution probably needs a higher degbound
3482  int minDegBound = calcSubstDegBounds(f,s1,s2);
3483  setring r;
3484  def R1 = makeLetterplaceRing(minDegBound);
3485  setring R1;
3486
3487  // the last parameter is optional
3488  lpSubstitute(imap(R,f), imap(R,s1), imap(R,s2), imap(R,G));
3489}
3490example {
3491  LIB "fpadim.lib";
3492  ring r = 0,(x,y,z),dp;
3493  def R = makeLetterplaceRing(4);
3494  setring R;
3495
3496  poly f = 3*x(1)*x(2)+y(1)*x(2);
3497  poly g = z(1)*x(2)+y(1);
3498  poly h = 7*x(1)*z(2)+x(1);
3499  ideal I = f,g,h;
3500  ideal s1 = x(1), y(1);
3501  ideal s2 = y(1)*z(2)*z(3), x(1);
3502
3503  int minDegBound = calcSubstDegBounds(I,s1,s2);
3504  setring r;
3505  def R1 = makeLetterplaceRing(minDegBound);
3506  setring R1;
3507
3508  ideal I = imap(R,I);
3509  ideal s1 = imap(R,s1);
3510  ideal s2 = imap(R,s2);
3511  for (int i = 1; i <= size(I); i++) {
3512    lpSubstitute(I[i], s1, s2);
3513  }
3514}
3515
3516static proc lpIndexOf(ideal I, poly p) {
3517  for (int i = 1; i <= size(I); i++) {
3518    if (I[i] == p) {
3519      return (i);
3520    }
3521  }
3522  return (-1);
3523}
3524
3525static proc ivIndexOf(list L, intvec iv) {
3526  for (int i = 1; i <= size(L); i++) {
3527    if (L[i] == iv) {
3528      return (i);
3529    }
3530  }
3531  return (-1);
3532}
3533
3534
3535proc calcSubstDegBound(poly f, ideal s1, ideal s2)
3536"USAGE: calcSubstDegBound(f,s1,s2); f letterplace polynomial, s1 list (ideal) of variables
3537@*      to replace, s2 list (ideal) of polynomials to replace with
3538RETURN: int, the min degbound required to perform the substitution
3539ASSUME: - basering is a Letterplace ring
3540EXAMPLE: example lpSubstitute; shows examples
3541"
3542{
3543  int maxDegBound = 0;
3544  for (int i = 1; i <= size(f); i++) {
3545    intvec ivfi = lp2iv(f[i]);
3546    int tmpDegBound;
3547    for (int j = 1; j <= size(ivfi); j++) {
3548      int varindex = ivfi[j];
3549      int subindex = lpIndexOf(s1, var(varindex));
3550      if (subindex > 0) {
3551        tmpDegBound = tmpDegBound + deg(s2[subindex]);
3552      } else {
3553        tmpDegBound = tmpDegBound + 1;
3554      }
3555    }
3556    if (tmpDegBound > maxDegBound) {
3557      maxDegBound = tmpDegBound;
3558    }
3559  }
3560
3561  // increase degbound by 50% when ideal is provided
3562  // needed for lpNF
3563  maxDegBound = maxDegBound + maxDegBound/2;
3564
3565  return (maxDegBound);
3566}
3567
3568// convenience method
3569proc calcSubstDegBounds(ideal I, ideal s1, ideal s2)
3570"USAGE: calcSubstDegBounds(I,s1,s2); I list (ideal) of letterplace polynomials, s1 list (ideal)
3571@*      of variables to replace, s2 list (ideal) of polynomials to replace with
3572RETURN: int, the min degbound required to perform all of the substitutions
3573ASSUME: - basering is a Letterplace ring
3574EXAMPLE: example lpSubstitute; shows examples
3575"
3576{
3577  int maxDegBound = 0;
3578  for (int i = 1; i <= size(I); i++) {
3579    int tmpDegBound = calcSubstDegBound(I[i], s1, s2, #);
3580    if (tmpDegBound > maxDegBound) {
3581      maxDegBound = tmpDegBound;
3582    }
3583  }
3584  return (maxDegBound);
3585}
3586
3587
3588/*
3589   Here are some examples one may try. Just copy them into your console.
3590   These are relations for braid groups, up to degree d:
3591
3592
3593   LIB "fpadim.lib";
3594   ring r = 0,(x,y,z),dp;
3595   int d =10; // degree
3596   def R = makeLetterplaceRing(d);
3597   setring R;
3598   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),
3599   z(1)*x(2)*z(3) - y(1)*z(2)*x(3), x(1)*x(2)*x(3) + y(1)*y(2)*y(3) +
3600   z(1)*z(2)*z(3) + x(1)*y(2)*z(3);
3601   option(prot);
3602   option(redSB);option(redTail);option(mem);
3603   ideal J = system("freegb",I,d,3);
3604   lpDimCheck(J);
3605   sickle(J,1,1,1,d);//Computes mistletoes, K-dimension and the Hilbert series
3606
3607
3608
3609   LIB "fpadim.lib";
3610   ring r = 0,(x,y,z),dp;
3611   int d =11; // degree
3612   def R = makeLetterplaceRing(d);
3613   setring R;
3614   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),
3615   z(1)*x(2)*z(3) - y(1)*z(2)*x(3), x(1)*x(2)*x(3) + y(1)*y(2)*y(3) +
3616   z(1)*z(2)*z(3) + x(1)*y(2)*z(3);
3617   option(prot);
3618   option(redSB);option(redTail);option(mem);
3619   ideal J = system("freegb",I,d,3);
3620   lpDimCheck(J);
3621   sickle(J,1,1,1,d);
3622
3623
3624
3625   LIB "fpadim.lib";
3626   ring r = 0,(x,y,z),dp;
3627   int d  = 6; // degree
3628   def R  = makeLetterplaceRing(d);
3629   setring R;
3630   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),
3631   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);
3632   option(prot);
3633   option(redSB);option(redTail);option(mem);
3634   ideal J = system("freegb",I,d,3);
3635   lpDimCheck(J);
3636   sickle(J,1,1,1,d);
3637 */
3638
3639/*
3640   Here are some examples, which can also be found in [studzins]:
3641
3642// takes up to 880Mb of memory
3643LIB "fpadim.lib";
3644ring r = 0,(x,y,z),dp;
3645int d =10; // degree
3646def R = makeLetterplaceRing(d);
3647setring R;
3648ideal I =
3649z(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);
3650option(prot);
3651option(redSB);option(redTail);option(mem);
3652ideal J = system("freegb",I,d,nvars(r));
3653lpDimCheck(J);
3654sickle(J,1,1,1,d); // dimension is 24872
3655
3656
3657LIB "fpadim.lib";
3658ring r = 0,(x,y,z),dp;
3659int d =10; // degree
3660def R = makeLetterplaceRing(d);
3661setring R;
3662ideal 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);
3663option(prot);
3664option(redSB);option(redTail);option(mem);
3665ideal J = system("freegb",I,d,3);
3666lpDimCheck(J);
3667sickle(J,1,1,1,d);
3668 */
3669
3670
3671/*
3672   Example for computing GK dimension:
3673   returns a ring which contains an ideal I
3674   run gkDim(I) inside this ring and it should return 2n (the GK dimension
3675   of n-th Weyl algebra including evaluation operators).
3676
3677   proc createWeylEx(int n, int d)
3678   "
3679   "
3680   {
3681   int baseringdef;
3682   if (defined(basering)) // if a basering is defined, it should be saved for later use
3683   {
3684   def save = basering;
3685   baseringdef = 1;
3686   }
3687   ring r = 0,(d(1..n),x(1..n),e(1..n)),dp;
3688   def R = makeLetterplaceRing(d);
3689   setring R;
3690   ideal I; int i,j;
3691
3692   for (i = 1; i <= n; i++)
3693   {
3694   for (j = i+1; j<= n; j++)
3695   {
3696   I[size(I)+1] = lpMult(var(i),var(j));
3697   }
3698   }
3699
3700   for (i = 1; i <= n; i++)
3701   {
3702   for (j = i+1; j<= n; j++)
3703   {
3704   I[size(I)+1] = lpMult(var(n+i),var(n+j));
3705   }
3706   }
3707   for (i = 1; i <= n; i++)
3708   {
3709   for (j = 1; j<= n; j++)
3710   {
3711   I[size(I)+1] = lpMult(var(i),var(n+j));
3712   }
3713   }
3714   for (i = 1; i <= n; i++)
3715   {
3716   for (j = 1; j<= n; j++)
3717   {
3718   I[size(I)+1] = lpMult(var(i),var(2*n+j));
3719   }
3720   }
3721   for (i = 1; i <= n; i++)
3722   {
3723   for (j = 1; j<= n; j++)
3724   {
3725   I[size(I)+1] = lpMult(var(2*n+i),var(n+j));
3726   }
3727   }
3728   for (i = 1; i <= n; i++)
3729   {
3730   for (j = 1; j<= n; j++)
3731   {
3732   I[size(I)+1] = lpMult(var(2*n+i),var(2*n+j));
3733   }
3734   }
3735   I = simplify(I,2+4);
3736   I = letplaceGBasis(I);
3737   export(I);
3738   if (baseringdef == 1) {setring save;}
3739   return(R);
3740   }
3741
3742proc TestGKAuslander3()
3743{
3744  ring r = (0,q),(z,x,y),(dp(1),dp(2));
3745  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
3746  R; setring R; // sets basering to Letterplace ring
3747  ideal I;
3748  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);
3749  I = letplaceGBasis(I);
3750  lpGkDim(I); // must be 3
3751  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
3752  I = letplaceGBasis(I); // not finite BUT contains a poly in x,y only
3753  lpGkDim(I); // must be 4
3754
3755  ring r = 0,(y,x,z),dp;
3756  def R = makeLetterplaceRing(10); // constructs a Letterplace ring
3757  R; setring R; // sets basering to Letterplace ring
3758  ideal I;
3759  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
3760  I = letplaceGBasis(I); // computed as it would be homogenized; infinite
3761  poly p = x(1)*y(2)*y(3)*x(4)-y(1)*x(2)*x(3)*y(4);
3762  lpNF(p, I); // 0 as expected
3763
3764  // with inverse of z
3765  ring r = 0,(iz,z,x,y),dp;
3766  def R = makeLetterplaceRing(11); // constructs a Letterplace ring
3767  R; setring R; // sets basering to Letterplace ring
3768  ideal I;
3769  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),
3770    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;
3771  I = letplaceGBasis(I); //
3772  setring r;
3773  def R2 = makeLetterplaceRing(23); // constructs a Letterplace ring
3774  setring R2; // sets basering to Letterplace ring
3775  ideal I = imap(R,I);
3776  lpGkDim(I);
3777
3778
3779  ring r = 0,(t,z,x,y),(dp(2),dp(2));
3780  def R = makeLetterplaceRing(20); // constructs a Letterplace ring
3781  R; setring R; // sets basering to Letterplace ring
3782  ideal I;
3783  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),
3784    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
3785  I = letplaceGBasis(I); // computed as it would be homogenized; infinite
3786  LIB "elim.lib";
3787  ideal Inoz = nselect(I,intvec(2,6,10,14,18,22,26,30));
3788  for(int i=1; i<=20; i++)
3789  {
3790    Inoz=subst(Inoz,t(i),1);
3791  }
3792  ideal J = x(1)*y(2)*y(3)*x(4)-y(1)*x(2)*x(3)*y(4);
3793  J = letplaceGBasis(J);
3794
3795  poly p = x(1)*y(2)*y(3)*x(4)-y(1)*x(2)*x(3)*y(4);
3796  lpNF(p, I); // 0 as expected
3797
3798  ring r2 = 0,(x,y),dp;
3799  def R2 = makeLetterplaceRing(50); // constructs a Letterplace ring
3800  setring R2;
3801  ideal J = x(1)*y(2)*y(3)*x(4)-y(1)*x(2)*x(3)*y(4);
3802  J = letplaceGBasis(J);
3803}
3804
3805*/
3806
3807
3808/*   actual work:
3809// downup algebra A
3810LIB "fpadim.lib";
3811ring r = (0,a,b,g),(x,y),Dp;
3812def R = makeLetterplaceRing(6); // constructs a Letterplace ring
3813setring R;
3814poly F1 = g*x(1);
3815poly F2 = g*y(1);
3816ideal J = x(1)*x(2)*y(3)-a*x(1)*y(2)*x(3) - b*y(1)*x(2)*x(3) - F1,
3817x(1)*y(2)*y(3)-a*y(1)*x(2)*y(3) - b*y(1)*y(2)*x(3) - F2;
3818J = letplaceGBasis(J);
3819lpGkDim(J); // 3 == correct
3820
3821// downup algebra B
3822LIB "fpadim.lib";
3823ring r = (0,a,b,g, p(1..7),q(1..7)),(x,y),Dp;
3824def R = makeLetterplaceRing(6); // constructs a Letterplace ring
3825setring R;
3826ideal 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);
3827int i;
3828poly F1, F2;
3829for(i=1;i<=7;i++)
3830{
3831F1 = F1 + p(i)*imn[i];
3832F2 = F2 + q(i)*imn[i];
3833}
3834ideal J = x(1)*x(2)*y(3)-a*x(1)*y(2)*x(3) - b*y(1)*x(2)*x(3) - F1,
3835x(1)*y(2)*y(3)-a*y(1)*x(2)*y(3) - b*y(1)*y(2)*x(3) - F2;
3836J = letplaceGBasis(J);
3837lpGkDim(J); // 3 == correct
3838
3839 */
Note: See TracBrowser for help on using the repository browser.