source: git/Singular/LIB/fpadim.lib @ a62db6

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