source: git/Singular/LIB/fpadim.lib @ 437cdbc

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