source: git/Singular/LIB/fpadim.lib @ 5482b19

fieker-DuValspielwiese
Last change on this file since 5482b19 was 5482b19, checked in by Karim Abou Zeid <karim23697@…>, 7 years ago
Global dimension for ideals which contain single variables.
  • Property mode set to 100644
File size: 99.6 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 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 isSF(intvec S, intvec I)
884"
885PURPOSE:
886checks, if a word P is a suffix of another word I
887"
888{
889 int n = size(S);
890 if (n <= 0) {return(1);}
891 int m = size(I);
892 if (m < n) {return(0);}
893 intvec IS = I[(m-n+1)..m];
894 if (IS == S) {return(1);}
895 else {return(0);}
896}
897
898static proc isIF(intvec IF, intvec I)
899"
900PURPOSE:
901checks, if a word IF is an infix of another word I
902"
903{
904 int n = size(IF);
905 int m = size(I);
906
907 if (n <= 0) {
908   return(1);
909 }
910 if (m < n) {
911   return(0);
912 }
913
914 for (int i = 0; (n + i) <= m; i++){
915   intvec IIF = I[(1 + i)..(n + i)];
916   if (IIF == IF) {
917     return(1);
918   }
919 }
920 return(0);
921}
922
923proc ivL2lpI(list L)
924"USAGE: ivL2lpI(L); L a list of intvecs
925RETURN: ideal
926PURPOSE:Transforming a list of intvecs into an ideal of Letterplace monomials
927ASSUME: - Intvec corresponds to a Letterplace monomial
928@*      - basering has to be a Letterplace ring
929EXAMPLE: example ivL2lpI; shows examples
930"
931{checkAssumptions(0,L);
932  int i; ideal G;
933  poly p;
934  for (i = 1; i <= size(L); i++)
935  {p = iv2lp(L[i]);
936    G[(size(G) + 1)] = p;
937  }
938  return(G);
939}
940example
941{
942  "EXAMPLE:"; echo = 2;
943  ring r = 0,(x,y,z),dp;
944  def R = makeLetterplaceRing(5);// constructs a Letterplace ring
945  setring R; //sets basering to Letterplace ring
946  intvec u = 1,1,2; intvec v = 2,1,3; intvec w = 3,1,1;
947  // u = x^2y, v = yxz, w = zx^2 in intvec representation
948  list L = u,v,w;
949  ivL2lpI(L);// invokes the procedure, returns the ideal containing u,v,w
950}
951
952proc iv2lp(intvec I)
953"USAGE: iv2lp(I); I an intvec
954RETURN: poly
955PURPOSE:Transforming an intvec into the corresponding Letterplace polynomial
956ASSUME: - Intvec corresponds to a Letterplace monomial
957@*      - basering has to be a Letterplace ring
958NOTE:   - Assumptions will not be checked!
959EXAMPLE: example iv2lp; shows examples
960"
961{if (I[1] == 0) {return(1);}
962  int i = size(I);
963  if (i > attrib(basering,"uptodeg")) {ERROR("polynomial exceeds degreebound");}
964  int j; poly p = 1;
965  for (j = 1; j <= i; j++) {if (I[j] > 0) { p = lpMult(p,var(I[j]));}} //ignore zeroes, because they correspond to 1
966  return(p);
967}
968example
969{
970  "EXAMPLE:"; echo = 2;
971  ring r = 0,(x,y,z),dp;
972  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
973  setring R; //sets basering to Letterplace ring
974  intvec u = 1,1,2; intvec v = 2,1,3; intvec w = 3,1,1;
975  // u = x^2y, v = yxz, w = zx^2 in intvec representation
976  iv2lp(u); // invokes the procedure and returns the corresponding poly
977  iv2lp(v);
978  iv2lp(w);
979}
980
981proc iv2lpList(list L)
982"USAGE: iv2lpList(L); L a list of intmats
983RETURN: ideal
984PURPOSE:Converting a list of intmats into an ideal of corresponding monomials
985ASSUME: - The rows of each intmat in L must correspond to a Letterplace monomial
986@*      - basering has to be a Letterplace ring
987EXAMPLE: example iv2lpList; shows examples
988"
989{checkAssumptions(0,L);
990  ideal G;
991  int i;
992  for (i = 1; i <= size(L); i++){G = G + iv2lpMat(L[i]);}
993  return(G);
994}
995example
996{
997  "EXAMPLE:"; echo = 2;
998  ring r = 0,(x,y,z),dp;
999  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
1000  setring R; // sets basering to Letterplace ring
1001  intmat u[3][1] = 1,1,2; intmat v[1][3] = 2,1,3; intmat w[2][3] = 3,1,1,2,3,1;
1002  // defines intmats of different size containing intvec representations of
1003  // monomials as rows
1004  list L = u,v,w;
1005  print(u); print(v); print(w); // shows the intmats contained in L
1006  iv2lpList(L); // returns the corresponding monomials as an ideal
1007}
1008
1009
1010proc iv2lpMat(intmat M)
1011"USAGE: iv2lpMat(M); M an intmat
1012RETURN: ideal
1013PURPOSE:Converting an intmat into an ideal of the corresponding monomials
1014ASSUME: - The rows of M must correspond to Letterplace monomials
1015@*      - basering has to be a Letterplace ring
1016EXAMPLE: example iv2lpMat; shows examples
1017"
1018{list L = M;
1019  checkAssumptions(0,L);
1020  kill L;
1021  ideal G; poly p;
1022  int i; intvec I;
1023  for (i = 1; i <= nrows(M); i++)
1024  { I = M[i,1..ncols(M)];
1025    p = iv2lp(I);
1026    G[size(G)+1] = p;
1027  }
1028  return(G);
1029}
1030example
1031{
1032  "EXAMPLE:"; echo = 2;
1033  ring r = 0,(x,y,z),dp;
1034  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
1035  setring R; // sets basering to Letterplace ring
1036  intmat u[3][1] = 1,1,2; intmat v[1][3] = 2,1,3; intmat w[2][3] = 3,1,1,2,3,1;
1037  // defines intmats of different size containing intvec representations of
1038  // monomials as rows
1039  iv2lpMat(u); // returns the monomials contained in u
1040  iv2lpMat(v); // returns the monomials contained in v
1041  iv2lpMat(w); // returns the monomials contained in w
1042}
1043
1044proc lpId2ivLi(ideal G)
1045"USAGE: lpId2ivLi(G); G an ideal
1046RETURN: list
1047PURPOSE:Transforming an ideal into the corresponding list of intvecs
1048ASSUME: - basering has to be a Letterplace ring
1049EXAMPLE: example lpId2ivLi; shows examples
1050"
1051{int i,j,k;
1052  list M;
1053  checkAssumptions(0,M);
1054  for (i = 1; i <= size(G); i++) {M[i] = lp2iv(G[i]);}
1055  return(M);
1056}
1057example
1058{
1059  "EXAMPLE:"; echo = 2;
1060  ring r = 0,(x,y),dp;
1061  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
1062  setring R; // sets basering to Letterplace ring
1063  ideal L = x(1)*x(2),y(1)*y(2),x(1)*y(2)*x(3);
1064  lpId2ivLi(L); // returns the corresponding intvecs as a list
1065}
1066
1067proc lp2iv(poly p)
1068"USAGE: lp2iv(p); p a poly
1069RETURN: intvec
1070PURPOSE:Transforming a monomial into the corresponding intvec
1071ASSUME: - basering has to be a Letterplace ring
1072NOTE:   - Assumptions will not be checked!
1073EXAMPLE: example lp2iv; shows examples
1074"
1075{p = normalize(lead(p));
1076  intvec I;
1077  int i,j;
1078  if (deg(p) > attrib(basering,"uptodeg")) {ERROR("Monomial exceeds degreebound");}
1079  if (p == 1) {return(I);}
1080  if (p == 0) {ERROR("Monomial is not allowed to equal zero");}
1081  intvec lep = leadexp(p);
1082  for ( i = 1; i <= attrib(basering,"lV"); i++) {if (lep[i] == 1) {I = i; break;}}
1083  for (i = (attrib(basering,"lV")+1); i <= size(lep); i++)
1084  {if (lep[i] == 1)
1085    { j = (i mod attrib(basering,"lV"));
1086      if (j == 0) {I = I,attrib(basering,"lV");}
1087      else {I = I,j;}
1088    }
1089    else { if (lep[i] > 1) {ERROR("monomial has a not allowed multidegree");}}
1090  }
1091  if (I[1] == 0) {ERROR("monomial has a not allowed multidegree");}
1092
1093  return(I);
1094}
1095example
1096{
1097  "EXAMPLE:"; echo = 2;
1098  ring r = 0,(x,y,z),dp;
1099  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
1100  setring R; // sets basering to Letterplace ring
1101  poly p = x(1)*x(2)*z(3); poly q = y(1)*y(2)*x(3)*x(4);
1102  poly w= z(1)*y(2)*x(3)*z(4)*z(5);
1103  // p,q,w are some polynomials we want to transform into their
1104  // intvec representation
1105  lp2iv(p); lp2iv(q); lp2iv(w);
1106}
1107
1108proc lp2ivId(ideal G)
1109"USAGE: lp2ivId(G); G an ideal
1110RETURN: list
1111PURPOSE:Converting an ideal into an list of intmats,
1112@*      the corresponding intvecs forming the rows
1113ASSUME: - basering has to be a Letterplace ring
1114EXAMPLE: example lp2ivId; shows examples
1115"
1116{G = normalize(lead(G));
1117  intvec I; list L;
1118  checkAssumptions(0,L);
1119  int i,md;
1120  for (i = 1; i <= size(G); i++) { if (md <= deg(G[i])) {md = deg(G[i]);}}
1121  while (size(G) > 0)
1122  {ideal Gt;
1123    for (i = 1; i <= ncols(G); i++) {if (md == deg(G[i])) {Gt = Gt + G[i]; G[i] = 0;}}
1124    if (size(Gt) > 0)
1125    {G = simplify(G,2);
1126      intmat M [size(Gt)][md];
1127      for (i = 1; i <= size(Gt); i++) {M[i,1..md] = lp2iv(Gt[i]);}
1128      L = insert(L,M);
1129      kill M; kill Gt;
1130      md = md - 1;
1131    }
1132    else {kill Gt; md = md - 1;}
1133  }
1134  return(L);
1135}
1136example
1137{
1138  "EXAMPLE:"; echo = 2;
1139  ring r = 0,(x,y,z),dp;
1140  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
1141  setring R; // sets basering to Letterplace ring
1142  poly p = x(1)*x(2)*z(3); poly q = y(1)*y(2)*x(3)*x(4);
1143  poly w = z(1)*y(2)*x(3)*z(4);
1144  // p,q,w are some polynomials we want to transform into their
1145  // intvec representation
1146  ideal G = p,q,w;
1147  // define the ideal containing p,q and w
1148  lp2ivId(G); // and return the list of intmats for this ideal
1149}
1150
1151// -----------------main procedures----------------------
1152
1153static proc lpUfGkDim(ideal G)
1154{
1155  G = lead(G);
1156
1157  // check special case 1
1158  int l = 0;
1159  for (int i = 1; i <= size(G); i++) {
1160    // find the max degree in G
1161    int d = deg(G[i]);
1162    if (d > l) {
1163      l = d;
1164    }
1165
1166    // also if G is the whole ring return minus infinity
1167    if (leadmonom(G[i]) == 1) {
1168      return(-2); // minus infinity
1169    }
1170  }
1171  // if longest word has length 1 we handle it as a special case
1172  if (l == 1) {
1173    int n = attrib(basering, "lV"); // variable count
1174    int k = size(G);
1175    if (k == n) {
1176      return(0);
1177    }
1178    if (k == n-1) {
1179      return(1);
1180    }
1181    if (k <= n-2) {
1182      return(-1);
1183    }
1184  }
1185
1186  int t = rtimer; // DEBUG
1187  intmat UG = lpUfGraph(G);
1188  printf("lpUfGraph took %p", rtimer - t); // DEBUG
1189
1190  // check special case 2
1191  intmat zero[nrows(UG)][ncols(UG)];
1192  if (UG == zero) {
1193    return (0);
1194  }
1195
1196  // check special case 3
1197  UG = topologicalSort(UG);
1198
1199  if (imIsUpRightTriangle(UG)) {
1200    UG = eliminateZerosUpTriangle(UG);
1201    // already ensured that UG != 0
1202    return(UfGraphURTNZDGrowth(UG));
1203  }
1204
1205  // otherwise count cycles in the Ufnarovskij Graph
1206  int t = rtimer; // DEBUG
1207  int gkdim = UfGraphGrowth(UG);
1208  printf("UfGraphGrowth took %p", rtimer - t); // DEBUG
1209  return(gkdim);
1210}
1211
1212static proc UfGraphURTNZDGrowth(intmat UG) {
1213  // URTNZD = upper right triangle non zero diagonal
1214  for (int i = 1; i <= ncols(UG); i++) {
1215    UG[i,i] = 0; // remove all loops
1216  }
1217  intmat UGk = UG;
1218  intmat zero[nrows(UGk)][ncols(UGk)];
1219  int k = 1;
1220  while (UGk != zero) {
1221    UGk = UGk * UG;
1222    k++;
1223  }
1224  return (k);
1225}
1226
1227proc imIsUpRightTriangle(intmat M) {
1228  for (int i = 1; i <= nrows(M); i++) {
1229    for (int j = 1; j < i; j++) {
1230      if(M[i,j] != 0) { return (0); }
1231    }
1232  }
1233  return (1);
1234}
1235
1236static proc eliminateZerosUpTriangle(intmat G) {
1237  // G is expected to be an upper triangle matrix
1238  for (int i = 1; i <= ncols(G); i++) {
1239    if (G[i,i] == 0) { // i doesn't have a cycle
1240      for (int j = 1; j < i; j++) {
1241        if (G[j,i] == 1) { // j has an edge to i
1242          for (int k = i + 1; k <= nrows(G); k++) {
1243            if (G[i,k] == 1) {
1244              G[j,k] = G[i,k]; // give j all edges from i
1245            }
1246          }
1247        }
1248      }
1249      G = imDelRowCol(G,i,i); // remove vertex i
1250    }
1251  }
1252  return (G);
1253}
1254
1255static proc imDelRowCol(intmat M, int row, int col) {
1256  // row and col are expected to be > 0
1257  int nr = nrows(M);
1258  int nc = ncols(M);
1259  intmat Mdel[nr - 1][nc - 1];
1260  for (int i = 1; i <= nr; i++) {
1261    for (int j = 1; j <= nc; j++) {
1262      if(i != row && j != col) {
1263        int newi = i;
1264        int newj = j;
1265        if (i > row) { newi = i - 1; }
1266        if (j > col) { newj = j - 1; }
1267        Mdel[newi,newj] = M[i,j];
1268      }
1269    }
1270  }
1271  return (Mdel);
1272}
1273
1274static proc topologicalSort(intmat G) {
1275  // NOTE: ignores loops
1276  // NOTE: this takes O(|V^3|), can be optimized
1277  int n = ncols(G);
1278  for (int i = 1; i <= n; i++) { // only use the submat at i
1279    // find a vertex v in the submat at i with no incoming edges
1280    int v;
1281    for (int j = i; j <= n; j++) {
1282      int incoming = 0;
1283      for (int k = i; k <= n; k++) {
1284        if (k != j && G[k,j] == 1) {
1285          incoming = 1;
1286        }
1287      }
1288      if (incoming == 0) {
1289        v = j;
1290        break;
1291      } else {
1292        if (j == n) {
1293          // G contains at least one cycle, abort
1294          return (G);
1295        }
1296      }
1297    }
1298
1299    // swap v and i
1300    if (v != i) {
1301      G = imPermcol(G, v, i);
1302      G = imPermrow(G, v, i);
1303    }
1304  }
1305  return (G);
1306}
1307
1308static proc imPermcol (intmat A, int c1, int c2)
1309{
1310   intmat B = A;
1311   int k = nrows(B);
1312   B[1..k,c1] = A[1..k,c2];
1313   B[1..k,c2] = A[1..k,c1];
1314   return (B);
1315}
1316
1317static proc imPermrow (intmat A, int r1, int r2)
1318{
1319   intmat B = A;
1320   int k = ncols(B);
1321   B[r1,1..k] = A[r2,1..k];
1322   B[r2,1..k] = A[r1,1..k];
1323   return (B);
1324}
1325
1326static proc UfGraphGrowth(intmat UG)
1327{
1328  int n = ncols(UG); // number of vertices
1329  // iterate through all vertices
1330
1331  intvec visited;
1332  visited[n] = 0;
1333
1334  intvec cyclic;
1335  cyclic[n] = 0;
1336
1337  int maxCycleCount = 0;
1338  for (int v = 1; v <= n; v++) {
1339    int cycleCount = countCycles(UG, v, visited, cyclic, 0);
1340    if (cycleCount == -1) {
1341      return(-1);
1342    }
1343    if (cycleCount > maxCycleCount) {
1344      maxCycleCount = cycleCount;
1345    }
1346  }
1347  return(maxCycleCount);
1348}
1349
1350static proc countCycles(intmat G, int v, intvec visited, intvec cyclic, intvec path)
1351"USAGE: countCycles(G, v, visited, cyclic, path); G a Graph, v the vertex to
1352start. visited, cyclic and path should be 0.
1353RETURN: int
1354PURPOSE: Calculate the maximal number of distinct cycles in a single path starting at v.
1355@*: Maximal number of distinct cycles
1356ASSUME: Basering has to be a Letterplace ring.
1357"
1358{
1359  // Mark the current vertex as visited
1360  visited[v] = 1;
1361
1362  // Store the current vertex in path
1363  if (path[1] == 0) {
1364    path[1] = v;
1365  } else {
1366    path[size(path) + 1] = v;
1367  }
1368
1369  int cycles = 0;
1370  for (int w = 1; w <= ncols(G); w++) {
1371    if (G[v,w] == 1) {
1372      if (visited[w] == 1) { // neuer zykel gefunden
1373        // 1. alle Knoten in path bis w ÃŒberprÃŒfen ob in cyclic
1374        for (int j = size(path); j >= 1; j--) {
1375          if(cyclic[path[j]] == 1) {
1376            // 1.1 falls ja return -1
1377            return (-1);
1378          }
1379          if (path[j] == w) {
1380            break;
1381          }
1382        }
1383
1384        // 2. ansonsten cycles++
1385        for (int j = size(path); j >= 1; j--) {
1386          // 2.2 Kanten in diesem Zykel entfernen; Knoten cyclic
1387          if (j == size(path)) { // Sonderfall bei der ersten Iteration
1388            cyclic[v] = 1;
1389            G[v, w] = 0;
1390          } else {
1391            cyclic[path[j]] = 1;
1392            G[path[j], path[j+1]] = 0;
1393          }
1394          if (path[j] == w) {
1395            break;
1396          }
1397        }
1398
1399        // 3. auf jedem dieser Knoten countCycles() aufrufen
1400        int maxCycleCount = 0;
1401        for (int j = size(path); j >= 1; j--) {
1402          int cycleCount = countCycles(G, path[j], visited, cyclic, path);
1403          if(cycleCount == -1) {
1404            return (-1);
1405          }
1406          if (cycleCount > maxCycleCount) {
1407            maxCycleCount = cycleCount;
1408          }
1409          if (path[j] == w) {
1410            break;
1411          }
1412        }
1413        if (maxCycleCount >= cycles) {
1414          cycles = maxCycleCount + 1;
1415        }
1416      } else {
1417        int cycleCount = countCycles(G, w, visited, cyclic, path);
1418        if (cycleCount == -1) {
1419          return(-1);
1420        }
1421        if (cycleCount > cycles) {
1422          cycles = cycleCount;
1423        }
1424      }
1425    }
1426  }
1427  // printf("Path: %s countCycles: %s", path, cycles); // DEBUG
1428  return(cycles);
1429}
1430
1431static proc lpUfGraph(ideal G)
1432"USAGE: lpUfGraph(G); G a set of monomials in a letterplace ring
1433RETURN: intmat
1434PURPOSE: Constructs the Ufnarovskij graph induced by G
1435@*      the adjacency matrix of the Ufnarovskij graph induced by G
1436ASSUME: - basering is a Letterplace ring
1437        - G are the leading monomials of a Groebner basis
1438"
1439{
1440  int l = 0; // length of longest word (monomial) in G
1441  for (int i = 1; i <= size(G); i++) { // find the max degree in G
1442    int d = deg(G[i]);
1443    if (d > l) {
1444      l = d;
1445    }
1446  }
1447  list LG = lpId2ivLi(G);
1448  list SW = ivStandardWords(LG, l - 1); // vertices
1449  int n = size(SW);
1450  intmat UG[n][n]; // Ufnarovskij graph
1451  for (int i = 1; i <= n; i++) {
1452    for (int j = 1; j <= n; j++) {
1453      // [Studzinski page 76]
1454      intvec v = SW[i];
1455      intvec w = SW[j];
1456      intvec v_overlap;
1457      intvec w_overlap;
1458      //TODO how should the graph look like when l - 1 = 0 ?
1459      if (l - 1 > 1) {
1460        v_overlap = v[2 .. l-1];
1461        w_overlap = w[1 .. l-2];
1462      }
1463      intvec vw = v;
1464      vw[l] = w[l-1];
1465      if (v_overlap == w_overlap && !ivdivides(LG, vw)) {
1466        UG[i,j] = 1;
1467      }
1468    }
1469  }
1470  return (UG);
1471}
1472
1473static proc ivStandardWords(list G, int length) {
1474  if (length == 0) {
1475    return (0); // iv = 0 means monom = 1
1476  }
1477  int lV = attrib(basering, "lV"); // variable count
1478  list prevWords = ivStandardWords(G, length - 1);
1479  list words;
1480  for (int i = 1; i <= lV; i++) {
1481    for (int j = 1; j <= size(prevWords); j++) {
1482      intvec word = prevWords[j];
1483      word[length] = i;
1484      // assumes that G is simplified!
1485      if (!ivdivides(G, word)) {
1486        words = insert(words, word);
1487      }
1488    }
1489  }
1490  return (words);
1491}
1492
1493static proc ivdivides(list G, intvec iv) {
1494  for (int k = 1; k <= size(G); k++) {
1495    if (isIF(G[k], iv)) {
1496      return (1);
1497    } else {
1498      if (k == size(G)) {
1499        return (0);
1500      }
1501    }
1502  }
1503}
1504
1505static proc lpGraphOfNormalWords(ideal G)
1506"USAGE: lpGraphOfNormalWords(G); G a set of monomials in a letterplace ring
1507RETURN: intmat
1508PURPOSE: Constructs the graph of normal words induced by G
1509@*:      the adjacency matrix of the graph of normal words induced by G
1510ASSUME: - basering is a Letterplace ring
1511        - G are the leading monomials of a Groebner basis
1512"
1513{
1514  // construct the Graph of normal words [Studzinski page 78]
1515  // construct set of vertices
1516  int v = attrib(basering,"lV"); int d = attrib(basering,"uptodeg");
1517  ideal V; poly p,q,w;
1518  ideal LG = lead(G);
1519  int i,j,k,b; intvec E,Et;
1520  for (i = 1; i <= v; i++){V = V, var(i);}
1521  for (i = 1; i <= size(LG); i++)
1522  {
1523   E = leadexp(LG[i]);
1524   if (E == intvec(0)) {V = V,monomial(intvec(0));}
1525   else
1526   {
1527    for (j = 1; j < d; j++)
1528    {
1529     Et = E[(j*v+1)..(d*v)];
1530     if (Et == intvec(0)) {break;}
1531     else {V = V, monomial(Et);}
1532    }
1533   }
1534  }
1535  V = simplify(V,2+4);
1536            printf("V = %p", V);
1537 
1538 
1539  // construct incidence matrix
1540 
1541  list LV = lpId2ivLi(V);
1542  intvec Ip,Iw;
1543  int n = size(V);
1544  intmat T[n+1][n];
1545  for (i = 1; i <= n; i++)
1546  {
1547       // printf("for1 (i=%p, n=%p)", i, n);
1548   p = V[i]; Ip = lp2iv(p);
1549   for (j = 1; j <= n; j++)
1550   {
1551       // printf("for2 (j=%p, n=%p)", j, n);
1552    k = 1; b = 1;
1553    q = V[j];
1554    w = lpNF(lpMult(p,q),LG);
1555    if (w <> 0)
1556    {
1557     Iw = lp2iv(w);
1558     while (k <= n)
1559     {
1560       // printf("while (k=%p, n=%p)", k, n);
1561      if (isPF(LV[k],Iw) > 0)
1562       {if (isPF(LV[k],Ip) == 0) {b = 0; k = n+1;} else {k++;}
1563       }
1564       else {k++;}
1565     }
1566     T[i,j] = b;
1567       //  print("Incidence Matrix:");
1568       // print(T);
1569    }
1570   }
1571  }
1572  return(T);
1573}
1574
1575static proc lpNorGkDim(ideal G)
1576"USAGE: lpNorGkDim(G); G an ideal in a letterplace ring
1577RETURN: int
1578PURPOSE: Determines the Gelfand Kirillov dimension of A/<G>
1579@*:     -1 means it is infinite
1580ASSUME: - basering is a Letterplace ring
1581        - G is a Groebner basis
1582"
1583{
1584  return(growthAlg(lpGraphOfNormalWords(G)));
1585}
1586
1587proc lpGkDim(ideal G, list#)
1588"USAGE: lpGkDim(G); G an ideal in a letterplace ring, method an
1589@*       optional integer. method = 0 uses the Ufnarovskij Graph
1590@*       and method = 1 uses the Graph of normal words to determine
1591@*       the Gelfand Kirillov dimension
1592RETURN: int
1593PURPOSE: Determines the Gelfand Kirillov dimension of A/<G>
1594@*      -1 means it is positive infinite
1595@*      -2 means it is negative infinite
1596ASSUME: - basering is a Letterplace ring
1597        - G is a Groebner basis
1598"
1599{
1600  int method = 0;
1601  if (size(#) > 0) {
1602    if (typeof(#[1])=="int") {
1603      method = #[1];
1604    }
1605  }
1606
1607  if (method == 0) {
1608    return (lpUfGkDim(G));
1609  } else {
1610    return (lpNorGkDim(G));
1611  }
1612}
1613example
1614{
1615  "EXAMPLE:"; echo = 2;
1616  ring r = 0,(x,y,z),dp;
1617  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
1618  R;
1619  setring R; // sets basering to Letterplace ring
1620  ideal I = z(1);//an example of infinite GK dimension
1621  lpGkDim(I);
1622  I = x(1),y(1),z(1); // gkDim = 0
1623  lpGkDim(I);
1624  I = x(1)*y(2), x(1)*z(2), z(1)*y(2), z(1)*z(2);//gkDim = 2
1625  lpGkDim(I);
1626}
1627
1628proc lpGlDimBound(ideal G)
1629"USAGE: lpGlDimBound(I); I an ideal
1630RETURN: int, an upper bound for the global dimension, -1 means infinity
1631PURPOSE: computing an upper bound for the global dimension
1632ASSUME: - basering is a Letterplace ring, G is a reduced Gröbner Basis
1633EXAMPLE: example lpGlDimBound; shows example
1634NOTE: if I = LM(I), then the global dimension is equal the Gelfand
1635@*    Kirillov dimension if it is finite
1636@*    Global dimension should be 0 for A/G = K and 1 for A/G = K<x1...xn>
1637"
1638{
1639  // NOTE: Gl should be 0 for A/G = K and 1 for A/G = K<x1...xn>
1640  // G1 contains generators with single variable in LM
1641  ideal G1;
1642  for (int i = 1; i <= size(G); i++) {
1643    if (ord(G[i]) < 2) { // single variable in LM
1644      G1 = insertGenerator(G1,G[i]);
1645    }
1646  }
1647
1648  // G = NF(G,G1)
1649  for (int i = 1; i <= size(G); i++) {
1650    G[i] = lpNF(G[i],G1);
1651  }
1652  G = simplify(G,2); // remove zero generators
1653
1654  // delete variables in LM(G1) from the ring
1655  def save = basering;
1656  ring R = basering;
1657  for (int i = 1; i <= size(G1); i++) {
1658    if (attrib(R, "lV") > 1) {
1659      ring R = lpDelVar(lp2iv(G1[i])[1]);
1660      ideal G1 = imap(save,G1);
1661      G1 = simplify(G1, 2); // remove zero generators
1662      i = 0; // reset counter
1663    } else {
1664      // only the field is left (no variables)
1665      return(0);
1666    }
1667  }
1668
1669  ideal G = imap(save, G);
1670
1671  // Li p. 184 if G = LM(G), then I = LM(I) and thus glDim = gkDim if it's finite
1672  for (int i = 1; i <= size(G); i++) {
1673    if (G[i] != lead(G[i])) {
1674      break;
1675    } else {
1676      if (i == size(G)) { // if last iteration
1677        print("Using gk dim"); // DEBUG
1678        int gkDim = lpGkDim(G);
1679        if (gkDim >= 0) {
1680          return (gkDim);
1681        }
1682      }
1683    }
1684  }
1685
1686  intmat GNC = lpGraphOfNChains(G);
1687
1688  // assuming GNC is connected
1689
1690  // TODO: maybe loop+cycle checking could be done more efficiently?
1691  if (!imHasLoops(GNC) && imIsUpRightTriangle(topologicalSort(GNC))) {
1692    // GNC is a DAG
1693    intmat GNCk = GNC;
1694    intmat zero[1][ncols(GNCk)];
1695    int k = 1;
1696    // while first row isn't empty
1697    while (GNCk[1,1..(ncols(GNCk))] != zero[1,1..(ncols(zero))]) {
1698      GNCk = GNCk * GNC;
1699      k++;
1700    }
1701    // k-1 = number of edges in longest path starting from 1
1702    return (k-1);
1703  } else {
1704    // GNC contains loops/cycles => there is always an n-chain
1705    return (-1); // infinity
1706  }
1707}
1708example
1709{
1710  "EXAMPLE:"; echo = 2;
1711  ring r = 0,(x,y),dp;
1712  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
1713  setring R; // sets basering to Letterplace ring
1714  ideal G = x(1)*x(2), y(1)*y(2),x(1)*y(2)*x(3); // ideal G contains a
1715  //Groebner basis
1716  lpGlDimBound(G); // invokes procedure with Groebner basis G
1717}
1718
1719static proc imHasLoops(intmat A) {
1720  int n = ncols(A);
1721  for (int i = 1; i < n; i++) {
1722      if (A[i,i] == 1) {
1723        return (1);
1724      }
1725  }
1726  return (0);
1727}
1728
1729static proc lpGraphOfNChains(ideal G) // G must be reduced
1730{
1731  list LG = lpId2ivLi(lead(G));
1732  int n = attrib(basering, "lV");
1733  int degbound = attrib(basering, "uptodeg");
1734
1735  list V;
1736  for (int i = 0; i <= n; i++) {
1737    V[i+1] = i; // add 1 and all variables
1738  }
1739  for (int i = 1; i <= size(LG); i++) {
1740    intvec u = LG[i];
1741    for (int j = 2; j <= size(u); j++) {
1742      intvec v = u[j..size(u)];
1743      if (!contains(V, v)) {
1744        V = insert(V, v, size(V)); // add subword j..size
1745      }
1746    }
1747  }
1748  int nV = size(V);
1749  intmat GNC[nV][nV]; // graph of n-chains
1750
1751  // for vertex 1
1752  for (int i = 2; i <= n + 1; i++) {
1753    GNC[1,i] = 1; // 1 has an edge to all variables
1754  }
1755
1756  // for the other vertices
1757  for (int i = 2; i <= nV; i++) {
1758    for (int j = 2; j <= nV; j++) {
1759      intvec uv = V[i],V[j];
1760
1761      if (contains(LG, uv)) {
1762        GNC[i,j] = 1;
1763      } else {
1764        // Li p. 177
1765        // search for a right divisor 'w' of uv in G
1766        // then check if G doesn't divide the subword uv-1
1767
1768        // look for a right divisor in LG
1769        for (int k = 1; k <= size(LG); k++) {
1770          if (isSF(LG[k], uv)) {
1771            // w = LG[k]
1772            if(!ivdivides(LG, uv[1..(size(uv)-1)])) {
1773              // G doesn't divide uv-1
1774              GNC[i,j] = 1;
1775              break;
1776            }
1777          }
1778        }
1779      }
1780    }
1781  }
1782
1783  return(GNC);
1784}
1785
1786static proc contains(list L, def item)
1787{
1788  for (int i = 1; i <= size(L); i++) {
1789    if (L[i] == item) {
1790      return (1);
1791    }
1792  }
1793  return (0);
1794}
1795
1796
1797proc ivDHilbert(list L, int n, list #)
1798"USAGE: ivDHilbert(L,n[,degbound]); L a list of intmats, n an integer,
1799@*      degbound an optional integer
1800RETURN: list
1801PURPOSE:Computing the K-dimension and the Hilbert series
1802ASSUME: - basering is a Letterplace ring
1803@*      - all rows of each intmat correspond to a Letterplace monomial
1804@*      - if you specify a different degree bound degbound,
1805@*        degbound <= attrib(basering,uptodeg) holds
1806NOTE: - If L is the list returned, then L[1] is an integer corresponding to the
1807@*      dimension, L[2] is an intvec which contains the coefficients of the
1808@*      Hilbert series
1809@*    - If degbound is set, there will be a degree bound added. By default there
1810@*      is no degree bound
1811@*    - n is the number of variables
1812@*    - If I = L[2] is the intvec returned, then I[k] is the (k-1)-th coefficient of
1813@*      the Hilbert series.
1814@*    - If the K-dimension is known to be infinite, a degree bound is needed
1815EXAMPLE: example ivDHilbert; shows examples
1816"
1817{int degbound = 0;
1818  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] > 0){degbound = #[1];}}}
1819  checkAssumptions(degbound,L);
1820  intvec H; int i,dimen;
1821  H = ivHilbert(L,n,degbound);
1822  for (i = 1; i <= size(H); i++){dimen = dimen + H[i];}
1823  L = dimen,H;
1824  return(L);
1825}
1826example
1827{
1828  "EXAMPLE:"; echo = 2;
1829  ring r = 0,(x,y),dp;
1830  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
1831  R;
1832  setring R; // sets basering to Letterplace ring
1833  //some intmats, which contain monomials in intvec representation as rows
1834  intmat I1 [2][2] = 1,1,2,2; intmat I2 [1][3]  = 1,2,1;
1835  intmat J1 [1][2] =  1,1; intmat J2 [2][3] = 2,1,2,1,2,1;
1836  print(I1);
1837  print(I2);
1838  print(J1);
1839  print(J2);
1840  list G = I1,I2; // ideal, which is already a Groebner basis
1841  list I = J1,J2; // ideal, which is already a Groebner basis
1842  //the procedure without a degree bound
1843  ivDHilbert(G,2);
1844  // the procedure with degree bound 5
1845  ivDHilbert(I,2,5);
1846}
1847
1848proc ivDHilbertSickle(list L, int n, list #)
1849"USAGE: ivDHilbertSickle(L,n[,degbound]); L a list of intmats, n an integer,
1850@*      degbound an optional integer
1851RETURN: list
1852PURPOSE:Computing K-dimension, Hilbert series and mistletoes
1853ASSUME: - basering is a Letterplace ring.
1854@*      - All rows of each intmat correspond to a Letterplace monomial.
1855@*      - If you specify a different degree bound degbound,
1856@*        degbound <= attrib(basering,uptodeg) holds.
1857NOTE: - If L is the list returned, then L[1] is an integer, L[2] is an intvec
1858@*      which contains the coefficients of the Hilbert series and L[3]
1859@*      is a list, containing the mistletoes as intvecs.
1860@*    - If degbound is set, a degree bound will be added. By default there
1861@*      is no degree bound.
1862@*    - n is the number of variables.
1863@*    - If I = L[2] is the intvec returned, then I[k] is the (k-1)-th
1864@*      coefficient of the Hilbert series.
1865@*    - If the K-dimension is known to be infinite, a degree bound is needed
1866EXAMPLE: example ivDHilbertSickle; shows examples
1867"
1868{int degbound = 0;
1869  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] > 0){degbound = #[1];}}}
1870  checkAssumptions(degbound,L);
1871  int i,dimen; list R;
1872  R = ivSickleHil(L,n,degbound);
1873  for (i = 1; i <= size(R[1]); i++){dimen = dimen + R[1][i];}
1874  R[3] = R[2]; R[2] = R[1]; R[1] = dimen;
1875  return(R);
1876}
1877example
1878{
1879  "EXAMPLE:"; echo = 2;
1880  ring r = 0,(x,y),dp;
1881  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
1882  R;
1883  setring R; // sets basering to Letterplace ring
1884  //some intmats, which contain monomials in intvec representation as rows
1885  intmat I1 [2][2] = 1,1,2,2; intmat I2 [1][3]  = 1,2,1;
1886  intmat J1 [1][2] =  1,1; intmat J2 [2][3] = 2,1,2,1,2,1;
1887  print(I1);
1888  print(I2);
1889  print(J1);
1890  print(J2);
1891  list G = I1,I2;// ideal, which is already a Groebner basis
1892  list I = J1,J2; // ideal, which is already a Groebner basis
1893  ivDHilbertSickle(G,2); // invokes the procedure without a degree bound
1894  ivDHilbertSickle(I,2,3); // invokes the procedure with degree bound 3
1895}
1896
1897proc ivDimCheck(list L, int n)
1898"USAGE: ivDimCheck(L,n); L a list of intmats, n an integer
1899RETURN: int, 0 if the dimension is finite, or 1 otherwise
1900PURPOSE:Decides, whether the K-dimension is finite or not
1901ASSUME: - basering is a Letterplace ring.
1902@*      - All rows of each intmat correspond to a Letterplace monomial.
1903NOTE:   - n is the number of variables.
1904EXAMPLE: example ivDimCheck; shows examples
1905"
1906{checkAssumptions(0,L);
1907  int i,r;
1908  intvec P,H;
1909  for (i = 1; i <= size(L); i++)
1910  {P[i] = ncols(L[i]);
1911    if (P[i] == 1) {if (isInMat(H,L[i]) > 0) {ERROR("Quotient algebra is trivial");}}
1912  }
1913  if (size(L) == 0) {ERROR("GB is empty, quotient algebra corresponds to free algebra");}
1914  kill H;
1915  intmat S; int sd,ld; intvec V;
1916  sd = P[1]; ld = P[1];
1917  for (i = 2; i <= size(P); i++)
1918  {if (P[i] < sd) {sd = P[i];}
1919    if (P[i] > ld) {ld = P[i];}
1920  }
1921  sd = (sd - 1); ld = ld - 1;
1922  if (ld == 0) { return(allVars(L,P,n));}
1923  if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
1924  else {S = createStartMat(sd,n);}
1925  module M;
1926  for (i = 1; i <= nrows(S); i++)
1927  {V = S[i,1..ncols(S)];
1928    if (findCycle(V,L,P,n,ld,M)) {r = 1; break;}
1929  }
1930  return(r);
1931}
1932example
1933{
1934  "EXAMPLE:"; echo = 2;
1935  ring r = 0,(x,y),dp;
1936  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
1937  R;
1938  setring R; // sets basering to Letterplace ring
1939  //some intmats, which contain monomials in intvec representation as rows
1940  intmat I1 [2][2] = 1,1,2,2; intmat I2 [1][3]  = 1,2,1;
1941  intmat J1 [1][2] =  1,1; intmat J2 [2][3] = 2,1,2,1,2,1;
1942  print(I1);
1943  print(I2);
1944  print(J1);
1945  print(J2);
1946  list G = I1,I2;// ideal, which is already a Groebner basis
1947  list I = J1,J2; // ideal, which is already a Groebner basis and which
1948  ivDimCheck(G,2); // invokes the procedure, factor is of finite K-dimension
1949  ivDimCheck(I,2); // invokes the procedure, factor is not of finite K-dimension
1950}
1951
1952proc ivHilbert(list L, int n, list #)
1953"USAGE: ivHilbert(L,n[,degbound]); L a list of intmats, n an integer,
1954@*      degbound an optional integer
1955RETURN: intvec, containing the coefficients of the Hilbert series
1956PURPOSE:Computing the Hilbert series
1957ASSUME: - basering is a Letterplace ring.
1958@*      - all rows of each intmat correspond to a Letterplace monomial
1959@*      - if you specify a different degree bound degbound,
1960@*       degbound <= attrib(basering,uptodeg) holds.
1961NOTE: - If degbound is set, a degree bound  will be added. By default there
1962@*      is no degree bound.
1963@*    - n is the number of variables.
1964@*    - If I is returned, then I[k] is the (k-1)-th coefficient of the Hilbert
1965@*      series.
1966@*    - If the K-dimension is known to be infinite, a degree bound is needed
1967EXAMPLE: example ivHilbert; shows examples
1968"
1969{int degbound = 0;
1970  if (size(#) > 0) {if (typeof(#[1])=="int"){if (#[1] > 0) {degbound = #[1];}}}
1971  intvec P,H; int i;
1972  for (i = 1; i <= size(L); i++)
1973  {P[i] = ncols(L[i]);
1974    if (P[i] == 1) {if ( isInMat(H,L[i]) > 0) {ERROR("Quotient algebra is trivial");}}
1975  }
1976  if (size(L) == 0) {ERROR("GB is empty, quotient algebra corresponds to free algebra");}
1977  H[1] = 1;
1978  checkAssumptions(degbound,L);
1979  if (degbound == 0)
1980  {int sd;
1981    intmat S;
1982    sd = P[1];
1983    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
1984    sd = (sd - 1);
1985    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
1986    else {S = createStartMat(sd,n);}
1987    if (intvec(S) == 0) {return(H);}
1988    for (i = 1; i <= sd; i++) {H = H,(n^i);}
1989    for (i = 1; i <= nrows(S); i++)
1990    {intvec St = S[i,1..ncols(S)];
1991      H = findHCoeff(St,n,L,P,H);
1992      kill St;
1993    }
1994    return(H);
1995  }
1996  else
1997  {for (i = 1; i <= size(P); i++)
1998    {if (P[i] > degbound) {ERROR("degreebound is too small, GB contains elements of higher degree");}}
1999    int sd;
2000    intmat S;
2001    sd = P[1];
2002    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
2003    sd = (sd - 1);
2004    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
2005    else {S = createStartMat(sd,n);}
2006    if (intvec(S) == 0) {return(H);}
2007    for (i = 1; i <= sd; i++) {H = H,(n^i);}
2008    for (i = 1; i <= nrows(S); i++)
2009    {intvec St = S[i,1..ncols(S)];
2010      H = findHCoeff(St,n,L,P,H,degbound);
2011      kill St;
2012    }
2013    return(H);
2014  }
2015}
2016example
2017{
2018  "EXAMPLE:"; echo = 2;
2019  ring r = 0,(x,y),dp;
2020  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2021  R;
2022  setring R; // sets basering to Letterplace ring
2023  //some intmats, which contain monomials in intvec representation as rows
2024  intmat I1 [2][2] = 1,1,2,2; intmat I2 [1][3]  = 1,2,1;
2025  intmat J1 [1][2] =  1,1; intmat J2 [2][3] = 2,1,2,1,2,1;
2026  print(I1);
2027  print(I2);
2028  print(J1);
2029  print(J2);
2030  list G = I1,I2; // ideal, which is already a Groebner basis
2031  list I = J1,J2; // ideal, which is already a Groebner basis
2032  ivHilbert(G,2); // invokes the procedure without any degree bound
2033  ivHilbert(I,2,5); // invokes the procedure with degree bound 5
2034}
2035
2036
2037proc ivKDim(list L, int n, list #)
2038"USAGE: ivKDim(L,n[,degbound]); L a list of intmats,
2039@*      n an integer, degbound an optional integer
2040RETURN: int, the K-dimension of A/<L>
2041PURPOSE:Computing the K-dimension of A/<L>
2042ASSUME: - basering is a Letterplace ring.
2043@*      - all rows of each intmat correspond to a Letterplace monomial
2044@*      - if you specify a different degree bound degbound,
2045@*        degbound <= attrib(basering,uptodeg) holds.
2046NOTE: - If degbound is set, a degree bound will be added. By default there
2047@*      is no degree bound.
2048@*    - n is the number of variables.
2049@*    - If the K-dimension is known to be infinite, a degree bound is needed
2050EXAMPLE: example ivKDim; shows examples
2051"
2052{int degbound = 0;
2053  if (size(#) > 0) {if (typeof(#[1])=="int"){if (#[1] > 0) {degbound = #[1];}}}
2054  intvec P,H; int i;
2055  for (i = 1; i <= size(L); i++)
2056  {P[i] = ncols(L[i]);
2057    if (P[i] == 1) {if ( isInMat(H,L[i]) > 0) {ERROR("Quotient algebra is trivial");}}
2058  }
2059  if (size(L) == 0) {ERROR("GB is empty, quotient algebra corresponds to free algebra");}
2060  kill H;
2061  checkAssumptions(degbound,L);
2062  if (degbound == 0)
2063  {int sd; int dimen = 1;
2064    intmat S;
2065    sd = P[1];
2066    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
2067    sd = (sd - 1);
2068    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
2069    else {S = createStartMat(sd,n);}
2070    if (intvec(S) == 0) {return(dimen);}
2071    for (i = 1; i <= sd; i++) {dimen = dimen +(n^i);}
2072    for (i = 1; i <= nrows(S); i++)
2073    {intvec St = S[i,1..ncols(S)];
2074      dimen = dimen + findDimen(St,n,L,P);
2075      kill St;
2076    }
2077    return(dimen);
2078  }
2079  else
2080  {for (i = 1; i <= size(P); i++)
2081    {if (P[i] > degbound) {ERROR("degreebound is too small, GB contains elements of higher degree");}}
2082    int sd; int dimen = 1;
2083    intmat S;
2084    sd = P[1];
2085    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
2086    sd = (sd - 1);
2087    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
2088    else {S = createStartMat(sd,n);}
2089    if (intvec(S) == 0) {return(dimen);}
2090    for (i = 1; i <= sd; i++) {dimen = dimen +(n^i);}
2091    for (i = 1; i <= nrows(S); i++)
2092    {intvec St = S[i,1..ncols(S)];
2093      dimen = dimen + findDimen(St,n,L,P, degbound);
2094      kill St;
2095    }
2096    return(dimen);
2097  }
2098}
2099example
2100{
2101  "EXAMPLE:"; echo = 2;
2102  ring r = 0,(x,y),dp;
2103  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2104  R;
2105  setring R; // sets basering to Letterplace ring
2106  //some intmats, which contain monomials in intvec representation as rows
2107  intmat I1 [2][2] = 1,1,2,2; intmat I2 [1][3]  = 1,2,1;
2108  intmat J1 [1][2] =  1,1; intmat J2 [2][3] = 2,1,2,1,2,1;
2109  print(I1);
2110  print(I2);
2111  print(J1);
2112  print(J2);
2113  list G = I1,I2; // ideal, which is already a Groebner basis
2114  list I = J1,J2; // ideal, which is already a Groebner basis
2115  ivKDim(G,2); // invokes the procedure without any degree bound
2116  ivKDim(I,2,5); // invokes the procedure with degree bound 5
2117}
2118
2119proc ivMis2Dim(list M)
2120"USAGE: ivMis2Dim(M); M a list of intvecs
2121RETURN: int, the K-dimension of the given algebra
2122PURPOSE:Computing the K-dimension out of given mistletoes
2123ASSUME: - The mistletoes have to be ordered lexicographically -> OrdMisLex.
2124@*        Otherwise the returned value may differ from the K-dimension.
2125@*      - basering is a Letterplace ring.
2126EXAMPLE: example ivMis2Dim; shows examples
2127"
2128{checkAssumptions(0,M);
2129  intvec L;
2130  if (size(M) == 0){ERROR("There are no mistletoes, so it appears your dimension is infinite!");}
2131  if (isInList(L,M) > 0) {print("1 is a mistletoe, therefore dim = 1"); return(1);}
2132  int i,j,d,s;
2133  j = 1;
2134  d = 1 + size(M[1]);
2135  for (i = 1; i < size(M); i++)
2136  {s = size(M[i]); if (s > size(M[i+1])){s = size(M[i+1]);}
2137    while ((M[i][j] == M[i+1][j]) && (j <= s)){j = j + 1;}
2138    d = d + size(M[i+1])- j + 1;
2139  }
2140  return(d);
2141}
2142example
2143{
2144  "EXAMPLE:"; echo = 2;
2145  ring r = 0,(x,y),dp;
2146  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2147  R;
2148  setring R; // sets basering to Letterplace ring
2149  intvec i1 = 1,2; intvec i2 = 2,1,2;
2150  // the mistletoes are xy and yxy, which are already ordered lexicographically
2151  list L = i1,i2;
2152  ivMis2Dim(L); // returns the dimension of the factor algebra
2153}
2154
2155proc ivOrdMisLex(list M)
2156"USAGE: ivOrdMisLex(M); M a list of intvecs
2157RETURN: list, containing the ordered intvecs of M
2158PURPOSE:Orders a given set of mistletoes lexicographically
2159ASSUME: - basering is a Letterplace ring.
2160       - intvecs correspond to monomials
2161NOTE:   - This is preprocessing, it's not needed if the mistletoes are returned
2162@*        from the sickle algorithm.
2163@*      - Each entry of the list returned is an intvec.
2164EXAMPLE: example ivOrdMisLex; shows examples
2165"
2166{checkAssumptions(0,M);
2167  return(sort(M)[1]);
2168}
2169example
2170{
2171  "EXAMPLE:"; echo = 2;
2172  ring r = 0,(x,y),dp;
2173  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2174  setring R; // sets basering to Letterplace ring
2175  intvec i1 = 1,2,1; intvec i2 = 2,2,1; intvec i3 = 1,1; intvec i4 = 2,1,1,1;
2176  // the corresponding monomials are xyx,y^2x,x^2,yx^3
2177  list M = i1,i2,i3,i4;
2178  M;
2179  ivOrdMisLex(M);// orders the list of monomials
2180}
2181
2182proc ivSickle(list L, int n, list #)
2183"USAGE: ivSickle(L,n,[degbound]); L a list of intmats, n an int, degbound an
2184@*      optional integer
2185RETURN: list, containing intvecs, the mistletoes of A/<L>
2186PURPOSE:Computing the mistletoes for a given Groebner basis L
2187ASSUME: - basering is a Letterplace ring.
2188@*      - all rows of each intmat correspond to a Letterplace monomial
2189@*      - if you specify a different degree bound degbound,
2190@*        degbound <= attrib(basering,uptodeg) holds.
2191NOTE: - If degbound is set, a degree bound will be added. By default there
2192@*      is no degree bound.
2193@*    - n is the number of variables.
2194@*    - If the K-dimension is known to be infinite, a degree bound is needed
2195EXAMPLE: example ivSickle; shows examples
2196"
2197{list M;
2198  int degbound = 0;
2199  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] > 0){degbound = #[1];}}}
2200  int i;
2201  intvec P,H;
2202  for (i = 1; i <= size(L); i++)
2203  {P[i] = ncols(L[i]);
2204    if (P[i] == 1) {if (isInMat(H,L[i]) > 0) {ERROR("Quotient algebra is trivial");}}
2205  }
2206  if (size(L) == 0) {ERROR("GB is empty, quotient algebra corresponds to free algebra");}
2207  kill H;
2208  checkAssumptions(degbound,L);
2209  if (degbound == 0)
2210  {intmat S; int sd;
2211    sd = P[1];
2212    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
2213    sd = (sd - 1);
2214    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
2215    else {S = createStartMat(sd,n);}
2216    if (intvec(S) == 0) {return(list (intvec(0)));}
2217    for (i = 1; i <= nrows(S); i++)
2218    {intvec St = S[i,1..ncols(S)];
2219      M = M + findmistletoes(St,n,L,P);
2220      kill St;
2221    }
2222    return(M);
2223  }
2224  else
2225  {for (i = 1; i <= size(P); i++)
2226    {if (P[i] > degbound) {ERROR("degreebound is too small, GB contains elements of higher degree");}}
2227    intmat S; int sd;
2228    sd = P[1];
2229    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
2230    sd = (sd - 1);
2231    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
2232    else {S = createStartMat(sd,n);}
2233    if (intvec(S) == 0) {return(list (intvec(0)));}
2234    for (i = 1; i <= nrows(S); i++)
2235    {intvec St = S[i,1..ncols(S)];
2236      M = M + findmistletoes(St,n,L,P,degbound);
2237      kill St;
2238    }
2239    return(M);
2240  }
2241}
2242example
2243{
2244  "EXAMPLE:"; echo = 2;
2245  ring r = 0,(x,y),dp;
2246  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2247  setring R; // sets basering to Letterplace ring
2248  //some intmats, which contain monomials in intvec representation as rows
2249  intmat I1 [2][2] = 1,1,2,2; intmat I2 [1][3]  = 1,2,1;
2250  intmat J1 [1][2] =  1,1; intmat J2 [2][3] = 2,1,2,1,2,1;
2251  print(I1);
2252  print(I2);
2253  print(J1);
2254  print(J2);
2255  list G = I1,I2; // ideal, which is already a Groebner basis
2256  list I =  J1,J2; // ideal, which is already a Groebner basis
2257  ivSickle(G,2); // invokes the procedure without any degree bound
2258  ivSickle(I,2,5); // invokes the procedure with degree bound 5
2259}
2260
2261proc ivSickleDim(list L, int n, list #)
2262"USAGE: ivSickleDim(L,n[,degbound]); L a list of intmats, n an integer, degbound
2263@*      an optional integer
2264RETURN: list
2265PURPOSE:Computing mistletoes and the K-dimension
2266ASSUME: - basering is a Letterplace ring.
2267@*      - all rows of each intmat correspond to a Letterplace monomial
2268@*      - if you specify a different degree bound degbound,
2269@*        degbound <= attrib(basering,uptodeg) holds.
2270NOTE: - If L is the list returned, then L[1] is an integer, L[2] is a list,
2271@*      containing the mistletoes as intvecs.
2272@*    - If degbound is set, a degree bound will be added. By default there
2273@*      is no degree bound.
2274@*    - n is the number of variables.
2275@*    - If the K-dimension is known to be infinite, a degree bound is needed
2276EXAMPLE: example ivSickleDim; shows examples
2277"
2278{list M;
2279  int degbound = 0;
2280  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] > 0){degbound = #[1];}}}
2281  int i,dimen; list R;
2282  intvec P,H;
2283  for (i = 1; i <= size(L); i++)
2284  {P[i] = ncols(L[i]);
2285    if (P[i] == 1) {if (isInMat(H,L[i]) > 0) {ERROR("Quotient algebra is trivial, dimension equals zero");}}
2286  }
2287  if (size(L) == 0) {ERROR("GB is empty, quotient algebra corresponds to free algebra");}
2288  kill H;
2289  checkAssumptions(degbound,L);
2290  if (degbound == 0)
2291  {int sd; dimen = 1;
2292    intmat S;
2293    sd = P[1];
2294    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
2295    sd = (sd - 1);
2296    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
2297    else {S = createStartMat(sd,n);}
2298    if (intvec(S) == 0) {return(list(dimen,list(intvec(0))));}
2299    for (i = 1; i <= sd; i++) {dimen = dimen +(n^i);}
2300    R[1] = dimen;
2301    for (i = 1; i <= nrows(S); i++)
2302    {intvec St = S[i,1..ncols(S)];
2303      R = findMisDim(St,n,L,P,R);
2304      kill St;
2305    }
2306    return(R);
2307  }
2308  else
2309  {for (i = 1; i <= size(P); i++)
2310    {if (P[i] > degbound) {ERROR("degreebound is too small, GB contains elements of higher degree");}}
2311    int sd; dimen = 1;
2312    intmat S;
2313    sd = P[1];
2314    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
2315    sd = (sd - 1);
2316    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
2317    else {S = createStartMat(sd,n);}
2318    if (intvec(S) == 0) {return(list(dimen,list(intvec(0))));}
2319    for (i = 1; i <= sd; i++) {dimen = dimen +(n^i);}
2320    R[1] = dimen;
2321    for (i = 1; i <= nrows(S); i++)
2322    {intvec St = S[i,1..ncols(S)];
2323      R = findMisDim(St,n,L,P,R,degbound);
2324      kill St;
2325    }
2326    return(R);
2327  }
2328}
2329example
2330{
2331  "EXAMPLE:"; echo = 2;
2332  ring r = 0,(x,y),dp;
2333  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2334  setring R; // sets basering to Letterplace ring
2335  //some intmats, which contain monomials in intvec representation as rows
2336  intmat I1 [2][2] = 1,1,2,2; intmat I2 [1][3]  = 1,2,1;
2337  intmat J1 [1][2] =  1,1; intmat J2 [2][3] = 2,1,2,1,2,1;
2338  print(I1);
2339  print(I2);
2340  print(J1);
2341  print(J2);
2342  list G = I1,I2;// ideal, which is already a Groebner basis
2343  list I =  J1,J2; // ideal, which is already a Groebner basis
2344  ivSickleDim(G,2); // invokes the procedure without any degree bound
2345  ivSickleDim(I,2,5); // invokes the procedure with degree bound 5
2346}
2347
2348proc ivSickleHil(list L, int n, list #)
2349"USAGE:ivSickleHil(L,n[,degbound]); L a list of intmats, n an integer,
2350@*     degbound an optional integer
2351RETURN: list
2352PURPOSE:Computing the mistletoes and the Hilbert series
2353ASSUME: - basering is a Letterplace ring.
2354@*      - all rows of each intmat correspond to a Letterplace monomial
2355@*      - if you specify a different degree bound degbound,
2356@*        degbound <= attrib(basering,uptodeg) holds.
2357NOTE: - If L is the list returned, then L[1] is an intvec, L[2] is a list,
2358@*      containing the mistletoes as intvecs.
2359@*    - If degbound is set, a degree bound will be added. By default there
2360@*      is no degree bound.
2361@*    - n is the number of variables.
2362@*    - If I = L[1] is the intvec returned, then I[k] is the (k-1)-th
2363@*      coefficient of the Hilbert series.
2364@*    - If the K-dimension is known to be infinite, a degree bound is needed
2365EXAMPLE: example ivSickleHil; shows examples
2366"
2367{int degbound = 0;
2368  if (size(#) > 0) {if (typeof(#[1])=="int"){if (#[1] > 0) {degbound = #[1];}}}
2369  intvec P,H; int i; list R;
2370  for (i = 1; i <= size(L); i++)
2371  {P[i] = ncols(L[i]);
2372    if (P[i] == 1) {if ( isInMat(H,L[i]) > 0) {ERROR("Quotient algebra is trivial");}}
2373  }
2374  if (size(L) == 0) {ERROR("GB is empty, quotient algebra corresponds to free algebra");}
2375  H[1] = 1;
2376  checkAssumptions(degbound,L);
2377  if (degbound == 0)
2378  {int sd;
2379    intmat S;
2380    sd = P[1];
2381    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
2382    sd = (sd - 1);
2383    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
2384    else {S = createStartMat(sd,n);}
2385    if (intvec(S) == 0) {return(list(H,list(intvec (0))));}
2386    for (i = 1; i <= sd; i++) {H = H,(n^i);}
2387    R[1] = H; kill H;
2388    for (i = 1; i <= nrows(S); i++)
2389    {intvec St = S[i,1..ncols(S)];
2390      R = findHCoeffMis(St,n,L,P,R);
2391      kill St;
2392    }
2393    return(R);
2394  }
2395  else
2396  {for (i = 1; i <= size(P); i++)
2397    {if (P[i] > degbound) {ERROR("degreebound is too small, GB contains elements of higher degree");}}
2398    int sd;
2399    intmat S;
2400    sd = P[1];
2401    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
2402    sd = (sd - 1);
2403    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
2404    else {S = createStartMat(sd,n);}
2405    if (intvec(S) == 0) {return(list(H,list(intvec(0))));}
2406    for (i = 1; i <= sd; i++) {H = H,(n^i);}
2407    R[1] = H; kill H;
2408    for (i = 1; i <= nrows(S); i++)
2409    {intvec St = S[i,1..ncols(S)];
2410      R = findHCoeffMis(St,n,L,P,R,degbound);
2411      kill St;
2412    }
2413    return(R);
2414  }
2415}
2416example
2417{
2418  "EXAMPLE:"; echo = 2;
2419  ring r = 0,(x,y),dp;
2420  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2421  setring R; // sets basering to Letterplace ring
2422  //some intmats, which contain monomials in intvec representation as rows
2423  intmat I1[2][2] = 1,1,2,2; intmat I2[1][3]  = 1,2,1;
2424  intmat J1[1][2] =  1,1; intmat J2[2][3] = 2,1,2,1,2,1;
2425  print(I1);
2426  print(I2);
2427  print(J1);
2428  print(J2);
2429  list G = I1,I2;// ideal, which is already a Groebner basis
2430  list I =  J1,J2; // ideal, which is already a Groebner basis
2431  ivSickleHil(G,2); // invokes the procedure without any degree bound
2432  ivSickleHil(I,2,5); // invokes the procedure with degree bound 5
2433}
2434
2435proc lpDHilbert(ideal G, list #)
2436"USAGE: lpDHilbert(G[,degbound,n]); G an ideal, degbound, n optional integers
2437RETURN: list
2438PURPOSE:Computing K-dimension and Hilbert series, starting with a lp-ideal
2439ASSUME: - basering is a Letterplace ring.
2440@*      - if you specify a different degree bound degbound,
2441@*        degbound <= attrib(basering,uptodeg) holds.
2442NOTE: - If L is the list returned, then L[1] is an integer corresponding to the
2443@*      dimension, L[2] is an intvec which contains the coefficients of the
2444@*      Hilbert series
2445@*    - If degbound is set, there will be a degree bound added. 0 means no
2446@*      degree bound. Default: attrib(basering,uptodeg).
2447@*    - n can be set to a different number of variables.
2448@*      Default: n = attrib(basering, lV).
2449@*    - If I = L[2] is the intvec returned, then I[k] is the (k-1)-th
2450@*      coefficient of the Hilbert series.
2451@*    - If the K-dimension is known to be infinite, a degree bound is needed
2452EXAMPLE: example lpDHilbert; shows examples
2453"
2454{int degbound = attrib(basering,"uptodeg");int n = attrib(basering, "lV");
2455  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] >= 0){degbound = #[1];}}}
2456  if (size(#) > 1){if (typeof(#[1])=="int"){if (#[2] > 0){n = #[2];}}}
2457  list L;
2458  L = lp2ivId(normalize(lead(G)));
2459  return(ivDHilbert(L,n,degbound));
2460}
2461example
2462{
2463  "EXAMPLE:"; echo = 2;
2464  ring r = 0,(x,y),dp;
2465  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2466  setring R; // sets basering to Letterplace ring
2467  ideal G = x(1)*x(2), y(1)*y(2),x(1)*y(2)*x(3); // ideal G contains a
2468  //Groebner basis
2469  lpDHilbert(G,5,2); // invokes procedure with degree bound 5 and 2 variables
2470  // note that the optional parameters are not necessary, due to the finiteness
2471  // of the K-dimension of the factor algebra
2472  lpDHilbert(G); // procedure with ring parameters
2473  lpDHilbert(G,0); // procedure without degreebound
2474}
2475
2476proc lpDHilbertSickle(ideal G, list #)
2477"USAGE: lpDHilbertSickle(G[,degbound,n]); G an ideal, degbound, n optional
2478@*      integers
2479RETURN: list
2480PURPOSE:Computing K-dimension, Hilbert series and mistletoes at once
2481ASSUME: - basering is a Letterplace ring.
2482@*      - if you specify a different degree bound degbound,
2483@*        degbound <= attrib(basering,uptodeg) holds.
2484NOTE: - If L is the list returned, then L[1] is an integer, the K-dimension,
2485@*      L[2] is an intvec, the Hilbert series and L[3] is an ideal,
2486@*      the mistletoes
2487@*    - If degbound is set, there will be a degree bound added. 0 means no
2488@*      degree bound. Default: attrib(basering,uptodeg).
2489@*    - n can be set to a different number of variables.
2490@*      Default: n = attrib(basering, lV).
2491@*    - If I = L[1] is the intvec returned, then I[k] is the (k-1)-th
2492@*      coefficient of the Hilbert series.
2493@*    - If the K-dimension is known to be infinite, a degree bound is needed
2494EXAMPLE: example lpDHilbertSickle; shows examples
2495"
2496{int degbound = attrib(basering,"uptodeg");int n = attrib(basering, "lV");
2497  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] >= 0){degbound = #[1];}}}
2498  if (size(#) > 1){if (typeof(#[1])=="int"){if (#[2] > 0){n = #[2];}}}
2499  list L;
2500  L = lp2ivId(normalize(lead(G)));
2501  L = ivDHilbertSickle(L,n,degbound);
2502  L[3] =  ivL2lpI(L[3]);
2503  return(L);
2504}
2505example
2506{
2507  "EXAMPLE:"; echo = 2;
2508  ring r = 0,(x,y),dp;
2509  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2510  setring R; // sets basering to Letterplace ring
2511  ideal G = x(1)*x(2), y(1)*y(2),x(1)*y(2)*x(3); // ideal G contains a
2512  //Groebner basis
2513  lpDHilbertSickle(G,5,2); //invokes procedure with degree bound 5 and 2 variables
2514  // note that the optional parameters are not necessary, due to the finiteness
2515  // of the K-dimension of the factor algebra
2516  lpDHilbertSickle(G); // procedure with ring parameters
2517  lpDHilbertSickle(G,0); // procedure without degreebound
2518}
2519
2520proc lpHilbert(ideal G, list #)
2521"USAGE: lpHilbert(G[,degbound,n]); G an ideal, degbound, n optional integers
2522RETURN: intvec, containing the coefficients of the Hilbert series
2523PURPOSE:Computing the Hilbert series
2524ASSUME: - basering is a Letterplace ring.
2525@*      - if you specify a different degree bound degbound,
2526@*        degbound <= attrib(basering,uptodeg) holds.
2527NOTE: - If degbound is set, there will be a degree bound added. 0 means no
2528@*      degree bound. Default: attrib(basering,uptodeg).
2529@*    - n is the number of variables, which can be set to a different number.
2530@*      Default: attrib(basering, lV).
2531@*    - If I is returned, then I[k] is the (k-1)-th coefficient of the Hilbert
2532@*      series.
2533@*    - If the K-dimension is known to be infinite, a degree bound is needed
2534EXAMPLE: example lpHilbert; shows examples
2535"
2536{int degbound = attrib(basering,"uptodeg");int n = attrib(basering, "lV");
2537  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] >= 0){degbound = #[1];}}}
2538  if (size(#) > 1){if (typeof(#[1])=="int"){if (#[2] > 0){n = #[2];}}}
2539  list L;
2540  L = lp2ivId(normalize(lead(G)));
2541  return(ivHilbert(L,n,degbound));
2542}
2543example
2544{
2545  "EXAMPLE:"; echo = 2;
2546  ring r = 0,(x,y),dp;
2547  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2548  setring R; // sets basering to Letterplace ring
2549  ideal G = x(1)*x(2), y(1)*y(2),x(1)*y(2)*x(3); // ideal G contains a
2550  //Groebner basis
2551  lpHilbert(G,5,2); // invokes procedure with degree bound 5 and 2 variables
2552  // note that the optional parameters are not necessary, due to the finiteness
2553  // of the K-dimension of the factor algebra
2554  lpDHilbert(G); // procedure with ring parameters
2555  lpDHilbert(G,0); // procedure without degreebound
2556}
2557
2558proc lpDimCheck(ideal G)
2559"USAGE: lpDimCheck(G);
2560RETURN: int, 1 if K-dimension of the factor algebra is infinite, 0 otherwise
2561PURPOSE:Checking a factor algebra for finiteness of the K-dimension
2562ASSUME: - basering is a Letterplace ring.
2563EXAMPLE: example lpDimCheck; shows examples
2564"
2565{int n = attrib(basering,"lV");
2566  list L;
2567  ideal R;
2568  R = normalize(lead(G));
2569  L = lp2ivId(R);
2570  return(ivDimCheck(L,n));
2571}
2572example
2573{
2574  "EXAMPLE:"; echo = 2;
2575  ring r = 0,(x,y),dp;
2576  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2577  setring R; // sets basering to Letterplace ring
2578  ideal G = x(1)*x(2), y(1)*y(2),x(1)*y(2)*x(3);
2579  // Groebner basis
2580  ideal I = x(1)*x(2), y(1)*x(2)*y(3), x(1)*y(2)*x(3);
2581  // Groebner basis
2582  lpDimCheck(G); // invokes procedure, factor algebra is of finite K-dimension
2583  lpDimCheck(I); // invokes procedure, factor algebra is of infinite Kdimension
2584}
2585
2586proc lpKDim(ideal G, list #)
2587"USAGE: lpKDim(G[,degbound, n]); G an ideal, degbound, n optional integers
2588RETURN: int, the K-dimension of the factor algebra
2589PURPOSE:Computing the K-dimension of a factor algebra, given via an ideal
2590ASSUME: - basering is a Letterplace ring
2591@*      - if you specify a different degree bound degbound,
2592@*        degbound <= attrib(basering,uptodeg) holds.
2593NOTE: - If degbound is set, there will be a degree bound added. 0 means no
2594@*      degree bound. Default: attrib(basering, uptodeg).
2595@*    - n is the number of variables, which can be set to a different number.
2596@*      Default: attrib(basering, lV).
2597@*    - If the K-dimension is known to be infinite, a degree bound is needed
2598EXAMPLE: example lpKDim; shows examples
2599"
2600{int degbound = attrib(basering, "uptodeg");int n = attrib(basering, "lV");
2601  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] >= 0){degbound = #[1];}}}
2602  if (size(#) > 1){if (typeof(#[1])=="int"){if (#[2] > 0){n = #[2];}}}
2603  list L;
2604  L = lp2ivId(normalize(lead(G)));
2605  return(ivKDim(L,n,degbound));
2606}
2607example
2608{
2609  "EXAMPLE:"; echo = 2;
2610  ring r = 0,(x,y),dp;
2611  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2612  setring R; // sets basering to Letterplace ring
2613  ideal G = x(1)*x(2), y(1)*y(2),x(1)*y(2)*x(3);
2614  // ideal G contains a Groebner basis
2615  lpKDim(G); //procedure invoked with ring parameters
2616  // the factor algebra is finite, so the degree bound given by the Letterplace
2617  // ring is not necessary
2618  lpKDim(G,0); // procedure without any degree bound
2619}
2620
2621proc lpMis2Dim(ideal M)
2622"USAGE: lpMis2Dim(M); M an ideal
2623RETURN: int, the K-dimension of the factor algebra
2624PURPOSE:Computing the K-dimension out of given mistletoes
2625ASSUME: - basering is a Letterplace ring.
2626@*      - M contains only monomials
2627NOTE:   - The mistletoes have to be ordered lexicographically -> OrdMisLex.
2628EXAMPLE: example lpMis2Dim; shows examples
2629"
2630{list L;
2631  L = lpId2ivLi(M);
2632  return(ivMis2Dim(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 L = x(1)*y(2),y(1)*x(2)*y(3);
2641  // ideal containing the mistletoes
2642  lpMis2Dim(L); // returns the K-dimension of the factor algebra
2643}
2644
2645proc lpOrdMisLex(ideal M)
2646"USAGE: lpOrdMisLex(M); M an ideal of mistletoes
2647RETURN: ideal, containing the mistletoes, ordered lexicographically
2648PURPOSE:A given set of mistletoes is ordered lexicographically
2649ASSUME: - basering is a Letterplace ring.
2650NOTE:   This is preprocessing, it is not needed if the mistletoes are returned
2651@*      from the sickle algorithm.
2652EXAMPLE: example lpOrdMisLex; shows examples
2653"
2654{return(ivL2lpI(sort(lpId2ivLi(M))[1]));}
2655example
2656{
2657  "EXAMPLE:"; echo = 2;
2658  ring r = 0,(x,y),dp;
2659  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2660  setring R; // sets basering to Letterplace ring
2661  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);
2662  // some monomials
2663  lpOrdMisLex(M); // orders the monomials lexicographically
2664}
2665
2666proc lpSickle(ideal G,  list #)
2667"USAGE: lpSickle(G[,degbound,n]); G an ideal, degbound, n optional integers
2668RETURN: ideal
2669PURPOSE:Computing the mistletoes of K[X]/<G>
2670ASSUME: - basering is a Letterplace ring.
2671@*      - if you specify a different degree bound degbound,
2672@*        degbound <= attrib(basering,uptodeg) holds.
2673NOTE: - If degbound is set, there will be a degree bound added. 0 means no
2674@*      degree bound. Default: attrib(basering,uptodeg).
2675@*    - n is the number of variables, which can be set to a different number.
2676@*      Default: attrib(basering, lV).
2677@*    - If the K-dimension is known to be infinite, a degree bound is needed
2678EXAMPLE: example lpSickle; shows examples
2679"
2680{int degbound = attrib(basering,"uptodeg"); int n = attrib(basering, "lV");
2681  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] >= 0){degbound = #[1];}}}
2682  if (size(#) > 1){if (typeof(#[1])=="int"){if (#[2] > 0){n = #[2];}}}
2683  list L; ideal R;
2684  R = normalize(lead(G));
2685  L = lp2ivId(R);
2686  L = ivSickle(L,n,degbound);
2687  R = ivL2lpI(L);
2688  return(R);
2689}
2690example
2691{
2692  "EXAMPLE:"; echo = 2;
2693  ring r = 0,(x,y),dp;
2694  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2695  setring R; // sets basering to Letterplace ring
2696  ideal G = x(1)*x(2), y(1)*y(2),x(1)*y(2)*x(3); // ideal G contains a
2697  //Groebner basis
2698  lpSickle(G); //invokes the procedure with ring parameters
2699  // the factor algebra is finite, so the degree bound given by the Letterplace
2700  // ring is not necessary
2701  lpSickle(G,0); // procedure without any degree bound
2702}
2703
2704proc lpSickleDim(ideal G, list #)
2705"USAGE: lpSickleDim(G[,degbound,n]); G an ideal, degbound, n optional integers
2706RETURN: list
2707PURPOSE:Computing the K-dimension and the mistletoes
2708ASSUME: - basering is a Letterplace ring.
2709@*      - if you specify a different degree bound degbound,
2710@*        degbound <= attrib(basering,uptodeg) holds.
2711NOTE: - If L is the list returned, then L[1] is an integer, the K-dimension,
2712@*      L[2] is an ideal, the mistletoes.
2713@*    - If degbound is set, there will be a degree bound added. 0 means no
2714@*      degree bound. Default: attrib(basering,uptodeg).
2715@*    - n is the number of variables, which can be set to a different number.
2716@*      Default: attrib(basering, lV).
2717@*    - If the K-dimension is known to be infinite, a degree bound is needed
2718EXAMPLE: example lpSickleDim; shows examples
2719"
2720{int degbound = attrib(basering,"uptodeg");int n = attrib(basering, "lV");
2721  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] >= 0){degbound = #[1];}}}
2722  if (size(#) > 1){if (typeof(#[1])=="int"){if (#[2] > 0){n = #[2];}}}
2723  list L;
2724  L = lp2ivId(normalize(lead(G)));
2725  L = ivSickleDim(L,n,degbound);
2726  L[2] = ivL2lpI(L[2]);
2727  return(L);
2728}
2729example
2730{
2731  "EXAMPLE:"; echo = 2;
2732  ring r = 0,(x,y),dp;
2733  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2734  setring R; // sets basering to Letterplace ring
2735  ideal G = x(1)*x(2), y(1)*y(2),x(1)*y(2)*x(3); // ideal G contains a
2736  //Groebner basis
2737  lpSickleDim(G); // invokes the procedure with ring parameters
2738  // the factor algebra is finite, so the degree bound given by the Letterplace
2739  // ring is not necessary
2740  lpSickleDim(G,0); // procedure without any degree bound
2741}
2742
2743proc lpSickleHil(ideal G, list #)
2744"USAGE: lpSickleHil(G);
2745RETURN: list
2746PURPOSE:Computing the Hilbert series and the mistletoes
2747ASSUME: - basering is a Letterplace ring.
2748@*      - if you specify a different degree bound degbound,
2749@*        degbound <= attrib(basering,uptodeg) holds.
2750NOTE: - If L is the list returned, then L[1] is an intvec, corresponding to the
2751@*      Hilbert series, L[2] is an ideal, the mistletoes.
2752@*    - If degbound is set, there will be a degree bound added. 0 means no
2753@*      degree bound. Default: attrib(basering,uptodeg).
2754@*    - n is the number of variables, which can be set to a different number.
2755@*      Default: attrib(basering, lV).
2756@*    - If I = L[1] is the intvec returned, then I[k] is the (k-1)-th
2757@*      coefficient of the Hilbert series.
2758@*    - If the K-dimension is known to be infinite, a degree bound is needed
2759EXAMPLE: example lpSickleHil; shows examples
2760"
2761{int degbound = attrib(basering,"uptodeg");int n = attrib(basering, "lV");
2762  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] >= 0){degbound = #[1];}}}
2763  if (size(#) > 1){if (typeof(#[1])=="int"){if (#[2] > 0){n = #[2];}}}
2764  list L;
2765  L = lp2ivId(normalize(lead(G)));
2766  L = ivSickleHil(L,n,degbound);
2767  L[2] =  ivL2lpI(L[2]);
2768  return(L);
2769}
2770example
2771{
2772  "EXAMPLE:"; echo = 2;
2773  ring r = 0,(x,y),dp;
2774  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2775  setring R; // sets basering to Letterplace ring
2776  ideal G = x(1)*x(2), y(1)*y(2),x(1)*y(2)*x(3); // ideal G contains a
2777  //Groebner basis
2778  lpSickleHil(G); // invokes the procedure with ring parameters
2779  // the factor algebra is finite, so the degree bound given by the Letterplace
2780  // ring is not necessary
2781  lpSickleHil(G,0); // procedure without any degree bound
2782}
2783
2784proc sickle(ideal G, list #)
2785"USAGE: sickle(G[,m, d, h, degbound]); G an ideal; m,d,h,degbound optional
2786@*      integers
2787RETURN: list
2788PURPOSE:Allowing the user to access all procs with one command
2789ASSUME: - basering is a Letterplace ring.
2790@*      - if you specify a different degree bound degbound,
2791@*        degbound <= attrib(basering,uptodeg) holds.
2792NOTE:   The returned object will always be a list, but the entries of the
2793@*      returned list may be very different
2794@* case m=1,d=1,h=1: see lpDHilbertSickle
2795@* case m=1,d=1,h=0: see lpSickleDim
2796@* case m=1,d=0,h=1: see lpSickleHil
2797@* case m=1,d=0,h=0: see lpSickle (this is the default case)
2798@* case m=0,d=1,h=1: see lpDHilbert
2799@* case m=0,d=1,h=0: see lpKDim
2800@* case m=0,d=0,h=1: see lpHilbert
2801@* case m=0,d=0,h=0: returns an error
2802@*    - If degbound is set, there will be a degree bound added. 0 means no
2803@*      degree bound. Default: attrib(basering,uptodeg).
2804@*    - If the K-dimension is known to be infinite, a degree bound is needed
2805EXAMPLE: example sickle; shows examples
2806"
2807{int m,d,h,degbound;
2808  m = 1; d = 0; h = 0; degbound = attrib(basering,"uptodeg");
2809  if (size(#) > 0) {if (typeof(#[1])=="int"){if (#[1] < 1) {m = 0;}}}
2810  if (size(#) > 1) {if (typeof(#[1])=="int"){if (#[2] > 0) {d = 1;}}}
2811  if (size(#) > 2) {if (typeof(#[1])=="int"){if (#[3] > 0) {h = 1;}}}
2812  if (size(#) > 3) {if (typeof(#[1])=="int"){if (#[4] >= 0) {degbound = #[4];}}}
2813  if (m == 1)
2814  {if (d == 0)
2815    {if (h == 0) {return(lpSickle(G,degbound,attrib(basering,"lV")));}
2816      else        {return(lpSickleHil(G,degbound,attrib(basering,"lV")));}
2817    }
2818    else
2819    {if (h == 0) {return(lpSickleDim(G,degbound,attrib(basering,"lV")));}
2820      else {return(lpDHilbertSickle(G,degbound,attrib(basering,"lV")));}
2821    }
2822  }
2823  else
2824  {if (d == 0)
2825    {if (h == 0) {ERROR("You request to do nothing, so relax and do so");}
2826      else        {return(lpHilbert(G,degbound,attrib(basering,"lV")));}
2827    }
2828    else
2829    {if (h == 0) {return(lpKDim(G,degbound,attrib(basering,"lV")));}
2830      else {return(lpDHilbert(G,degbound,attrib(basering,"lV")));}
2831    }
2832  }
2833}
2834example
2835{
2836  "EXAMPLE:"; echo = 2;
2837  ring r = 0,(x,y),dp;
2838  def R = makeLetterplaceRing(5); // constructs a Letterplace ring
2839  setring R; // sets basering to Letterplace ring
2840  ideal G = x(1)*x(2), y(1)*y(2),x(1)*y(2)*x(3);
2841  // G contains a Groebner basis
2842  sickle(G,1,1,1); // computes mistletoes, K-dimension and the Hilbert series
2843  sickle(G,1,0,0); // computes mistletoes only
2844  sickle(G,0,1,0); // computes K-dimension only
2845  sickle(G,0,0,1); // computes Hilbert series only
2846}
2847
2848///////////////////////////////////////////////////////////////////////////////
2849/* vl: new stuff for conversion to Magma and to SD
2850todo: doc, example
2851*/
2852proc extractVars(r)
2853{
2854  int i = 1;
2855  int j = 1;
2856  string candidate;
2857  list result = list();
2858  for (i = 1; i<=nvars(r);i++)
2859  {
2860        candidate = string(var(i))[1,find(string(var(i)),"(")-1];
2861        if (!inList(result, candidate))
2862        {
2863          result = insert(result,candidate,size(result));
2864        }
2865  }
2866  return(result);
2867}
2868
2869proc letterPlacePoly2MagmaString(poly h)
2870{
2871  int pos;
2872  string s = string(h);
2873  while(find(s,"("))
2874  {
2875    pos = find(s,"(");
2876    while(s[pos]!=")")
2877    {
2878      s = s[1,pos-1]+s[pos+1,size(s)-pos];
2879    }
2880    if (size(s)!=pos)
2881    {
2882        s = s[1,pos-1]+s[pos+1,size(s)-pos]; // The last (")")
2883    }
2884    else
2885    {
2886                s = s[1,pos-1];
2887        }
2888  }
2889  return(s);
2890}
2891
2892proc letterPlaceIdeal2SD(ideal I, int upToDeg)
2893{
2894  int i;
2895  print("Don't forget to fill in the formal Data in the file");
2896  string result = "<?xml version=\"1.0\"?>"+newline+"<FREEALGEBRA createdAt=\"\" createdBy=\"Singular\" id=\"FREEALGEBRA/\">"+newline;
2897  result = result + "<vars>"+string(extractVars(basering))+"</vars>"+newline;
2898  result = result + "<basis>"+newline;
2899  for (i = 1;i<=size(I);i++)
2900  {
2901    result = result + "<poly>"+letterPlacePoly2MagmaString(I[i])+"</poly>"+newline;
2902  }
2903  result = result + "</basis>"+newline;
2904  result = result + "<uptoDeg>"+ string(upToDeg)+"</uptoDeg>"+newline;
2905  result = result + "<Comment></Comment>"+newline;
2906  result = result + "<Version></Version>"+newline;
2907  result = result + "</FREEALGEBRA>";
2908  return(result);
2909}
2910
2911
2912///////////////////////////////////////////////////////////////////////////////
2913
2914
2915proc tst_fpadim()
2916{
2917  example ivDHilbert;
2918  example ivDHilbertSickle;
2919  example ivDimCheck;
2920  example ivHilbert;
2921  example ivKDim;
2922  example ivMis2Dim;
2923  example ivOrdMisLex;
2924  example ivSickle;
2925  example ivSickleHil;
2926  example ivSickleDim;
2927  example lpDHilbert;
2928  example lpDHilbertSickle;
2929  example lpHilbert;
2930  example lpDimCheck;
2931  example lpKDim;
2932  example lpMis2Dim;
2933  example lpOrdMisLex;
2934  example lpSickle;
2935  example lpSickleHil;
2936  example lpSickleDim;
2937  example sickle;
2938  example ivL2lpI;
2939  example iv2lp;
2940  example iv2lpList;
2941  example iv2lpMat;
2942  example lp2iv;
2943  example lp2ivId;
2944  example lpId2ivLi;
2945}
2946
2947
2948/*proc lpSubstituteExpandRing(poly f, list s1, list s2) {*/
2949  /*int minDegBound = calcSubstDegBound(f,s1,s2);*/
2950/**/
2951  /*def R = basering; // curr lp ring*/
2952  /*setring ORIGINALRING; // non lp ring TODO*/
2953  /*def R1 = makeLetterplaceRing(minDegBound);*/
2954  /*setring R1;*/
2955/**/
2956  /*poly g = lpSubstitute(imap(R,f), imap(R,s1), imap(R,s2));*/
2957/**/
2958  /*return (R1); // return the new ring*/
2959/*}*/
2960
2961proc lpSubstitute(poly f, list s1, list s2, list #)
2962"USAGE: lpSubstitute(f,s1,s2[,G]); f letterplace polynomial, s1 list of variables
2963@*      to replace, s2 list of polynomials to replace with, G optional ideal to
2964@*      reduce with.
2965RETURN: poly, the substituted polynomial
2966ASSUME: - basering is a Letterplace ring
2967@*      - G is a groebner basis,
2968@*      - the current ring has a sufficient degbound (can be calculated with
2969@*        calcSubstDegBound())
2970EXAMPLE: example lpSubstitute; shows examples
2971"
2972{
2973  ideal G;
2974  if (size(#) > 0) {
2975    if (typeof(#[1])=="ideal") {
2976      G = #[1];
2977    }
2978  }
2979
2980  poly fs;
2981  for (int i = 1; i <= size(f); i++) {
2982    poly fis = leadcoef(f[i]);
2983    intvec ivfi = lp2iv(f[i]);
2984    for (int j = 1; j <= size(ivfi); j++) {
2985      int varindex = ivfi[j];
2986      int subindex = indexof(s1, varindex);
2987      if (subindex > 0) {
2988        s2[subindex] = lpNF(s2[subindex],G);
2989        fis = lpMult(fis, s2[subindex]);
2990      } else {
2991        fis = lpMult(fis, lpNF(iv2lp(varindex),G));
2992      }
2993      /*fis = lpNF(fis,G);*/
2994    }
2995    fs = fs + fis;
2996  }
2997  fs = lpNF(fs, G);
2998  return (fs);
2999}
3000example {
3001  LIB "fpadim.lib";
3002  ring r = 0,(x,y,z),dp;
3003  def R = makeLetterplaceRing(4);
3004  setring R;
3005
3006  ideal G = x(1)*y(2); // optional
3007
3008  poly f = 3*x(1)*x(2)+y(1)*x(2);
3009  list s1 = x(1), y(1);
3010  list s2 = y(1)*z(2)*z(3), x(1);
3011
3012  // the substitution probably needs a higher degbound
3013  int minDegBound = calcSubstDegBounds(f,s1,s2);
3014  setring r;
3015  def R1 = makeLetterplaceRing(minDegBound);
3016  setring R1;
3017
3018  // the last parameter is optional
3019  lpSubstitute(imap(R,f), imap(R,s1), imap(R,s2), imap(R,G));
3020}
3021example {
3022  LIB "fpadim.lib";
3023  ring r = 0,(x,y,z),dp;
3024  def R = makeLetterplaceRing(4);
3025  setring R;
3026
3027  poly f = 3*x(1)*x(2)+y(1)*x(2);
3028  poly g = z(1)*x(2)+y(1);
3029  poly h = 7*x(1)*z(2)+x(1);
3030  list L = f,g,h;
3031  list s1 = x(1), y(1);
3032  list s2 = y(1)*z(2)*z(3), x(1);
3033
3034  int minDegBound = calcSubstDegBounds(L,s1,s2);
3035  setring r;
3036  def R1 = makeLetterplaceRing(minDegBound);
3037  setring R1;
3038
3039  list L = imap(R,L);
3040  list s1 = imap(R,s1);
3041  list s2 = imap(R,s2);
3042  for (int i = 1; i <= size(L); i++) {
3043    lpSubstitute(L[i], s1, s2);
3044  }
3045}
3046
3047static proc indexof(list L, int varindex) {
3048  for (int i = 1; i <= size(L); i++) {
3049    if (lp2iv(L[i])[1] == varindex) {
3050      return (i);
3051    }
3052  }
3053  return (-1);
3054}
3055
3056proc calcSubstDegBound(poly f, list s1, list s2)
3057"USAGE: calcSubstDegBound(f,s1,s2); f letterplace polynomial, s1 list of variables
3058@*      to replace, s2 list of polynomials to replace with
3059RETURN: int, the min degbound required to perform the substitution
3060ASSUME: - basering is a Letterplace ring
3061EXAMPLE: example lpSubstitute; shows examples
3062"
3063{
3064  int maxDegBound = 0;
3065  for (int i = 1; i <= size(f); i++) {
3066    intvec ivfi = lp2iv(f[i]);
3067    int tmpDegBound;
3068    for (int j = 1; j <= size(ivfi); j++) {
3069      int varindex = ivfi[j];
3070      int subindex = indexof(s1, varindex);
3071      if (subindex > 0) {
3072        tmpDegBound = tmpDegBound + deg(s2[subindex]);
3073      } else {
3074        tmpDegBound = tmpDegBound + 1;
3075      }
3076    }
3077    if (tmpDegBound > maxDegBound) {
3078      maxDegBound = tmpDegBound;
3079    }
3080  }
3081
3082  // increase degbound by 50% when ideal is provided
3083  // needed for lpNF
3084  maxDegBound = maxDegBound + maxDegBound/2;
3085
3086  return (maxDegBound);
3087}
3088
3089// convenience method
3090proc calcSubstDegBounds(list L, list s1, list s2)
3091"USAGE: calcSubstDegBounds(L,s1,s2); L list of letterplace polynomials, s1 list
3092@*      of variables to replace, s2 list of polynomials to replace with
3093RETURN: int, the min degbound required to perform all of the substitutions
3094ASSUME: - basering is a Letterplace ring
3095EXAMPLE: example lpSubstitute; shows examples
3096"
3097{
3098  int maxDegBound = 0;
3099  for (int i = 1; i <= size(L); i++) {
3100    int tmpDegBound = calcSubstDegBound(L[i], s1, s2, #);
3101    if (tmpDegBound > maxDegBound) {
3102      maxDegBound = tmpDegBound;
3103    }
3104  }
3105  return (maxDegBound);
3106}
3107
3108
3109/*
3110  Here are some examples one may try. Just copy them into your console.
3111  These are relations for braid groups, up to degree d:
3112
3113
3114  LIB "fpadim.lib";
3115  ring r = 0,(x,y,z),dp;
3116  int d =10; // degree
3117  def R = makeLetterplaceRing(d);
3118  setring R;
3119  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),
3120  z(1)*x(2)*z(3) - y(1)*z(2)*x(3), x(1)*x(2)*x(3) + y(1)*y(2)*y(3) +
3121  z(1)*z(2)*z(3) + x(1)*y(2)*z(3);
3122  option(prot);
3123  option(redSB);option(redTail);option(mem);
3124  ideal J = system("freegb",I,d,3);
3125  lpDimCheck(J);
3126  sickle(J,1,1,1,d);//Computes mistletoes, K-dimension and the Hilbert series
3127
3128
3129
3130  LIB "fpadim.lib";
3131  ring r = 0,(x,y,z),dp;
3132  int d =11; // degree
3133  def R = makeLetterplaceRing(d);
3134  setring R;
3135  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),
3136  z(1)*x(2)*z(3) - y(1)*z(2)*x(3), x(1)*x(2)*x(3) + y(1)*y(2)*y(3) +
3137  z(1)*z(2)*z(3) + x(1)*y(2)*z(3);
3138  option(prot);
3139  option(redSB);option(redTail);option(mem);
3140  ideal J = system("freegb",I,d,3);
3141  lpDimCheck(J);
3142  sickle(J,1,1,1,d);
3143
3144
3145
3146  LIB "fpadim.lib";
3147  ring r = 0,(x,y,z),dp;
3148  int d  = 6; // degree
3149  def R  = makeLetterplaceRing(d);
3150  setring R;
3151  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),
3152  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);
3153  option(prot);
3154  option(redSB);option(redTail);option(mem);
3155  ideal J = system("freegb",I,d,3);
3156  lpDimCheck(J);
3157  sickle(J,1,1,1,d);
3158*/
3159
3160/*
3161  Here are some examples, which can also be found in [studzins]:
3162
3163  // takes up to 880Mb of memory
3164  LIB "fpadim.lib";
3165  ring r = 0,(x,y,z),dp;
3166  int d =10; // degree
3167  def R = makeLetterplaceRing(d);
3168  setring R;
3169  ideal I =
3170  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);
3171  option(prot);
3172  option(redSB);option(redTail);option(mem);
3173  ideal J = system("freegb",I,d,nvars(r));
3174  lpDimCheck(J);
3175  sickle(J,1,1,1,d); // dimension is 24872
3176
3177
3178  LIB "fpadim.lib";
3179  ring r = 0,(x,y,z),dp;
3180  int d =10; // degree
3181  def R = makeLetterplaceRing(d);
3182  setring R;
3183  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);
3184  option(prot);
3185  option(redSB);option(redTail);option(mem);
3186  ideal J = system("freegb",I,d,3);
3187  lpDimCheck(J);
3188  sickle(J,1,1,1,d);
3189*/
3190
3191
3192/*
3193Example for computing GK dimension:
3194returns a ring which contains an ideal I
3195run gkDim(I) inside this ring and it should return 2n (the GK dimension
3196of n-th Weyl algebra including evaluation operators).
3197
3198proc createWeylEx(int n, int d)
3199"
3200"
3201{
3202  int baseringdef;
3203 if (defined(basering)) // if a basering is defined, it should be saved for later use
3204 {
3205  def save = basering;
3206  baseringdef = 1;
3207 }
3208 ring r = 0,(d(1..n),x(1..n),e(1..n)),dp;
3209 def R = makeLetterplaceRing(d);
3210 setring R;
3211 ideal I; int i,j;
3212
3213 for (i = 1; i <= n; i++)
3214 {
3215  for (j = i+1; j<= n; j++)
3216  {
3217   I[size(I)+1] = lpMult(var(i),var(j));
3218  }
3219 }
3220
3221 for (i = 1; i <= n; i++)
3222 {
3223  for (j = i+1; j<= n; j++)
3224  {
3225   I[size(I)+1] = lpMult(var(n+i),var(n+j));
3226  }
3227 }
3228 for (i = 1; i <= n; i++)
3229 {
3230  for (j = 1; j<= n; j++)
3231  {
3232   I[size(I)+1] = lpMult(var(i),var(n+j));
3233  }
3234 }
3235  for (i = 1; i <= n; i++)
3236 {
3237  for (j = 1; j<= n; j++)
3238  {
3239   I[size(I)+1] = lpMult(var(i),var(2*n+j));
3240  }
3241 }
3242 for (i = 1; i <= n; i++)
3243 {
3244  for (j = 1; j<= n; j++)
3245  {
3246   I[size(I)+1] = lpMult(var(2*n+i),var(n+j));
3247  }
3248 }
3249  for (i = 1; i <= n; i++)
3250 {
3251  for (j = 1; j<= n; j++)
3252  {
3253   I[size(I)+1] = lpMult(var(2*n+i),var(2*n+j));
3254  }
3255 }
3256 I = simplify(I,2+4);
3257 I = letplaceGBasis(I);
3258 export(I);
3259 if (baseringdef == 1) {setring save;}
3260 return(R);
3261}
3262
3263proc TestGKAuslander3()
3264{
3265ring r = (0,q),(z,x,y),(dp(1),dp(2));
3266def R = makeLetterplaceRing(5); // constructs a Letterplace ring
3267R; setring R; // sets basering to Letterplace ring
3268ideal I;
3269I = 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);
3270I = letplaceGBasis(I);
3271lpGkDim(I); // must be 3
3272I = 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
3273I = letplaceGBasis(I); // not finite BUT contains a poly in x,y only
3274lpGkDim(I); // must be 4
3275
3276ring r = 0,(y,x,z),dp;
3277def R = makeLetterplaceRing(10); // constructs a Letterplace ring
3278R; setring R; // sets basering to Letterplace ring
3279ideal I;
3280I = 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
3281I = letplaceGBasis(I); // computed as it would be homogenized; infinite
3282poly p = x(1)*y(2)*y(3)*x(4)-y(1)*x(2)*x(3)*y(4);
3283lpNF(p, I); // 0 as expected
3284
3285// with inverse of z
3286ring r = 0,(iz,z,x,y),dp;
3287def R = makeLetterplaceRing(11); // constructs a Letterplace ring
3288R; setring R; // sets basering to Letterplace ring
3289ideal I;
3290I = 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),
3291iz(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;
3292I = letplaceGBasis(I); //
3293setring r;
3294def R2 = makeLetterplaceRing(23); // constructs a Letterplace ring
3295setring R2; // sets basering to Letterplace ring
3296ideal I = imap(R,I);
3297lpGkDim(I);
3298
3299
3300ring r = 0,(t,z,x,y),(dp(2),dp(2));
3301def R = makeLetterplaceRing(20); // constructs a Letterplace ring
3302R; setring R; // sets basering to Letterplace ring
3303ideal I;
3304I = 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),
3305t(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
3306I = letplaceGBasis(I); // computed as it would be homogenized; infinite
3307LIB "elim.lib";
3308ideal Inoz = nselect(I,intvec(2,6,10,14,18,22,26,30));
3309for(int i=1; i<=20; i++)
3310{
3311Inoz=subst(Inoz,t(i),1);
3312}
3313ideal J = x(1)*y(2)*y(3)*x(4)-y(1)*x(2)*x(3)*y(4);
3314J = letplaceGBasis(J);
3315
3316poly p = x(1)*y(2)*y(3)*x(4)-y(1)*x(2)*x(3)*y(4);
3317lpNF(p, I); // 0 as expected
3318
3319ring r2 = 0,(x,y),dp;
3320def R2 = makeLetterplaceRing(50); // constructs a Letterplace ring
3321setring R2;
3322ideal J = x(1)*y(2)*y(3)*x(4)-y(1)*x(2)*x(3)*y(4);
3323J = letplaceGBasis(J);
3324}
3325
3326*/
3327
3328
3329/*   actual work:
3330// downup algebra A
3331LIB "fpadim.lib";
3332ring r = (0,a,b,g),(x,y),Dp;
3333def R = makeLetterplaceRing(6); // constructs a Letterplace ring
3334setring R;
3335poly F1 = g*x(1);
3336poly F2 = g*y(1);
3337ideal J = x(1)*x(2)*y(3)-a*x(1)*y(2)*x(3) - b*y(1)*x(2)*x(3) - F1,
3338x(1)*y(2)*y(3)-a*y(1)*x(2)*y(3) - b*y(1)*y(2)*x(3) - F2;
3339J = letplaceGBasis(J);
3340lpGkDim(J); // 3 == correct
3341
3342// downup algebra B
3343LIB "fpadim.lib";
3344ring r = (0,a,b,g, p(1..7),q(1..7)),(x,y),Dp;
3345def R = makeLetterplaceRing(6); // constructs a Letterplace ring
3346setring R;
3347ideal 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);
3348int i;
3349poly F1, F2;
3350for(i=1;i<=7;i++)
3351{
3352F1 = F1 + p(i)*imn[i];
3353F2 = F2 + q(i)*imn[i];
3354}
3355ideal J = x(1)*x(2)*y(3)-a*x(1)*y(2)*x(3) - b*y(1)*x(2)*x(3) - F1,
3356x(1)*y(2)*y(3)-a*y(1)*x(2)*y(3) - b*y(1)*y(2)*x(3) - F2;
3357J = letplaceGBasis(J);
3358lpGkDim(J); // 3 == correct
3359
3360*/
Note: See TracBrowser for help on using the repository browser.