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

spielwiese
Last change on this file since dfa15b was dfa15b, checked in by Hans Schoenemann <hannes@…>, 5 years ago
fix doc in LP-libs
  • Property mode set to 100755
File size: 76.0 KB
Line 
1////////////////////////////////////////////////////////
2version="version fpadim.lib 4.1.1.4 Oct_2018 "; // $Id$
3category="Noncommutative";
4info="
5LIBRARY: fpadim.lib     Vector space dimension, basis and Hilbert series for finitely presented algebras (Letterplace)
6AUTHORS: Grischa Studzinski,       grischa.studzinski at rwth-aachen.de
7@*       Viktor Levandovskyy,      viktor.levandovskyy at math.rwth-aachen.de
8@*       Karim Abou Zeid,          karim.abou.zeid at rwth-aachen.de
9
10Support: Joint projects LE 2697/2-1 and KR 1907/3-1 of the Priority Programme SPP 1489:
11'Algorithmische und Experimentelle Methoden in Algebra, Geometrie und Zahlentheorie'
12of the German DFG (2010-2013)
13and Project II.6 of the transregional collaborative research centre
14SFB-TRR 195 'Symbolic Tools in Mathematics and their Application' of the German DFG  (from 2017 on)
15
16KEYWORDS: finitely presented algebra; Letterplace Groebner basis; K-basis; K-dimension; Hilbert series
17
18NOTE:
19- basering is a Letterplace ring
20- all intvecs correspond to Letterplace monomials
21- if a degree bound d is specified, d <= attrib(basering,uptodeg) holds
22
23In the procedures below, 'iv' stands for intvec representation
24and 'lp' for the letterplace representation of monomials
25
26OVERVIEW:
27      Given the free associative algebra A = K<x_1,...,x_n> and
28      a (finite or truncated) Groebner basis GB, one is interested in
29      the following data:
30          - the K-dimension of A/<GB> (check for finiteness or explicit value)
31          - the Hilbert series of A/<GB>
32          - the explicit monomial K-basis of A/<GB>
33      In order to determine these, we need
34      - the Ufnarovskij graph induced by GB
35      - the mistletoes of A/<GB> (which are special monomials in a basis)
36
37      The Ufnarovskij graph is used to determine whether A/<GB> has finite
38      K-dimension. One has to check if the graph contains cycles.
39      For the whole theory we refer to [Ufn]. Given a
40      reduced set of monomials GB one can define the basis tree, whose vertex
41      set V consists of all normal monomials w.r.t. GB. For every two
42      monomials m_1, m_2 in V there is a direct edge from m_1 to m_2, if and
43      only if there exists x_k in {x_1,..,x_n}, such that m_1*x_k = m_2. The
44      set M = {m in V | there is no edge from m to another monomial in V} is
45      called the set of mistletoes. As one can easily see it consists of
46      the endpoints of the graph. Since there is a unique path to every
47      monomial in V, the whole graph can be described only from the knowledge
48      of the mistletoes. Note that V corresponds to a basis of A/<GB>, so
49      knowing the mistletoes we know a K-basis. The name mistletoes was given
50      to those points because of these miraculous value and the algorithm is
51      named sickle, because a sickle is the tool to harvest mistletoes.
52      For more details see [Stu]. This package uses the Letterplace
53      format introduced by [LL09]. The algebra can either be represented as a
54      Letterplace ring or via integer vectors: Every variable will only be
55      represented by its number, so variable one is represented as 1,
56      variable two as 2 and so on. The monomial x_1*x_3*x_2 for example will
57      be stored as (1,3,2). Multiplication is concatenation. Note that the
58      approach in this library does not need an algorithm for computing the normal
59      form. Note that fpa is an acronym for Finitely Presented Algebra.
60
61
62REFERENCES:
63[Ufn] V. Ufnarovskij: Combinatorical and asymptotic methods in algebra, 1990.
64[LL09] R. La Scala, V. Levandovskyy: Letterplace ideals and non-commutative
65Groebner bases, Journal of Symbolic Computation, 2009.
66[Stu] G. Studzinski: Dimension computations in non-commutative,
67associative algebras, Diploma thesis, RWTH Aachen, 2010.
68
69PROCEDURES:
70lpKDimCheck(G);            checks whether the K-dimension of A/<G> is finite
71lpKDim(G[,d,n]);           computes the K-dimension of A/<G>
72lpMonomialBasis(d, donly, J); computes a list of monomials not contained in J
73lpHilbert(G[,d,n]);        computes the truncated Hilbert series of A/<G>
74lpSickleDim(G[,d,n]);      computes the mistletoes and the K-dimension of A/<G>
75
76SEE ALSO: freegb_lib, fpaprops_lib, ncHilb_lib
77";
78
79LIB "freegb.lib"; //for letterplace rings
80LIB "general.lib";//for sorting mistletoes
81
82/////////////////////////////////////////////////////////
83
84/* very fast and cheap test of consistency and functionality
85  DO NOT make it static !
86  after adding the new proc, add it here */
87proc tstfpadim()
88{
89  example ivDHilbert;
90  example ivDHilbertSickle;
91  example ivKDimCheck;
92  example ivHilbert;
93  example ivKDim;
94  example ivMis2Base;
95  example ivMis2Dim;
96  example ivOrdMisLex;
97  example ivSickle;
98  example ivSickleHil;
99  example ivSickleDim;
100  example lpDHilbert;
101  example lpDHilbertSickle;
102  example lpHilbert;
103  example lpKDimCheck;
104  example lpKDim;
105  example lpMis2Base;
106  example lpMis2Dim;
107  example lpOrdMisLex;
108  example lpSickle;
109  example lpSickleHil;
110  example lpSickleDim;
111  example sickle;
112  example lpMonomialBasis;
113}
114
115
116//--------------- auxiliary procedures ------------------
117
118static proc allVars(list L, intvec P, int n)
119"USAGE: allVars(L,P,n); L a list of intmats, P an intvec, n an integer
120RETURN: int, 0 if all variables are contained in the quotient algebra, 1 otherwise
121"
122{int i,j,r;
123  intvec V;
124  for (i = 1; i <= size(P); i++) {if (P[i] == 1){ j = i; break;}}
125  V = L[j][1..nrows(L[j]),1];
126  for (i = 1; i <= n; i++) {if (isInVec(i,V) == 0) {r = 1; break;}}
127  if (r == 0) {return(1);}
128  else {return(0);}
129}
130
131static proc checkAssumptions(int d, list L)
132"PURPOSE: Checks, if all the Assumptions are holding
133"
134{if (!isFreeAlgebra(basering)) {ERROR("Basering is not a Letterplace ring!");}
135  if (d > lpDegBound(basering)) {ERROR("Specified degree bound exceeds ring parameter!");}
136  int i;
137  for (i = 1; i <= size(L); i++)
138  {if (entryViolation(L[i], lpVarBlockSize(basering)))
139    {ERROR("Not allowed monomial/intvec found!");}
140  }
141  return();
142}
143
144static proc createStartMat(int d, int n)
145"USAGE: createStartMat(d,n); d, n integers
146RETURN: intmat
147PURPOSE:Creating the intmat with all normal monomials in n variables and of degree d to start with
148NOTE:   d has to be > 0
149"
150{intmat M[(n^d)][d];
151  int i1,i2,i3,i4;
152  for (i1 = 1; i1 <= d; i1++)  //Spalten
153  {i2 = 1; //durchlaeuft Zeilen
154    while (i2 <= (n^d))
155    {for (i3 = 1; i3 <= n; i3++)
156      {for (i4 = 1; i4 <= (n^(i1-1)); i4++)
157        {M[i2,i1] = i3;
158          i2 = i2 + 1;
159        }
160      }
161    }
162  }
163  return(M);
164}
165
166static proc createStartMat1(int n, intmat M)
167"USAGE: createStartMat1(n,M); n an integer, M an intmat
168RETURN: intmat, with all variables except those in M
169"
170{int i;
171  intvec V,Vt;
172  V = M[(1..nrows(M)),1];
173  for (i = 1; i <= size(V); i++) {if (isInVec(i,V) == 0) {Vt = Vt,i;}}
174  if (Vt == 0) {intmat S; return(S);}
175  else {Vt = Vt[2..size(Vt)]; intmat S [size(Vt)][1]; S[1..size(Vt),1] = Vt; return(S);}
176}
177
178static proc entryViolation(intmat M, int n)
179"PURPOSE:checks, if all entries in M are variable-related
180"
181{int i,j;
182  for (i = 1; i <= nrows(M); i++)
183  {for (j = 1; j <= ncols(M); j++)
184    {if(!((1<=M[i,j])&&(M[i,j]<=n))) {return(1);}}
185  }
186  return(0);
187}
188
189static proc findDimen(intvec V, int n, list L, intvec P, list #)
190"USAGE: findDimen(V,n,L,P,degbound); V,P intvecs, n, an integer, L a list,
191@*      degbound an optional integer
192RETURN: int
193PURPOSE:Compute the K-dimension of the quotient algebra
194"
195{int degbound = 0;
196  if (size(#) > 0) {if (#[1] > 0) {degbound = #[1];}}
197  int dimen,i,j,w,it;
198  intvec Vt,Vt2;
199  module M;
200  if (degbound == 0)
201  {for (i = 1; i <= n; i++)
202    {Vt = V, i; w = 0;
203      for (j = 1; j<= size(P); j++)
204      {if (P[j] <= size(Vt))
205        {Vt2 = Vt[(size(Vt)-P[j]+1)..size(Vt)];
206          if (isInMat(Vt2,L[j]) > 0) {w = 1; break;}
207        }
208      }
209      if (w == 0)
210      {vector Vtt;
211        for (it = 1; it <= size(Vt); it++){Vtt = Vtt + Vt[it]*gen(it);}
212        M = M,Vtt;
213        kill Vtt;
214      }
215    }
216    if (size(M) == 0) {return(0);}
217    else
218    {M = simplify(M,2);
219      for (i = 1; i <= size(M); i++)
220      {kill Vt; intvec Vt;
221        for (j =1; j <= size(M[i]); j++){Vt[j] =  int(leadcoef(M[i][j]));}
222        dimen = dimen + 1 + findDimen(Vt,n,L,P);
223      }
224      return(dimen);
225    }
226  }
227  else
228  {if (size(V) > degbound) {ERROR("monomial exceeds degreebound");}
229    if (size(V) == degbound) {return(0);}
230    for (i = 1; i <= n; i++)
231    {Vt = V, i; w = 0;
232      for (j = 1; j<= size(P); j++)
233      {if (P[j] <= size(Vt))
234        {Vt2 = Vt[(size(Vt)-P[j]+1)..size(Vt)];
235          if (isInMat(Vt2,L[j]) > 0) {w = 1; break;}
236        }
237      }
238      if (w == 0) {vector Vtt;
239        for (it = 1; it <= size(Vt); it++){Vtt = Vtt + Vt[it]*gen(it);}
240        M = M,Vtt;
241        kill Vtt;
242      }
243    }
244    if (size(M) == 0) {return(0);}
245    else
246    {M = simplify(M,2);
247      for (i = 1; i <= size(M); i++)
248      {kill Vt; intvec Vt;
249        for (j =1; j <= size(M[i]); j++){Vt[j] =  int(leadcoef(M[i][j]));}
250        dimen = dimen + 1 + findDimen(Vt,n,L,P,degbound);
251      }
252      return(dimen);
253    }
254  }
255}
256
257static proc findCycle(intvec V, list L, intvec P, int n, int ld, module M)
258"USAGE:
259RETURN: int, 1 if Ufn-graph contains a cycle, or 0 otherwise
260PURPOSE:Searching the Ufnarovskij graph for cycles
261"
262{int i,j,w,r;intvec Vt,Vt2;
263  int it, it2;
264  if (size(V) < ld)
265  {for (i = 1; i <= n; i++)
266    {Vt = V,i; w = 0;
267      for (j = 1; j <= size(P); j++)
268      {if (P[j] <= size(Vt))
269        {Vt2 = Vt[(size(Vt)-P[j]+1)..size(Vt)];
270          if (isInMat(Vt2,L[j]) > 0)
271          {w = 1; break;}
272        }
273      }
274      if (w == 0) {r = findCycle(Vt,L,P,n,ld,M);}
275      if (r == 1) {break;}
276    }
277    return(r);
278  }
279  else
280  {j = size(M);
281    if (j > 0)
282    {
283      intmat Mt[j][nrows(M)];
284      for (it = 1; it <= j; it++)
285      { for(it2 = 1; it2 <= nrows(M);it2++)
286        {Mt[it,it2] = int(leadcoef(M[it2,it]));}
287      }
288      Vt = V[(size(V)-ld+1)..size(V)];
289      //Mt; type(Mt);Vt;type(Vt);
290      if (isInMat(Vt,Mt) > 0) {return(1);}
291      else
292      {vector Vtt;
293        for (it =1; it <= size(Vt); it++)
294        {Vtt = Vtt + Vt[it]*gen(it);}
295        M = M,Vtt;
296        kill Vtt;
297        for (i = 1; i <= n; i++)
298        {Vt = V,i; w = 0;
299          for (j = 1; j <= size(P); j++)
300          {if (P[j] <= size(Vt))
301            {Vt2 = Vt[(size(Vt)-P[j]+1)..size(Vt)];
302              //L[j]; type(L[j]);Vt2;type(Vt2);
303              if (isInMat(Vt2,L[j]) > 0)
304              {w = 1; break;}
305            }
306          }
307          if (w == 0) {r = findCycle(Vt,L,P,n,ld,M);}
308          if (r == 1) {break;}
309        }
310        return(r);
311      }
312    }
313    else
314    { Vt = V[(size(V)-ld+1)..size(V)];
315      vector Vtt;
316      for (it = 1; it <= size(Vt); it++)
317      {Vtt = Vtt + Vt[it]*gen(it);}
318      M = Vtt;
319      kill Vtt;
320      for (i = 1; i <= n; i++)
321      {Vt = V,i; w = 0;
322        for (j = 1; j <= size(P); j++)
323        {if (P[j] <= size(Vt))
324          {Vt2 = Vt[(size(Vt)-P[j]+1)..size(Vt)];
325            //L[j]; type(L[j]);Vt2;type(Vt2);
326            if (isInMat(Vt2,L[j]) > 0)
327            {w = 1; break;}
328          }
329        }
330        if (w == 0) {r = findCycle(Vt,L,P,n,ld,M);}
331        if (r == 1) {break;}
332      }
333      return(r);
334    }
335  }
336}
337
338
339static proc findCycleDFS(int i, intmat T, intvec V)
340"
341PURPOSE:
342this is a classical deep-first search for cycles contained in a graph given by an intmat
343"
344{
345  intvec rV;
346  int k,k1,t;
347  int j = V[size(V)];
348  if (T[j,i] > 0) {return(V);}
349  else
350  {
351    for (k = 1; k <= ncols(T); k++)
352    {
353      t = 0;
354      if (T[j,k] > 0)
355      {
356        for (k1 = 1; k1 <= size(V); k1++) {if (V[k1] == k) {t = 1; break;}}
357        if (t == 0)
358        {
359          rV = V;
360          rV[size(rV)+1] = k;
361          rV = findCycleDFS(i,T,rV);
362          if (rV[1] > -1) {return(rV);}
363        }
364      }
365    }
366  }
367  return(intvec(-1));
368}
369
370
371
372static proc findHCoeff(intvec V,int n,list L,intvec P,intvec H,list #)
373"USAGE: findHCoeff(V,n,L,P,H,degbound); L a list of intmats, degbound an integer
374RETURN: intvec
375PURPOSE:Compute the coefficient of the Hilbert series (upto degree degbound)
376NOTE:   Starting with a part of the Hilbert series we change the coefficient
377@*      depending on how many basis elements we found on the actual branch
378"
379{int degbound = 0;
380  if (size(#) > 0){if (#[1] > 0){degbound = #[1];}}
381  int i,w,j,it;
382  int h1 = 0;
383  intvec Vt,Vt2,H1;
384  module M;
385  if (degbound == 0)
386  {for (i = 1; i <= n; i++)
387    {Vt = V, i; w = 0;
388      for (j = 1; j<= size(P); j++)
389      {if (P[j] <= size(Vt))
390        {Vt2 = Vt[(size(Vt)-P[j]+1)..size(Vt)];
391          if (isInMat(Vt2,L[j]) > 0) {w = 1; break;}
392        }
393      }
394      if (w == 0)
395      {vector Vtt;
396        for (it = 1; it <= size(Vt); it++){Vtt = Vtt + Vt[it]*gen(it);}
397        M = M,Vtt;
398        kill Vtt;
399      }
400    }
401    if (size(M) == 0) {return(H);}
402    else
403    {M = simplify(M,2);
404      for (i = 1; i <= size(M); i++)
405      {kill Vt; intvec Vt;
406        for (j =1; j <= size(M[i]); j++) {Vt[j] =  int(leadcoef(M[i][j]));}
407        h1 = h1 + 1; H1 = findHCoeff(Vt,n,L,P,H1);
408      }
409      if (size(H1) < (size(V)+2)) {H1[(size(V)+2)] = h1;}
410      else {H1[(size(V)+2)] = H1[(size(V)+2)] + h1;}
411      H1 = H1 + H;
412      return(H1);
413    }
414  }
415  else
416  {if (size(V) > degbound) {ERROR("monomial exceeds degreebound");}
417    if (size(V) == degbound) {return(H);}
418    for (i = 1; i <= n; i++)
419    {Vt = V, i; w = 0;
420      for (j = 1; j<= size(P); j++)
421      {if (P[j] <= size(Vt))
422        {Vt2 = Vt[(size(Vt)-P[j]+1)..size(Vt)];
423          if (isInMat(Vt2,L[j]) > 0) {w = 1; break;}
424        }
425      }
426      if (w == 0)
427      {vector Vtt;
428        for (it = 1; it <= size(Vt); it++){Vtt = Vtt + Vt[it]*gen(it);}
429        M = M,Vtt;
430        kill Vtt;
431      }
432    }
433    if (size(M) == 0) {return(H);}
434    else
435    {M = simplify(M,2);
436      for (i = 1; i <= size(M); i++)
437      {kill Vt; intvec Vt;
438        for (j =1; j <= size(M[i]); j++)
439        {Vt[j] =  int(leadcoef(M[i][j]));}
440        h1 = h1 + 1; H1 = findHCoeff(Vt,n,L,P,H1,degbound);
441      }
442      if (size(H1) < (size(V)+2)) { H1[(size(V)+2)] = h1;}
443      else {H1[(size(V)+2)] = H1[(size(V)+2)] + h1;}
444      H1 = H1 + H;
445      return(H1);
446    }
447  }
448}
449
450static proc findHCoeffMis(intvec V, int n, list L, intvec P, list R,list #)
451"USAGE: findHCoeffMis(V,n,L,P,R,degbound); degbound an optional integer, L a
452@*      list of Intmats, R
453RETURN: list
454PURPOSE:Compute the coefficients of the Hilbert series and the Mistletoes all
455@*      at once
456"
457{int degbound = 0;
458  if (size(#) > 0) {if (#[1] > 0) {degbound = #[1];}}
459  int i,w,j,h1;
460  intvec Vt,Vt2,H1; int it;
461  module M;
462  if (degbound == 0)
463  {for (i = 1; i <= n; i++)
464    {Vt = V, i; w = 0;
465      for (j = 1; j<= size(P); j++)
466      {if (P[j] <= size(Vt))
467        {Vt2 = Vt[(size(Vt)-P[j]+1)..size(Vt)];
468          if (isInMat(Vt2,L[j]) > 0) {w = 1; break;}
469        }
470      }
471      if (w == 0)
472      {vector Vtt;
473        for (it = 1; it <= size(Vt); it++){Vtt = Vtt + Vt[it]*gen(it);}
474        M = M,Vtt;
475        kill Vtt;
476      }
477    }
478    if (size(M) == 0) {if (size(R) < 2){R[2] = list(V);} else {R[2] = R[2] + list(V);} return(R);}
479    else
480    {M = simplify(M,2);
481      for (i = 1; i <= size(M); i++)
482      {kill Vt; intvec Vt;
483        for (j =1; j <= size(M[i]); j++)
484        {Vt[j] =  int(leadcoef(M[i][j]));}
485        if (size(R[1]) < (size(V)+2)) { R[1][(size(V)+2)] = 1;}
486        else
487        {R[1][(size(V)+2)] = R[1][(size(V)+2)] + 1;}
488        R = findHCoeffMis(Vt,n,L,P,R);
489      }
490      return(R);
491    }
492  }
493  else
494  {if (size(V) > degbound) {ERROR("monomial exceeds degreebound");}
495    if (size(V) == degbound)
496    {if (size(R) < 2){R[2] = list (V);}
497      else{R[2] = R[2] + list (V);}
498      return(R);
499    }
500    for (i = 1; i <= n; i++)
501    {Vt = V, i; w = 0;
502      for (j = 1; j<= size(P); j++)
503      {if (P[j] <= size(Vt))
504        {Vt2 = Vt[(size(Vt)-P[j]+1)..size(Vt)];
505          if (isInMat(Vt2,L[j]) > 0) {w = 1; break;}
506        }
507      }
508      if (w == 0)
509      {vector Vtt;
510        for (it = 1; it <= size(Vt); it++){Vtt = Vtt + Vt[it]*gen(it);}
511        M = M,Vtt;
512        kill Vtt;
513      }
514    }
515    if (size(M) == 0) {if (size(R) < 2){R[2] = list(V);} else {R[2] = R[2] + list(V);} return(R);}
516    else
517    {M = simplify(M,2);
518      for (i = 1; i <= ncols(M); i++)
519      {kill Vt; intvec Vt;
520        for (j =1; j <= size(M[i]); j++)
521        {Vt[j] =  int(leadcoef(M[i][j]));}
522        if (size(R[1]) < (size(V)+2)) { R[1][(size(V)+2)] = 1;}
523        else
524        {R[1][(size(V)+2)] = R[1][(size(V)+2)] + 1;}
525        R = findHCoeffMis(Vt,n,L,P,R,degbound);
526      }
527      return(R);
528    }
529  }
530}
531
532
533static proc findMisDim(intvec V,int n,list L,intvec P,list R,list #)
534"USAGE:
535RETURN: list
536PURPOSE:Compute the K-dimension and the Mistletoes all at once
537"
538{int degbound = 0;
539  if (size(#) > 0) {if (#[1] > 0) {degbound = #[1];}}
540  int dimen,i,j,w;
541  intvec Vt,Vt2; int it;
542  module M;
543  if (degbound == 0)
544  {for (i = 1; i <= n; i++)
545    {Vt = V, i; w = 0;
546      for (j = 1; j<= size(P); j++)
547      {if (P[j] <= size(Vt))
548        {Vt2 = Vt[(size(Vt)-P[j]+1)..size(Vt)];
549          if (isInMat(Vt2,L[j]) > 0) {w = 1; break;}
550        }
551      }
552      if (w == 0)
553      {vector Vtt;
554        for (it = 1; it <= size(Vt); it++){Vtt = Vtt + Vt[it]*gen(it);}
555        M = M,Vtt;
556        kill Vtt;
557      }
558    }
559    if (size(M) == 0)
560    {if (size(R) < 2){R[2] = list (V);}
561      else{R[2] = R[2] + list(V);}
562      return(R);
563    }
564    else
565    {M = simplify(M,2);
566      for (i = 1; i <= size(M); i++)
567      {kill Vt; intvec Vt;
568        for (j =1; j <= size(M[i]); j++){Vt[j] =  int(leadcoef(M[i][j]));}
569        R[1] = R[1] + 1; R = findMisDim(Vt,n,L,P,R);
570      }
571      return(R);
572    }
573  }
574  else
575  {if (size(V) > degbound) {ERROR("monomial exceeds degreebound");}
576    if (size(V) == degbound)
577    {if (size(R) < 2){R[2] = list (V);}
578      else{R[2] = R[2] + list (V);}
579      return(R);
580    }
581    for (i = 1; i <= n; i++)
582    {Vt = V, i; w = 0;
583      for (j = 1; j<= size(P); j++)
584      {if (P[j] <= size(Vt))
585        {Vt2 = Vt[(size(Vt)-P[j]+1)..size(Vt)];
586          if (isInMat(Vt2,L[j]) > 0) {w = 1; break;}
587        }
588      }
589      if (w == 0)
590      {vector Vtt;
591        for (it = 1; it <= size(Vt); it++){Vtt = Vtt + Vt[it]*gen(it);}
592        M = M,Vtt;
593        kill Vtt;
594      }
595    }
596    if (size(M) == 0)
597    {if (size(R) < 2){R[2] = list (V);}
598      else{R[2] = R[2] + list(V);}
599      return(R);
600    }
601    else
602    {M = simplify(M,2);
603      for (i = 1; i <= size(M); i++)
604      {kill Vt; intvec Vt;
605        for (j =1; j <= size(M[i]); j++){Vt[j] =  int(leadcoef(M[i][j]));}
606        R[1] = R[1] + 1; R = findMisDim(Vt,n,L,P,R,degbound);
607      }
608      return(R);
609    }
610  }
611}
612
613
614static proc findmistletoes(intvec V, int n, list L, intvec P, list #)
615"USAGE: findmistletoes(V,n,L,P,degbound); V a normal word, n the number of
616@*      variables, L the GB, P the occuring degrees,
617@*      and degbound the (optional) degreebound
618RETURN:  list
619PURPOSE:Compute mistletoes starting in V
620NOTE:   V has to be normal w.r.t. L, it will not be checked for being so
621"
622{int degbound = 0;
623  if (size(#) > 0) {if (#[1] > 0) {degbound = #[1];}}
624  list R; intvec Vt,Vt2; int it;
625  int i,j;
626  module M;
627  if (degbound == 0)
628  {int w;
629    for (i = 1; i <= n; i++)
630    {Vt = V,i; w = 0;
631      for (j = 1; j <= size(P); j++)
632      {if (P[j] <= size(Vt))
633        {Vt2 = Vt[(size(Vt)-P[j]+1)..size(Vt)];
634          if (isInMat(Vt2,L[j]) > 0)
635          {w = 1; break;}
636        }
637      }
638      if (w == 0)
639      {vector Vtt;
640        for (it = 1; it <= size(Vt); it++){Vtt = Vtt + Vt[it]*gen(it);}
641        M = M,Vtt;
642        kill Vtt;
643      }
644    }
645    if (size(M)==0) {R = V; return(R);}
646    else
647    {M = simplify(M,2);
648      for (i = 1; i <= size(M); i++)
649      {kill Vt; intvec Vt;
650        for (j =1; j <= size(M[i]); j++){Vt[j] =  int(leadcoef(M[i][j]));}
651        R = R + findmistletoes(Vt,n,L,P);
652      }
653      return(R);
654    }
655  }
656  else
657  {if (size(V) > degbound) {ERROR("monomial exceeds degreebound");}
658    if (size(V) == degbound) {R = V; return(R);}
659    int w;
660    for (i = 1; i <= n; i++)
661    {Vt = V,i; w = 0;
662      for (j = 1; j <= size(P); j++)
663      {if (P[j] <= size(Vt))
664        {Vt2 = Vt[(size(Vt)-P[j]+1)..size(Vt)];
665          if (isInMat(Vt2,L[j]) > 0){w = 1; break;}
666        }
667      }
668      if (w == 0)
669      {vector Vtt;
670        for (it = 1; it <= size(Vt); it++){Vtt = Vtt + Vt[it]*gen(it);}
671        M = M,Vtt;
672        kill Vtt;
673      }
674    }
675    if (size(M) == 0) {R = V; return(R);}
676    else
677    {M = simplify(M,2);
678      for (i = 1; i <= ncols(M); i++)
679      {kill Vt; intvec Vt;
680        for (j =1; j <= size(M[i]); j++)
681        {Vt[j] =  int(leadcoef(M[i][j]));}
682        //Vt; typeof(Vt); size(Vt);
683        R = R + findmistletoes(Vt,n,L,P,degbound);
684      }
685      return(R);
686    }
687  }
688}
689
690static proc growthAlg(intmat T, list #)
691"
692real algorithm for checking the growth of an algebra
693"
694{
695  int s = 1;
696  if (size(#) > 0) { s = #[1];}
697  int j;
698  int n = ncols(T);
699  intvec NV,C; NV[n] = 0; int m,i;
700  intmat T2[n][n] = T[1..n,1..n]; intmat N[n][n];
701  if (T2 == N)
702  {
703    for (i = 1; i <= n; i++)
704    {
705      if (m <  T[n+1,i]) { m = T[n+1,i];}
706    }
707    return(m);
708  }
709
710  //first part: the diagonals
711  for (i = s; i <= n; i++)
712  {
713    if (T[i,i] > 0)
714    {
715      if ((T[i,i] >= 1) && (T[n+1,i] > 0)) {return(-1);}
716      if ((T[i,i] == 1) && (T[n+1,i] == 0))
717      {
718        T[i,i] = 0;
719        T[n+1,i] = 1;
720        return(growthAlg(T));
721      }
722    }
723  }
724
725  //second part: searching for the last but one vertices
726  T2 = T2*T2;
727  for (i = s; i <= n; i++)
728  {
729    if ((intvec(T[i,1..n]) <> intvec(0)) && (intvec(T2[i,1..n]) == intvec(0)))
730    {
731      for (j = 1; j <= n; j++)
732      {
733        if ((T[i,j] > 0) && (m < T[n+1,j])) {m = T[n+1,j];}
734      }
735      T[n+1,i] = T[n+1,i] + m;
736      T[i,1..n] = NV;
737      return(growthAlg(T));
738    }
739  }
740  m = 0;
741
742  //third part: searching for circles
743  for (i = s; i <= n; i++)
744  {
745    T2 = T[1..n,1..n];
746    C = findCycleDFS(i,T2, intvec(i));
747    if (C[1] > 0)
748    {
749      for (j = 2; j <= size(C); j++)
750      {
751        T[i,1..n] = T[i,1..n] + T[C[j],1..n];
752        T[C[j],1..n] = NV;
753      }
754      for (j = 2; j <= size(C); j++)
755      {
756        T[1..n,i] = T[1..n,i] + T[1..n,C[j]];
757        T[1..n,C[j]] = NV;
758      }
759      T[i,i] = T[i,i] - size(C) + 1;
760      m = 0;
761      for (j = 1; j <= size(C); j++)
762      {
763        m = m + T[n+1,C[j]];
764      }
765      for (j = 1; j <= size(C); j++)
766      {
767        T[n+1,C[j]] = m;
768      }
769      return(growthAlg(T,i));
770    }
771    else {ERROR("No Cycle found, something seems wrong! Please contact the authors.");}
772  }
773
774  m = 0;
775  for (i = 1; i <= n; i++)
776  {
777    if (m < T[n+1,i])
778    {
779      m = T[n+1,i];
780    }
781  }
782  return(m);
783}
784
785static proc GlDimSuffix(intvec v, intvec g)
786{
787  //Computes the shortest r such that g is a suffix for vr
788  //only valid for lex orderings?
789  intvec r,gt,vt,lt,g2;
790  int lg,lv,l,i,c,f;
791  lg = size(g); lv = size(v);
792  if (lg <= lv)
793  {
794    l = lv-lg;
795  }
796  else
797  {
798    l = 0; g2 = g[(lv+1)..lg];
799    g = g[1..lv]; lg = size(g);
800    c = 1;
801  }
802  while (l < lv)
803  {
804    vt = v[(l+1)..lv];
805    gt = g[1..(lv-l)];
806    lt = size(gt);
807    for (i = 1; i <= lt; i++)
808    {
809      if (vt[i]<>gt[i]) {l++; break;}
810    }
811    if (lt <=i ) { f = 1; break;}
812  }
813  if (f == 0) {return(g);}
814  r = g[(lv-l+1)..lg];
815  if (c == 1) {r = r,g2;}
816  return(r);
817}
818
819static proc isNormal(intvec V, list G)
820{
821  int i,j,k,l;
822  k = 0;
823  for (i = 1; i <= size(G); i++)
824  {
825    if ( size(G[i]) <= size(V) )
826    {
827      while ( size(G[i])+k <= size(V) )
828      {
829        if ( G[i] == V[(1+k)..size(V)] ) {return(1);}
830      }
831    }
832  }
833  return(0);
834}
835
836static proc findDChain(list L)
837{
838  list Li; int i,j;
839  for (i = 1; i <= size(L); i++) {Li[i] = size(L[i]);}
840  Li = sort(Li); Li = Li[1];
841  return(Li[size(Li)]);
842}
843
844static proc isInList(intvec V, list L)
845"USAGE: isInList(V,L); V an intvec, L a list of intvecs
846RETURN: int
847PURPOSE:Finding the position of V in L, returns 0, if V is not in M
848"
849{int i,n;
850  n = 0;
851  for (i = 1; i <= size(L); i++) {if (L[i] == V) {n = i; break;}}
852  return(n);
853}
854
855static proc isInMat(intvec V, intmat M)
856"USAGE: isInMat(V,M);V an intvec, M an intmat
857RETURN: int
858PURPOSE:Finding the position of V in M, returns 0, if V is not in M
859"
860{if (size(V) <> ncols(M)) {return(0);}
861  int i;
862  intvec Vt;
863  for (i = 1; i <= nrows(M); i++)
864  {Vt = M[i,1..ncols(M)];
865    if ((V-Vt) == 0){return(i);}
866  }
867  return(0);
868}
869
870static proc isInVec(int v,intvec V)
871"USAGE: isInVec(v,V); v an integer,V an intvec
872RETURN: int
873PURPOSE:Finding the position of v in V, returns 0, if v is not in V
874"
875{int i,n;
876  n = 0;
877  for (i = 1; i <= size(V); i++) {if (V[i] == v) {n = i; break;}}
878  return(n);
879}
880
881
882static proc isPF(intvec P, intvec I)
883"
884PURPOSE:
885checks, if a word P is a praefix of another word I
886"
887{
888  int n = size(P);
889  if (n <= 0 || P == 0) {return(1);}
890  if (size(I) < n) {return(0);}
891  intvec IP = I[1..n];
892  if (IP == P) {return(1);}
893  else {return(0);}
894}
895
896// -----------------main procedures----------------------
897
898static proc lpGraphOfNormalWords(ideal G)
899"USAGE: lpGraphOfNormalWords(G); G a set of monomials in a letterplace ring
900RETURN: intmat
901PURPOSE: Constructs the graph of normal words induced by G
902@*:      the adjacency matrix of the graph of normal words induced by G
903ASSUME: - basering is a Letterplace ring
904- G are the leading monomials of a Groebner basis
905"
906{
907  // construct the Graph of normal words [Studzinski page 78]
908  // construct set of vertices
909  int v = lpVarBlockSize(basering); int d = lpDegBound(basering);
910  ideal V; poly p,q,w;
911  ideal LG = lead(G);
912  int i,j,k,b; intvec E,Et;
913  for (i = 1; i <= v; i++){V = V, var(i);}
914  for (i = 1; i <= size(LG); i++)
915  {
916    E = leadexp(LG[i]);
917    if (E == intvec(0)) {V = V,monomial(intvec(0));}
918    else
919    {
920      for (j = 1; j < d; j++)
921      {
922        Et = E[(j*v+1)..(d*v)];
923        if (Et == intvec(0)) {break;}
924        else {V = V, monomial(Et);}
925      }
926    }
927  }
928  V = simplify(V,2+4);
929  printf("V = %p", V);
930
931
932  // construct incidence matrix
933
934  list LV = lpId2ivLi(V);
935  intvec Ip,Iw;
936  int n = size(V);
937  intmat T[n+1][n];
938  for (i = 1; i <= n; i++)
939  {
940    // printf("for1 (i=%p, n=%p)", i, n);
941    p = V[i]; Ip = lp2iv(p);
942    for (j = 1; j <= n; j++)
943    {
944      // printf("for2 (j=%p, n=%p)", j, n);
945      k = 1; b = 1;
946      q = V[j];
947      w = lpNF(p*q,LG);
948      if (w <> 0)
949      {
950        Iw = lp2iv(w);
951        while (k <= n)
952        {
953          // printf("while (k=%p, n=%p)", k, n);
954          if (isPF(LV[k],Iw) > 0)
955          {if (isPF(LV[k],Ip) == 0) {b = 0; k = n+1;} else {k++;}
956          }
957          else {k++;}
958        }
959        T[i,j] = b;
960        //  print("Incidence Matrix:");
961        // print(T);
962      }
963    }
964  }
965  return(T);
966}
967
968// This proc is deprecated, see lpGkDim() in fpaprops.lib
969/* proc lpGkDim(ideal G) */
970/* "USAGE: lpGkDim(G); G an ideal in a letterplace ring */
971/* RETURN: int */
972/* PURPOSE: Determines the Gelfand Kirillov dimension of A/<G> */
973/* @*:     -1 means it is infinite */
974/* ASSUME: - basering is a Letterplace ring */
975/* - G is a Groebner basis */
976/* NOTE: see fpaprops.lib for a faster and more up to date version of this method */
977/* " */
978/* { */
979/*   return(growthAlg(lpGraphOfNormalWords(G))); */
980/* } */
981
982static proc ivDHilbert(list L, int n, list #)
983"USAGE: ivDHilbert(L,n[,degbound]); L a list of intmats, n an integer,
984@*      degbound an optional integer
985RETURN: list
986PURPOSE:Compute the K-dimension and the Hilbert series
987ASSUME: - basering is a Letterplace ring
988@*      - all rows of each intmat correspond to a Letterplace monomial
989@*      - if you specify a different degree bound degbound,
990@*        degbound <= attrib(basering,uptodeg) holds
991NOTE: - If L is the list returned, then L[1] is an integer corresponding to the
992@*      dimension, L[2] is an intvec which contains the coefficients of the
993@*      Hilbert series
994@*    - If degbound is set, there will be a degree bound added. By default there
995@*      is no degree bound
996@*    - n is the number of variables
997@*    - If I = L[2] is the intvec returned, then I[k] is the (k-1)-th coefficient of
998@*      the Hilbert series.
999@*    - If the K-dimension is known to be infinite, a degree bound is needed
1000EXAMPLE: example ivDHilbert; shows examples
1001"
1002{int degbound = 0;
1003  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] > 0){degbound = #[1];}}}
1004  checkAssumptions(degbound,L);
1005  intvec H; int i,dimen;
1006  H = ivHilbert(L,n,degbound);
1007  for (i = 1; i <= size(H); i++){dimen = dimen + H[i];}
1008  L = dimen,H;
1009  return(L);
1010}
1011example
1012{
1013  "EXAMPLE:"; echo = 2;
1014  ring r = 0,(x,y),dp;
1015  def R = freeAlgebra(r, 5); // constructs a Letterplace ring
1016  R;
1017  setring R; // sets basering to Letterplace ring
1018  //some intmats, which contain monomials in intvec representation as rows
1019  intmat I1 [2][2] = 1,1,2,2; intmat I2 [1][3]  = 1,2,1;
1020  intmat J1 [1][2] =  1,1; intmat J2 [2][3] = 2,1,2,1,2,1;
1021  print(I1);
1022  print(I2);
1023  print(J1);
1024  print(J2);
1025  list G = I1,I2; // ideal, which is already a Groebner basis
1026  list I = J1,J2; // ideal, which is already a Groebner basis
1027  //the procedure without a degree bound
1028  ivDHilbert(G,2);
1029  // the procedure with degree bound 5
1030  ivDHilbert(I,2,5);
1031}
1032
1033static proc ivDHilbertSickle(list L, int n, list #)
1034"USAGE: ivDHilbertSickle(L,n[,degbound]); L a list of intmats, n an integer,
1035@*      degbound an optional integer
1036RETURN: list
1037PURPOSE:Compute the K-dimension, Hilbert series and mistletoes
1038ASSUME: - basering is a Letterplace ring.
1039@*      - All rows of each intmat correspond to a Letterplace monomial.
1040@*      - If you specify a different degree bound degbound,
1041@*        degbound <= attrib(basering,uptodeg) holds.
1042NOTE: - If L is the list returned, then L[1] is an integer, L[2] is an intvec
1043@*      which contains the coefficients of the Hilbert series and L[3]
1044@*      is a list, containing the mistletoes as intvecs.
1045@*    - If degbound is set, a degree bound will be added. By default there
1046@*      is no degree bound.
1047@*    - n is the number of variables.
1048@*    - If I = L[2] is the intvec returned, then I[k] is the (k-1)-th
1049@*      coefficient of the Hilbert series.
1050@*    - If the K-dimension is known to be infinite, a degree bound is needed
1051EXAMPLE: example ivDHilbertSickle; shows examples
1052"
1053{int degbound = 0;
1054  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] > 0){degbound = #[1];}}}
1055  checkAssumptions(degbound,L);
1056  int i,dimen; list R;
1057  R = ivSickleHil(L,n,degbound);
1058  for (i = 1; i <= size(R[1]); i++){dimen = dimen + R[1][i];}
1059  R[3] = R[2]; R[2] = R[1]; R[1] = dimen;
1060  return(R);
1061}
1062example
1063{
1064  "EXAMPLE:"; echo = 2;
1065  ring r = 0,(x,y),dp;
1066  def R = freeAlgebra(r, 5); // constructs a Letterplace ring
1067  R;
1068  setring R; // sets basering to Letterplace ring
1069  //some intmats, which contain monomials in intvec representation as rows
1070  intmat I1 [2][2] = 1,1,2,2; intmat I2 [1][3]  = 1,2,1;
1071  intmat J1 [1][2] =  1,1; intmat J2 [2][3] = 2,1,2,1,2,1;
1072  print(I1);
1073  print(I2);
1074  print(J1);
1075  print(J2);
1076  list G = I1,I2;// ideal, which is already a Groebner basis
1077  list I = J1,J2; // ideal, which is already a Groebner basis
1078  ivDHilbertSickle(G,2); // invokes the procedure without a degree bound
1079  ivDHilbertSickle(I,2,3); // invokes the procedure with degree bound 3
1080}
1081
1082static proc ivKDimCheck(list L, int n)
1083"USAGE: ivKDimCheck(L,n); L a list of intmats, n an integer
1084RETURN: int, 0 if the dimension is finite, or 1 otherwise
1085PURPOSE:Decides, whether the K-dimension is finite or not
1086ASSUME: - basering is a Letterplace ring.
1087@*      - All rows of each intmat correspond to a Letterplace monomial.
1088NOTE:   - n is the number of variables.
1089EXAMPLE: example ivKDimCheck; shows examples
1090"
1091{checkAssumptions(0,L);
1092  int i,r;
1093  intvec P,H;
1094  for (i = 1; i <= size(L); i++)
1095  {P[i] = ncols(L[i]);
1096    if (P[i] == 1) {if (isInMat(H,L[i]) > 0) {ERROR("Quotient algebra is trivial");}}
1097  }
1098  if (size(L) == 0) {ERROR("GB is empty, quotient algebra corresponds to free algebra");}
1099  kill H;
1100  intmat S; int sd,ld; intvec V;
1101  sd = P[1]; ld = P[1];
1102  for (i = 2; i <= size(P); i++)
1103  {if (P[i] < sd) {sd = P[i];}
1104    if (P[i] > ld) {ld = P[i];}
1105  }
1106  sd = (sd - 1); ld = ld - 1;
1107  if (ld == 0) { return(allVars(L,P,n));}
1108  if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
1109  else {S = createStartMat(sd,n);}
1110  module M;
1111  for (i = 1; i <= nrows(S); i++)
1112  {V = S[i,1..ncols(S)];
1113    if (findCycle(V,L,P,n,ld,M)) {r = 1; break;}
1114  }
1115  return(r);
1116}
1117example
1118{
1119  "EXAMPLE:"; echo = 2;
1120  ring r = 0,(x,y),dp;
1121  def R = freeAlgebra(r, 5); // constructs a Letterplace ring
1122  R;
1123  setring R; // sets basering to Letterplace ring
1124  //some intmats, which contain monomials in intvec representation as rows
1125  intmat I1 [2][2] = 1,1,2,2; intmat I2 [1][3]  = 1,2,1;
1126  intmat J1 [1][2] =  1,1; intmat J2 [2][3] = 2,1,2,1,2,1;
1127  print(I1);
1128  print(I2);
1129  print(J1);
1130  print(J2);
1131  list G = I1,I2;// ideal, which is already a Groebner basis
1132  list I = J1,J2; // ideal, which is already a Groebner basis and which
1133  ivKDimCheck(G,2); // invokes the procedure, factor is of finite K-dimension
1134  ivKDimCheck(I,2); // invokes the procedure, factor is not of finite K-dimension
1135}
1136
1137static proc ivHilbert(list L, int n, list #)
1138"USAGE: ivHilbert(L,n[,degbound]); L a list of intmats, n an integer,
1139@*      degbound an optional integer
1140RETURN: intvec, containing the coefficients of the Hilbert series
1141PURPOSE:Compute the Hilbert series
1142ASSUME: - basering is a Letterplace ring.
1143@*      - all rows of each intmat correspond to a Letterplace monomial
1144@*      - if you specify a different degree bound degbound,
1145@*       degbound <= attrib(basering,uptodeg) holds.
1146NOTE: - If degbound is set, a degree bound  will be added. By default there
1147@*      is no degree bound.
1148@*    - n is the number of variables.
1149@*    - If I is returned, then I[k] is the (k-1)-th coefficient of the Hilbert
1150@*      series.
1151@*    - If the K-dimension is known to be infinite, a degree bound is needed
1152EXAMPLE: example ivHilbert; shows examples
1153"
1154{int degbound = 0;
1155  if (size(#) > 0) {if (typeof(#[1])=="int"){if (#[1] > 0) {degbound = #[1];}}}
1156  intvec P,H; int i;
1157  for (i = 1; i <= size(L); i++)
1158  {P[i] = ncols(L[i]);
1159    if (P[i] == 1) {if ( isInMat(H,L[i]) > 0) {ERROR("Quotient algebra is trivial");}}
1160  }
1161  if (size(L) == 0) {ERROR("GB is empty, quotient algebra corresponds to free algebra");}
1162  H[1] = 1;
1163  checkAssumptions(degbound,L);
1164  if (degbound == 0)
1165  {int sd;
1166    intmat S;
1167    sd = P[1];
1168    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
1169    sd = (sd - 1);
1170    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
1171    else {S = createStartMat(sd,n);}
1172    if (intvec(S) == 0) {return(H);}
1173    for (i = 1; i <= sd; i++) {H = H,(n^i);}
1174    for (i = 1; i <= nrows(S); i++)
1175    {intvec St = S[i,1..ncols(S)];
1176      H = findHCoeff(St,n,L,P,H);
1177      kill St;
1178    }
1179    return(H);
1180  }
1181  else
1182  {for (i = 1; i <= size(P); i++)
1183    {if (P[i] > degbound) {ERROR("degreebound is too small, GB contains elements of higher degree");}}
1184    int sd;
1185    intmat S;
1186    sd = P[1];
1187    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
1188    sd = (sd - 1);
1189    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
1190    else {S = createStartMat(sd,n);}
1191    if (intvec(S) == 0) {return(H);}
1192    for (i = 1; i <= sd; i++) {H = H,(n^i);}
1193    for (i = 1; i <= nrows(S); i++)
1194    {intvec St = S[i,1..ncols(S)];
1195      H = findHCoeff(St,n,L,P,H,degbound);
1196      kill St;
1197    }
1198    return(H);
1199  }
1200}
1201example
1202{
1203  "EXAMPLE:"; echo = 2;
1204  ring r = 0,(x,y),dp;
1205  def R = freeAlgebra(r, 5); // constructs a Letterplace ring
1206  R;
1207  setring R; // sets basering to Letterplace ring
1208  //some intmats, which contain monomials in intvec representation as rows
1209  intmat I1 [2][2] = 1,1,2,2; intmat I2 [1][3]  = 1,2,1;
1210  intmat J1 [1][2] =  1,1; intmat J2 [2][3] = 2,1,2,1,2,1;
1211  print(I1);
1212  print(I2);
1213  print(J1);
1214  print(J2);
1215  list G = I1,I2; // ideal, which is already a Groebner basis
1216  list I = J1,J2; // ideal, which is already a Groebner basis
1217  ivHilbert(G,2); // invokes the procedure without any degree bound
1218  ivHilbert(I,2,5); // invokes the procedure with degree bound 5
1219}
1220
1221
1222static proc ivKDim(list L, int n, list #)
1223"USAGE: ivKDim(L,n[,degbound]); L a list of intmats,
1224@*      n an integer, degbound an optional integer
1225RETURN: int, the K-dimension of A/<L>
1226PURPOSE:Compute the K-dimension of A/<L>
1227ASSUME: - basering is a Letterplace ring.
1228@*      - all rows of each intmat correspond to a Letterplace monomial
1229@*      - if you specify a different degree bound degbound,
1230@*        degbound <= attrib(basering,uptodeg) holds.
1231NOTE: - If degbound is set, a degree bound will be added. By default there
1232@*      is no degree bound.
1233@*    - n is the number of variables.
1234@*    - If the K-dimension is known to be infinite, a degree bound is needed
1235EXAMPLE: example ivKDim; shows examples
1236"
1237{int degbound = 0;
1238  if (size(#) > 0) {if (typeof(#[1])=="int"){if (#[1] > 0) {degbound = #[1];}}}
1239  intvec P,H; int i;
1240  for (i = 1; i <= size(L); i++)
1241  {P[i] = ncols(L[i]);
1242    if (P[i] == 1) {if ( isInMat(H,L[i]) > 0) {ERROR("Quotient algebra is trivial");}}
1243  }
1244  if (size(L) == 0) {ERROR("GB is empty, quotient algebra corresponds to free algebra");}
1245  kill H;
1246  checkAssumptions(degbound,L);
1247  if (degbound == 0)
1248  {int sd; int dimen = 1;
1249    intmat S;
1250    sd = P[1];
1251    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
1252    sd = (sd - 1);
1253    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
1254    else {S = createStartMat(sd,n);}
1255    if (intvec(S) == 0) {return(dimen);}
1256    for (i = 1; i <= sd; i++) {dimen = dimen +(n^i);}
1257    for (i = 1; i <= nrows(S); i++)
1258    {intvec St = S[i,1..ncols(S)];
1259      dimen = dimen + findDimen(St,n,L,P);
1260      kill St;
1261    }
1262    return(dimen);
1263  }
1264  else
1265  {for (i = 1; i <= size(P); i++)
1266    {if (P[i] > degbound) {ERROR("degreebound is too small, GB contains elements of higher degree");}}
1267    int sd; int dimen = 1;
1268    intmat S;
1269    sd = P[1];
1270    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
1271    sd = (sd - 1);
1272    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
1273    else {S = createStartMat(sd,n);}
1274    if (intvec(S) == 0) {return(dimen);}
1275    for (i = 1; i <= sd; i++) {dimen = dimen +(n^i);}
1276    for (i = 1; i <= nrows(S); i++)
1277    {intvec St = S[i,1..ncols(S)];
1278      dimen = dimen + findDimen(St,n,L,P, degbound);
1279      kill St;
1280    }
1281    return(dimen);
1282  }
1283}
1284example
1285{
1286  "EXAMPLE:"; echo = 2;
1287  ring r = 0,(x,y),dp;
1288  def R = freeAlgebra(r, 5); // constructs a Letterplace ring
1289  R;
1290  setring R; // sets basering to Letterplace ring
1291  //some intmats, which contain monomials in intvec representation as rows
1292  intmat I1 [2][2] = 1,1,2,2; intmat I2 [1][3]  = 1,2,1;
1293  intmat J1 [1][2] =  1,1; intmat J2 [2][3] = 2,1,2,1,2,1;
1294  print(I1);
1295  print(I2);
1296  print(J1);
1297  print(J2);
1298  list G = I1,I2; // ideal, which is already a Groebner basis
1299  list I = J1,J2; // ideal, which is already a Groebner basis
1300  ivKDim(G,2); // invokes the procedure without any degree bound
1301  ivKDim(I,2,5); // invokes the procedure with degree bound 5
1302}
1303
1304static proc ivMis2Base(list M)
1305"USAGE: ivMis2Base(M); M a list of intvecs
1306RETURN: ideal, a K-base of the given algebra
1307PURPOSE:Compute the K-base out of given mistletoes
1308ASSUME: - The mistletoes have to be ordered lexicographically -> OrdMisLex.
1309@*        Otherwise there might some elements missing.
1310@*      - basering is a Letterplace ring.
1311@*      - mistletoes are stored as intvecs, as described in the overview
1312EXAMPLE: example ivMis2Base; shows examples
1313"
1314{
1315  //checkAssumptions(0,M);
1316  intvec L,A;
1317  if (size(M) == 0){ERROR("There are no mistletoes, so it appears your dimension is infinite!");}
1318  if (isInList(L,M) > 0) {print("1 is a mistletoe, therefore 1 is the only basis element"); return(list(intvec(0)));}
1319  int i,j,d,s;
1320  list Rt;
1321  Rt[1] = intvec(0);
1322  L = M[1];
1323  for (i = size(L); 1 <= i; i--) {Rt = insert(Rt,intvec(L[1..i]));}
1324  for (i = 2; i <= size(M); i++)
1325  {A = M[i]; L = M[i-1];
1326    s = size(A);
1327    if (s > size(L))
1328    {d = size(L);
1329      for (j = s; j > d; j--) {Rt = insert(Rt,intvec(A[1..j]));}
1330      A = A[1..d];
1331    }
1332    if (size(L) > s){L = L[1..s];}
1333    while (A <> L)
1334    {Rt = insert(Rt, intvec(A));
1335      if (size(A) > 1)
1336      {A = A[1..(size(A)-1)];
1337        L = L[1..(size(L)-1)];
1338      }
1339      else {break;}
1340    }
1341  }
1342  return(Rt);
1343}
1344example
1345{
1346  "EXAMPLE:"; echo = 2;
1347  ring r = 0,(x,y),dp;
1348  def R = freeAlgebra(r, 5); // constructs a Letterplace ring
1349  R;
1350  setring R; // sets basering to Letterplace ring
1351  intvec i1 = 1,2; intvec i2 = 2,1,2;
1352  // the mistletoes are xy and yxy, which are already ordered lexicographically
1353  list L = i1,i2;
1354  ivMis2Base(L); // returns the basis of the factor algebra
1355}
1356
1357
1358static proc ivMis2Dim(list M)
1359"USAGE: ivMis2Dim(M); M a list of intvecs
1360RETURN: int, the K-dimension of the given algebra
1361PURPOSE:Compute the K-dimension out of given mistletoes
1362ASSUME: - The mistletoes have to be ordered lexicographically -> OrdMisLex.
1363@*        Otherwise the returned value may differ from the K-dimension.
1364@*      - basering is a Letterplace ring.
1365EXAMPLE: example ivMis2Dim; shows examples
1366"
1367{checkAssumptions(0,M);
1368  intvec L;
1369  if (size(M) == 0){ERROR("There are no mistletoes, so it appears your dimension is infinite!");}
1370  if (isInList(L,M) > 0) {print("1 is a mistletoe, therefore dim = 1"); return(1);}
1371  int i,j,d,s;
1372  j = 1;
1373  d = 1 + size(M[1]);
1374  for (i = 1; i < size(M); i++)
1375  {s = size(M[i]); if (s > size(M[i+1])){s = size(M[i+1]);}
1376    while ((M[i][j] == M[i+1][j]) && (j <= s)){j = j + 1;}
1377    d = d + size(M[i+1])- j + 1;
1378  }
1379  return(d);
1380}
1381example
1382{
1383  "EXAMPLE:"; echo = 2;
1384  ring r = 0,(x,y),dp;
1385  def R = freeAlgebra(r, 5); // constructs a Letterplace ring
1386  R;
1387  setring R; // sets basering to Letterplace ring
1388  intvec i1 = 1,2; intvec i2 = 2,1,2;
1389  // the mistletoes are xy and yxy, which are already ordered lexicographically
1390  list L = i1,i2;
1391  ivMis2Dim(L); // returns the dimension of the factor algebra
1392}
1393
1394static proc ivOrdMisLex(list M)
1395"USAGE: ivOrdMisLex(M); M a list of intvecs
1396RETURN: list, containing the ordered intvecs of M
1397PURPOSE:Orders a given set of mistletoes lexicographically
1398ASSUME: - basering is a Letterplace ring.
1399- intvecs correspond to monomials
1400NOTE:   - This is preprocessing, it's not needed if the mistletoes are returned
1401@*        from the sickle algorithm.
1402@*      - Each entry of the list returned is an intvec.
1403EXAMPLE: example ivOrdMisLex; shows examples
1404"
1405{checkAssumptions(0,M);
1406  return(sort(M)[1]);
1407}
1408example
1409{
1410  "EXAMPLE:"; echo = 2;
1411  ring r = 0,(x,y),dp;
1412  def R = freeAlgebra(r, 5); // constructs a Letterplace ring
1413  setring R; // sets basering to Letterplace ring
1414  intvec i1 = 1,2,1; intvec i2 = 2,2,1; intvec i3 = 1,1; intvec i4 = 2,1,1,1;
1415  // the corresponding monomials are xyx,y^2x,x^2,yx^3
1416  list M = i1,i2,i3,i4;
1417  M;
1418  ivOrdMisLex(M);// orders the list of monomials
1419}
1420
1421static proc ivSickle(list L, int n, list #)
1422"USAGE: ivSickle(L,n,[degbound]); L a list of intmats, n an int, degbound an
1423@*      optional integer
1424RETURN: list, containing intvecs, the mistletoes of A/<L>
1425PURPOSE:Compute the mistletoes for a given Groebner basis L
1426ASSUME: - basering is a Letterplace ring.
1427@*      - all rows of each intmat correspond to a Letterplace monomial
1428@*      - if you specify a different degree bound degbound,
1429@*        degbound <= attrib(basering,uptodeg) holds.
1430NOTE: - If degbound is set, a degree bound will be added. By default there
1431@*      is no degree bound.
1432@*    - n is the number of variables.
1433@*    - If the K-dimension is known to be infinite, a degree bound is needed
1434EXAMPLE: example ivSickle; shows examples
1435"
1436{list M;
1437  int degbound = 0;
1438  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] > 0){degbound = #[1];}}}
1439  int i;
1440  intvec P,H;
1441  for (i = 1; i <= size(L); i++)
1442  {P[i] = ncols(L[i]);
1443    if (P[i] == 1) {if (isInMat(H,L[i]) > 0) {ERROR("Quotient algebra is trivial");}}
1444  }
1445  if (size(L) == 0) {ERROR("GB is empty, quotient algebra corresponds to free algebra");}
1446  kill H;
1447  checkAssumptions(degbound,L);
1448  if (degbound == 0)
1449  {intmat S; int sd;
1450    sd = P[1];
1451    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
1452    sd = (sd - 1);
1453    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
1454    else {S = createStartMat(sd,n);}
1455    if (intvec(S) == 0) {return(list (intvec(0)));}
1456    for (i = 1; i <= nrows(S); i++)
1457    {intvec St = S[i,1..ncols(S)];
1458      M = M + findmistletoes(St,n,L,P);
1459      kill St;
1460    }
1461    return(M);
1462  }
1463  else
1464  {for (i = 1; i <= size(P); i++)
1465    {if (P[i] > degbound) {ERROR("degreebound is too small, GB contains elements of higher degree");}}
1466    intmat S; int sd;
1467    sd = P[1];
1468    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
1469    sd = (sd - 1);
1470    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
1471    else {S = createStartMat(sd,n);}
1472    if (intvec(S) == 0) {return(list (intvec(0)));}
1473    for (i = 1; i <= nrows(S); i++)
1474    {intvec St = S[i,1..ncols(S)];
1475      M = M + findmistletoes(St,n,L,P,degbound);
1476      kill St;
1477    }
1478    return(M);
1479  }
1480}
1481example
1482{
1483  "EXAMPLE:"; echo = 2;
1484  ring r = 0,(x,y),dp;
1485  def R = freeAlgebra(r, 5); // constructs a Letterplace ring
1486  setring R; // sets basering to Letterplace ring
1487  //some intmats, which contain monomials in intvec representation as rows
1488  intmat I1 [2][2] = 1,1,2,2; intmat I2 [1][3]  = 1,2,1;
1489  intmat J1 [1][2] =  1,1; intmat J2 [2][3] = 2,1,2,1,2,1;
1490  print(I1);
1491  print(I2);
1492  print(J1);
1493  print(J2);
1494  list G = I1,I2; // ideal, which is already a Groebner basis
1495  list I =  J1,J2; // ideal, which is already a Groebner basis
1496  ivSickle(G,2); // invokes the procedure without any degree bound
1497  ivSickle(I,2,5); // invokes the procedure with degree bound 5
1498}
1499
1500static proc ivSickleDim(list L, int n, list #)
1501"USAGE: ivSickleDim(L,n[,degbound]); L a list of intmats, n an integer, degbound
1502@*      an optional integer
1503RETURN: list
1504PURPOSE:Compute mistletoes and the K-dimension
1505ASSUME: - basering is a Letterplace ring.
1506@*      - all rows of each intmat correspond to a Letterplace monomial
1507@*      - if you specify a different degree bound degbound,
1508@*        degbound <= attrib(basering,uptodeg) holds.
1509NOTE: - If L is the list returned, then L[1] is an integer, L[2] is a list,
1510@*      containing the mistletoes as intvecs.
1511@*    - If degbound is set, a degree bound will be added. By default there
1512@*      is no degree bound.
1513@*    - n is the number of variables.
1514@*    - If the K-dimension is known to be infinite, a degree bound is needed
1515EXAMPLE: example ivSickleDim; shows examples
1516"
1517{list M;
1518  int degbound = 0;
1519  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] > 0){degbound = #[1];}}}
1520  int i,dimen; list R;
1521  intvec P,H;
1522  for (i = 1; i <= size(L); i++)
1523  {P[i] = ncols(L[i]);
1524    if (P[i] == 1) {if (isInMat(H,L[i]) > 0) {ERROR("Quotient algebra is trivial, dimension equals zero");}}
1525  }
1526  if (size(L) == 0) {ERROR("GB is empty, quotient algebra corresponds to free algebra");}
1527  kill H;
1528  checkAssumptions(degbound,L);
1529  if (degbound == 0)
1530  {int sd; dimen = 1;
1531    intmat S;
1532    sd = P[1];
1533    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
1534    sd = (sd - 1);
1535    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
1536    else {S = createStartMat(sd,n);}
1537    if (intvec(S) == 0) {return(list(dimen,list(intvec(0))));}
1538    for (i = 1; i <= sd; i++) {dimen = dimen +(n^i);}
1539    R[1] = dimen;
1540    for (i = 1; i <= nrows(S); i++)
1541    {intvec St = S[i,1..ncols(S)];
1542      R = findMisDim(St,n,L,P,R);
1543      kill St;
1544    }
1545    return(R);
1546  }
1547  else
1548  {for (i = 1; i <= size(P); i++)
1549    {if (P[i] > degbound) {ERROR("degreebound is too small, GB contains elements of higher degree");}}
1550    int sd; dimen = 1;
1551    intmat S;
1552    sd = P[1];
1553    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
1554    sd = (sd - 1);
1555    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
1556    else {S = createStartMat(sd,n);}
1557    if (intvec(S) == 0) {return(list(dimen,list(intvec(0))));}
1558    for (i = 1; i <= sd; i++) {dimen = dimen +(n^i);}
1559    R[1] = dimen;
1560    for (i = 1; i <= nrows(S); i++)
1561    {intvec St = S[i,1..ncols(S)];
1562      R = findMisDim(St,n,L,P,R,degbound);
1563      kill St;
1564    }
1565    return(R);
1566  }
1567}
1568example
1569{
1570  "EXAMPLE:"; echo = 2;
1571  ring r = 0,(x,y),dp;
1572  def R = freeAlgebra(r, 5); // constructs a Letterplace ring
1573  setring R; // sets basering to Letterplace ring
1574  //some intmats, which contain monomials in intvec representation as rows
1575  intmat I1 [2][2] = 1,1,2,2; intmat I2 [1][3]  = 1,2,1;
1576  intmat J1 [1][2] =  1,1; intmat J2 [2][3] = 2,1,2,1,2,1;
1577  print(I1);
1578  print(I2);
1579  print(J1);
1580  print(J2);
1581  list G = I1,I2;// ideal, which is already a Groebner basis
1582  list I =  J1,J2; // ideal, which is already a Groebner basis
1583  ivSickleDim(G,2); // invokes the procedure without any degree bound
1584  ivSickleDim(I,2,5); // invokes the procedure with degree bound 5
1585}
1586
1587static proc ivSickleHil(list L, int n, list #)
1588"USAGE:ivSickleHil(L,n[,degbound]); L a list of intmats, n an integer,
1589@*     degbound an optional integer
1590RETURN: list
1591PURPOSE:Compute the mistletoes and the Hilbert series
1592ASSUME: - basering is a Letterplace ring.
1593@*      - all rows of each intmat correspond to a Letterplace monomial
1594@*      - if you specify a different degree bound degbound,
1595@*        degbound <= attrib(basering,uptodeg) holds.
1596NOTE: - If L is the list returned, then L[1] is an intvec, L[2] is a list,
1597@*      containing the mistletoes as intvecs.
1598@*    - If degbound is set, a degree bound will be added. By default there
1599@*      is no degree bound.
1600@*    - n is the number of variables.
1601@*    - If I = L[1] is the intvec returned, then I[k] is the (k-1)-th
1602@*      coefficient of the Hilbert series.
1603@*    - If the K-dimension is known to be infinite, a degree bound is needed
1604EXAMPLE: example ivSickleHil; shows examples
1605"
1606{int degbound = 0;
1607  if (size(#) > 0) {if (typeof(#[1])=="int"){if (#[1] > 0) {degbound = #[1];}}}
1608  intvec P,H; int i; list R;
1609  for (i = 1; i <= size(L); i++)
1610  {P[i] = ncols(L[i]);
1611    if (P[i] == 1) {if ( isInMat(H,L[i]) > 0) {ERROR("Quotient algebra is trivial");}}
1612  }
1613  if (size(L) == 0) {ERROR("GB is empty, quotient algebra corresponds to free algebra");}
1614  H[1] = 1;
1615  checkAssumptions(degbound,L);
1616  if (degbound == 0)
1617  {int sd;
1618    intmat S;
1619    sd = P[1];
1620    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
1621    sd = (sd - 1);
1622    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
1623    else {S = createStartMat(sd,n);}
1624    if (intvec(S) == 0) {return(list(H,list(intvec (0))));}
1625    for (i = 1; i <= sd; i++) {H = H,(n^i);}
1626    R[1] = H; kill H;
1627    for (i = 1; i <= nrows(S); i++)
1628    {intvec St = S[i,1..ncols(S)];
1629      R = findHCoeffMis(St,n,L,P,R);
1630      kill St;
1631    }
1632    return(R);
1633  }
1634  else
1635  {for (i = 1; i <= size(P); i++)
1636    {if (P[i] > degbound) {ERROR("degreebound is too small, GB contains elements of higher degree");}}
1637    int sd;
1638    intmat S;
1639    sd = P[1];
1640    for (i = 2; i <= size(P); i++) {if (P[i] < sd) {sd = P[i];}}
1641    sd = (sd - 1);
1642    if (sd == 0) { for (i = 1; i <= size(L); i++){if (ncols(L[i]) == 1){S = createStartMat1(n,L[i]); break;}}}
1643    else {S = createStartMat(sd,n);}
1644    if (intvec(S) == 0) {return(list(H,list(intvec(0))));}
1645    for (i = 1; i <= sd; i++) {H = H,(n^i);}
1646    R[1] = H; kill H;
1647    for (i = 1; i <= nrows(S); i++)
1648    {intvec St = S[i,1..ncols(S)];
1649      R = findHCoeffMis(St,n,L,P,R,degbound);
1650      kill St;
1651    }
1652    return(R);
1653  }
1654}
1655example
1656{
1657  "EXAMPLE:"; echo = 2;
1658  ring r = 0,(x,y),dp;
1659  def R = freeAlgebra(r, 5); // constructs a Letterplace ring
1660  setring R; // sets basering to Letterplace ring
1661  //some intmats, which contain monomials in intvec representation as rows
1662  intmat I1[2][2] = 1,1,2,2; intmat I2[1][3]  = 1,2,1;
1663  intmat J1[1][2] =  1,1; intmat J2[2][3] = 2,1,2,1,2,1;
1664  print(I1);
1665  print(I2);
1666  print(J1);
1667  print(J2);
1668  list G = I1,I2;// ideal, which is already a Groebner basis
1669  list I =  J1,J2; // ideal, which is already a Groebner basis
1670  ivSickleHil(G,2); // invokes the procedure without any degree bound
1671  ivSickleHil(I,2,5); // invokes the procedure with degree bound 5
1672}
1673
1674static proc lpDHilbert(ideal G, list #)
1675"USAGE: lpDHilbert(G[,degbound,n]); G an ideal, degbound, n optional integers
1676RETURN: list
1677PURPOSE:Compute K-dimension and Hilbert series, starting with a lp-ideal
1678ASSUME: - basering is a Letterplace ring.
1679@*      - if you specify a different degree bound degbound,
1680@*        degbound <= attrib(basering,uptodeg) holds.
1681NOTE: - If L is the list returned, then L[1] is an integer corresponding to the
1682@*      dimension, L[2] is an intvec which contains the coefficients of the
1683@*      Hilbert series
1684@*    - If degbound is set, there will be a degree bound added. 0 means no
1685@*      degree bound. Default: attrib(basering,uptodeg).
1686@*    - n can be set to a different number of variables.
1687@*      Default: n = attrib(basering, lV).
1688@*    - If I = L[2] is the intvec returned, then I[k] is the (k-1)-th
1689@*      coefficient of the Hilbert series.
1690@*    - If the K-dimension is known to be infinite, a degree bound is needed
1691EXAMPLE: example lpDHilbert; shows examples
1692"
1693{int degbound = lpDegBound(basering);int n = lpVarBlockSize(basering);
1694  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] >= 0){degbound = #[1];}}}
1695  if (size(#) > 1){if (typeof(#[1])=="int"){if (#[2] > 0){n = #[2];}}}
1696  list L;
1697  L = lp2ivId(normalize(lead(G)));
1698  return(ivDHilbert(L,n,degbound));
1699}
1700example
1701{
1702  "EXAMPLE:"; echo = 2;
1703  ring r = 0,(x,y),dp;
1704  def R = freeAlgebra(r, 5); // constructs a Letterplace ring
1705  setring R; // sets basering to Letterplace ring
1706  ideal G = x*x, y*y,x*y*x; // ideal G contains a
1707  //Groebner basis
1708  lpDHilbert(G,5,2); // invokes procedure with degree bound 5 and 2 variables
1709  // note that the optional parameters are not necessary, due to the finiteness
1710  // of the K-dimension of the factor algebra
1711  lpDHilbert(G); // procedure with ring parameters
1712  lpDHilbert(G,0); // procedure without degreebound
1713}
1714
1715static proc lpDHilbertSickle(ideal G, list #)
1716"USAGE: lpDHilbertSickle(G[,degbound,n]); G an ideal, degbound, n optional
1717@*      integers
1718RETURN: list
1719PURPOSE:Compute K-dimension, Hilbert series and mistletoes at once
1720ASSUME: - basering is a Letterplace ring.
1721@*      - if you specify a different degree bound degbound,
1722@*        degbound <= attrib(basering,uptodeg) holds.
1723NOTE: - If L is the list returned, then L[1] is an integer, the K-dimension,
1724@*      L[2] is an intvec, the Hilbert series and L[3] is an ideal,
1725@*      the mistletoes
1726@*    - If degbound is set, there will be a degree bound added. 0 means no
1727@*      degree bound. Default: attrib(basering,uptodeg).
1728@*    - n can be set to a different number of variables.
1729@*      Default: n = attrib(basering, lV).
1730@*    - If I = L[1] is the intvec returned, then I[k] is the (k-1)-th
1731@*      coefficient of the Hilbert series.
1732@*    - If the K-dimension is known to be infinite, a degree bound is needed
1733EXAMPLE: example lpDHilbertSickle; shows examples
1734"
1735{int degbound = lpDegBound(basering);int n = lpVarBlockSize(basering);
1736  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] >= 0){degbound = #[1];}}}
1737  if (size(#) > 1){if (typeof(#[1])=="int"){if (#[2] > 0){n = #[2];}}}
1738  list L;
1739  L = lp2ivId(normalize(lead(G)));
1740  L = ivDHilbertSickle(L,n,degbound);
1741  L[3] =  ivL2lpI(L[3]);
1742  return(L);
1743}
1744example
1745{
1746  "EXAMPLE:"; echo = 2;
1747  ring r = 0,(x,y),dp;
1748  def R = freeAlgebra(r, 5); // constructs a Letterplace ring
1749  setring R; // sets basering to Letterplace ring
1750  ideal G = x*x, y*y,x*y*x; // ideal G contains a
1751  //Groebner basis
1752  lpDHilbertSickle(G,5,2); //invokes procedure with degree bound 5 and 2 variables
1753  // note that the optional parameters are not necessary, due to the finiteness
1754  // of the K-dimension of the factor algebra
1755  lpDHilbertSickle(G); // procedure with ring parameters
1756  lpDHilbertSickle(G,0); // procedure without degreebound
1757}
1758
1759proc lpHilbert(ideal G, list #)
1760"USAGE: lpHilbert(G[,degbound,n]); G an ideal, degbound, n optional integers
1761RETURN: intvec, containing the coefficients of the Hilbert series
1762PURPOSE: Compute the truncated Hilbert series of K<X>/<G> up to a degree bound
1763ASSUME: - basering is a Letterplace ring.
1764@*      - if you specify a different degree bound degbound,
1765@*        degbound <= attrib(basering,uptodeg) holds.
1766THEORY: Hilbert series of an algebra K<X>/<G> is sum_(i>=0) h_i t^i,
1767where h_i is the K-dimension of the space of monomials of degree i,
1768not contained in <G>. For finitely presented algebras Hilbert series NEED
1769NOT be a rational function, though it happens often. Therefore in general
1770there is no notion of a Hilbert polynomial.
1771NOTE: - If degbound is set, there will be a degree bound added. 0 means no
1772@*      degree bound. Default: attrib(basering,uptodeg).
1773@*    - n is the number of variables, which can be set to a different number.
1774@*      Default: attrib(basering, lV).
1775@*    - In the output intvec I, I[k] is the (k-1)-th coefficient of the Hilbert
1776@*      series, i.e. h_(k-1) as above.
1777EXAMPLE: example lpHilbert; shows examples
1778SEE ALSO: ncHilb_lib
1779"
1780{int degbound = lpDegBound(basering);int n = lpVarBlockSize(basering);
1781  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] >= 0){degbound = #[1];}}}
1782  if (size(#) > 1){if (typeof(#[1])=="int"){if (#[2] > 0){n = #[2];}}}
1783  list L;
1784  L = lp2ivId(normalize(lead(G)));
1785  return(ivHilbert(L,n,degbound));
1786}
1787example
1788{
1789  "EXAMPLE:"; echo = 2;
1790  ring r = 0,(x,y),dp;
1791  def R = freeAlgebra(r, 5); // constructs a Letterplace ring
1792  setring R; // sets basering to Letterplace ring
1793  ideal G = y*y,x*y*x; // G is a Groebner basis
1794  lpHilbert(G); // procedure with default parameters
1795  lpHilbert(G,3,2); // invokes procedure with degree bound 3 and (same) 2 variables
1796}
1797
1798// compatibiltiy, do not put in header
1799proc lpDimCheck(ideal G)
1800{
1801  return(lpKDimCheck(G));
1802}
1803
1804proc lpKDimCheck(ideal G)
1805"USAGE: lpKDimCheck(G);
1806RETURN: int, 1 if K-dimension of the factor algebra is infinite, 0 otherwise
1807PURPOSE:Checking a factor algebra for finiteness of the K-dimension
1808ASSUME: - basering is a Letterplace ring.
1809EXAMPLE: example lpKDimCheck; shows examples
1810"
1811{int n = lpVarBlockSize(basering);
1812  list L;
1813  ideal R;
1814  R = normalize(lead(G));
1815  L = lp2ivId(R);
1816  return(ivKDimCheck(L,n));
1817}
1818example
1819{
1820  "EXAMPLE:"; echo = 2;
1821  ring r = 0,(x,y),dp;
1822  def R = freeAlgebra(r, 5); // constructs a Letterplace ring
1823  setring R; // sets basering to Letterplace ring
1824  ideal G = x*x, y*y,x*y*x;
1825  // Groebner basis
1826  ideal I = x*x, y*x*y, x*y*x;
1827  // Groebner basis
1828  lpKDimCheck(G); // invokes procedure, factor algebra is of finite K-dimension
1829  lpKDimCheck(I); // invokes procedure, factor algebra is of infinite Kdimension
1830}
1831
1832proc lpKDim(ideal G, list #)
1833"USAGE: lpKDim(G[,degbound, n]); G an ideal, degbound, n optional integers
1834RETURN: int, the K-dimension of the factor algebra
1835PURPOSE:Compute the K-dimension of a factor algebra, given via an ideal
1836ASSUME: - basering is a Letterplace ring
1837@*      - if you specify a different degree bound degbound,
1838@*        degbound <= attrib(basering,uptodeg) holds.
1839NOTE: - If degbound is set, there will be a degree bound added. 0 means no
1840@*      degree bound. Default: attrib(basering, uptodeg).
1841@*    - n is the number of variables, which can be set to a different number.
1842@*      Default: attrib(basering, lV).
1843@*    - If the K-dimension is known to be infinite, a degree bound is needed
1844EXAMPLE: example lpKDim; shows examples
1845"
1846{int degbound = lpDegBound(basering);int n = lpVarBlockSize(basering);
1847  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] >= 0){degbound = #[1];}}}
1848  if (size(#) > 1){if (typeof(#[1])=="int"){if (#[2] > 0){n = #[2];}}}
1849  list L;
1850  L = lp2ivId(normalize(lead(G)));
1851  return(ivKDim(L,n,degbound));
1852}
1853example
1854{
1855  "EXAMPLE:"; echo = 2;
1856  ring r = 0,(x,y),dp;
1857  def R = freeAlgebra(r, 5); // constructs a Letterplace ring
1858  setring R; // sets basering to Letterplace ring
1859  ideal G = x*x, y*y,x*y*x;
1860  // ideal G contains a Groebner basis
1861  lpKDim(G); //procedure invoked with ring parameters
1862  // the factor algebra is finite, so the degree bound given by the Letterplace
1863  // ring is not necessary
1864  lpKDim(G,0); // procedure without any degree bound
1865}
1866
1867static proc lpMis2Base(ideal M)
1868"USAGE: lpMis2Base(M); M an ideal
1869RETURN: ideal, a K-basis of the factor algebra
1870PURPOSE:Compute a K-basis out of given mistletoes
1871ASSUME: - basering is a Letterplace ring. G is a Letterplace ideal.
1872@*      - M contains only monomials
1873NOTE:   - The mistletoes have to be ordered lexicographically -> OrdMisLex.
1874EXAMPLE: example lpMis2Base; shows examples
1875"
1876{list L;
1877  L = lpId2ivLi(M);
1878  return(ivL2lpI(ivMis2Base(L)));
1879}
1880example
1881{
1882  "EXAMPLE:"; echo = 2;
1883  ring r = 0,(x,y),dp;
1884  def R = freeAlgebra(r, 5); // constructs a Letterplace ring
1885  setring R; // sets basering to Letterplace ring
1886  ideal L = x*y,y*x*y;
1887  // ideal containing the mistletoes
1888  lpMis2Base(L); // returns the K-basis of the factor algebra
1889}
1890
1891static proc lpMis2Dim(ideal M)
1892"USAGE: lpMis2Dim(M); M an ideal
1893RETURN: int, the K-dimension of the factor algebra
1894PURPOSE:Compute the K-dimension out of given mistletoes
1895ASSUME: - basering is a Letterplace ring.
1896@*      - M contains only monomials
1897NOTE:   - The mistletoes have to be ordered lexicographically -> OrdMisLex.
1898EXAMPLE: example lpMis2Dim; shows examples
1899"
1900{list L;
1901  L = lpId2ivLi(M);
1902  return(ivMis2Dim(L));
1903}
1904example
1905{
1906  "EXAMPLE:"; echo = 2;
1907  ring r = 0,(x,y),dp;
1908  def R = freeAlgebra(r, 5); // constructs a Letterplace ring
1909  setring R; // sets basering to Letterplace ring
1910  ideal L = x*y,y*x*y;
1911  // ideal containing the mistletoes
1912  lpMis2Dim(L); // returns the K-dimension of the factor algebra
1913}
1914
1915static proc lpOrdMisLex(ideal M)
1916"USAGE: lpOrdMisLex(M); M an ideal of mistletoes
1917RETURN: ideal, containing the mistletoes, ordered lexicographically
1918PURPOSE:A given set of mistletoes is ordered lexicographically
1919ASSUME: - basering is a Letterplace ring.
1920NOTE:   This is preprocessing, it is not needed if the mistletoes are returned
1921@*      from the sickle algorithm.
1922EXAMPLE: example lpOrdMisLex; shows examples
1923"
1924{return(ivL2lpI(sort(lpId2ivLi(M))[1]));}
1925example
1926{
1927  "EXAMPLE:"; echo = 2;
1928  ring r = 0,(x,y),dp;
1929  def R = freeAlgebra(r, 5); // constructs a Letterplace ring
1930  setring R; // sets basering to Letterplace ring
1931  ideal M = x*y*x, y*y*x, x*x, y*x*x*x;
1932  // some monomials
1933  lpOrdMisLex(M); // orders the monomials lexicographically
1934}
1935
1936static proc lpSickle(ideal G,  list #)
1937"USAGE: lpSickle(G[,degbound,n]); G an ideal, degbound, n optional integers
1938RETURN: ideal
1939PURPOSE:Compute the mistletoes of K[X]/<G>
1940ASSUME: - basering is a Letterplace ring.
1941@*      - if you specify a different degree bound degbound,
1942@*        degbound <= attrib(basering,uptodeg) holds.
1943NOTE: - If degbound is set, there will be a degree bound added. 0 means no
1944@*      degree bound. Default: attrib(basering,uptodeg).
1945@*    - n is the number of variables, which can be set to a different number.
1946@*      Default: attrib(basering, lV).
1947@*    - If the K-dimension is known to be infinite, a degree bound is needed
1948EXAMPLE: example lpSickle; shows examples
1949"
1950{int degbound = lpDegBound(basering); int n = lpVarBlockSize(basering);
1951  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] >= 0){degbound = #[1];}}}
1952  if (size(#) > 1){if (typeof(#[1])=="int"){if (#[2] > 0){n = #[2];}}}
1953  list L; ideal R;
1954  R = normalize(lead(G));
1955  L = lp2ivId(R);
1956  L = ivSickle(L,n,degbound);
1957  R = ivL2lpI(L);
1958  return(R);
1959}
1960example
1961{
1962  "EXAMPLE:"; echo = 2;
1963  ring r = 0,(x,y),dp;
1964  def R = freeAlgebra(r, 5); // constructs a Letterplace ring
1965  setring R; // sets basering to Letterplace ring
1966  ideal G = x*x, y*y,x*y*x; // ideal G contains a
1967  //Groebner basis
1968  lpSickle(G); //invokes the procedure with ring parameters
1969  // the factor algebra is finite, so the degree bound given by the Letterplace
1970  // ring is not necessary
1971  lpSickle(G,0); // procedure without any degree bound
1972}
1973
1974proc lpSickleDim(ideal G, list #)
1975"USAGE: lpSickleDim(G[,degbound,n]); G an ideal, degbound, n optional integers
1976RETURN: list
1977PURPOSE:Compute the K-dimension and the mistletoes of K<X>/<G>
1978ASSUME: - basering is a Letterplace ring.
1979@*      - if you specify a different degree bound degbound,
1980@*        degbound <= attrib(basering,uptodeg) holds.
1981NOTE: - If L is the list returned, then L[1] is an integer, the K-dimension,
1982@*      L[2] is an ideal, the mistletoes.
1983@*    - If degbound is set, there will be a degree bound added. 0 means no
1984@*      degree bound. Default: attrib(basering,uptodeg).
1985@*    - n is the number of variables, which can be set to a different number.
1986@*      Default: attrib(basering, lV).
1987@*    - If the K-dimension is known to be infinite, a degree bound is needed
1988EXAMPLE: example lpSickleDim; shows examples
1989"
1990{int degbound = lpDegBound(basering);int n = lpVarBlockSize(basering);
1991  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] >= 0){degbound = #[1];}}}
1992  if (size(#) > 1){if (typeof(#[1])=="int"){if (#[2] > 0){n = #[2];}}}
1993  list L;
1994  L = lp2ivId(normalize(lead(G)));
1995  L = ivSickleDim(L,n,degbound);
1996  L[2] = ivL2lpI(L[2]);
1997  return(L);
1998}
1999example
2000{
2001  "EXAMPLE:"; echo = 2;
2002  ring r = 0,(x,y),dp;
2003  def R = freeAlgebra(r, 5); // constructs a Letterplace ring
2004  setring R; // sets basering to Letterplace ring
2005  ideal G = x*x, y*y,x*y*x; // G is a monomial Groebner basis
2006  lpSickleDim(G); // invokes the procedure with ring parameters
2007  // the factor algebra is finite, so the degree bound, given
2008  // by the Letterplace ring is not necessary
2009  lpSickleDim(G,0); // procedure without any degree bound
2010}
2011
2012static proc lpSickleHil(ideal G, list #)
2013"USAGE: lpSickleHil(G);
2014RETURN: list
2015PURPOSE:Compute the Hilbert series and the mistletoes
2016ASSUME: - basering is a Letterplace ring.
2017@*      - if you specify a different degree bound degbound,
2018@*        degbound <= attrib(basering,uptodeg) holds.
2019NOTE: - If L is the list returned, then L[1] is an intvec, corresponding to the
2020@*      Hilbert series, L[2] is an ideal, the mistletoes.
2021@*    - If degbound is set, there will be a degree bound added. 0 means no
2022@*      degree bound. Default: attrib(basering,uptodeg).
2023@*    - n is the number of variables, which can be set to a different number.
2024@*      Default: attrib(basering, lV).
2025@*    - If I = L[1] is the intvec returned, then I[k] is the (k-1)-th
2026@*      coefficient of the Hilbert series.
2027@*    - If the K-dimension is known to be infinite, a degree bound is needed
2028EXAMPLE: example lpSickleHil; shows examples
2029"
2030{int degbound = lpDegBound(basering);int n = lpVarBlockSize(basering);
2031  if (size(#) > 0){if (typeof(#[1])=="int"){if (#[1] >= 0){degbound = #[1];}}}
2032  if (size(#) > 1){if (typeof(#[1])=="int"){if (#[2] > 0){n = #[2];}}}
2033  list L;
2034  L = lp2ivId(normalize(lead(G)));
2035  L = ivSickleHil(L,n,degbound);
2036  L[2] =  ivL2lpI(L[2]);
2037  return(L);
2038}
2039example
2040{
2041  "EXAMPLE:"; echo = 2;
2042  ring r = 0,(x,y),dp;
2043  def R = freeAlgebra(r, 5); // constructs a Letterplace ring
2044  setring R; // sets basering to Letterplace ring
2045  ideal G = x*x, y*y,x*y*x; // ideal G contains a
2046  //Groebner basis
2047  lpSickleHil(G); // invokes the procedure with ring parameters
2048  // the factor algebra is finite, so the degree bound given by the Letterplace
2049  // ring is not necessary
2050  lpSickleHil(G,0); // procedure without any degree bound
2051}
2052
2053static proc sickle(ideal G, list #)
2054"USAGE: sickle(G[,m, d, h, degbound]); G an ideal; m,d,h,degbound optional
2055@*      integers
2056RETURN: list
2057PURPOSE:Allowing the user to access all procs with one command
2058ASSUME: - basering is a Letterplace ring.
2059@*      - if you specify a different degree bound degbound,
2060@*        degbound <= attrib(basering,uptodeg) holds.
2061NOTE:   The returned object will always be a list, but the entries of the
2062@*      returned list may be very different
2063@* case m=1,d=1,h=1: see lpDHilbertSickle
2064@* case m=1,d=1,h=0: see lpSickleDim
2065@* case m=1,d=0,h=1: see lpSickleHil
2066@* case m=1,d=0,h=0: see lpSickle (this is the default case)
2067@* case m=0,d=1,h=1: see lpDHilbert
2068@* case m=0,d=1,h=0: see lpKDim
2069@* case m=0,d=0,h=1: see lpHilbert
2070@* case m=0,d=0,h=0: returns an error
2071@*    - If degbound is set, there will be a degree bound added. 0 means no
2072@*      degree bound. Default: attrib(basering,uptodeg).
2073@*    - If the K-dimension is known to be infinite, a degree bound is needed
2074EXAMPLE: example sickle; shows examples
2075"
2076{int m,d,h,degbound;
2077  m = 1; d = 0; h = 0; degbound = lpDegBound(basering);
2078  if (size(#) > 0) {if (typeof(#[1])=="int"){if (#[1] < 1) {m = 0;}}}
2079  if (size(#) > 1) {if (typeof(#[1])=="int"){if (#[2] > 0) {d = 1;}}}
2080  if (size(#) > 2) {if (typeof(#[1])=="int"){if (#[3] > 0) {h = 1;}}}
2081  if (size(#) > 3) {if (typeof(#[1])=="int"){if (#[4] >= 0) {degbound = #[4];}}}
2082  if (m == 1)
2083  {if (d == 0)
2084    {if (h == 0) {return(lpSickle(G,degbound,lpVarBlockSize(basering)));}
2085      else        {return(lpSickleHil(G,degbound,lpVarBlockSize(basering)));}
2086    }
2087    else
2088    {if (h == 0) {return(lpSickleDim(G,degbound,lpVarBlockSize(basering)));}
2089      else {return(lpDHilbertSickle(G,degbound,lpVarBlockSize(basering)));}
2090    }
2091  }
2092  else
2093  {if (d == 0)
2094    {if (h == 0) {ERROR("You request to do nothing, so relax and do so");}
2095      else        {return(lpHilbert(G,degbound,lpVarBlockSize(basering)));}
2096    }
2097    else
2098    {if (h == 0) {return(lpKDim(G,degbound,lpVarBlockSize(basering)));}
2099      else {return(lpDHilbert(G,degbound,lpVarBlockSize(basering)));}
2100    }
2101  }
2102}
2103example
2104{
2105  "EXAMPLE:"; echo = 2;
2106  ring r = 0,(x,y),dp;
2107  def R = freeAlgebra(r, 5); // constructs a Letterplace ring
2108  setring R; // sets basering to Letterplace ring
2109  ideal G = x*x, y*y,x*y*x;
2110  // G contains a Groebner basis
2111  sickle(G,1,1,1); // computes mistletoes, K-dimension and the Hilbert series
2112  sickle(G,1,0,0); // computes mistletoes only
2113  sickle(G,0,1,0); // computes K-dimension only
2114  sickle(G,0,0,1); // computes Hilbert series only
2115}
2116
2117proc lpMonomialBasis(int d, int donly, ideal J)
2118"USAGE: lpMonomialBasis(d, donly, J); d, donly integers, J an ideal
2119RETURN: ideal
2120PURPOSE: computes a list of free monomials in a Letterplace
2121@*       basering R of degree at most d and not contained in <LM(J)>
2122@*       if donly <> 0, only monomials of degree d are returned
2123ASSUME: - basering is a Letterplace ring.
2124@*      - d <= attrib(basering,uptodeg) holds.
2125@*      - J is a Groebner basis
2126NOTE: will be replaced with reduce(maxideal(d), J); soon
2127"
2128{
2129  if (d < 0) {
2130    return (delete(ideal(0), 1)); // no monomials
2131  }
2132  ideal I = maxideal(d);
2133  if (!donly) {
2134    for (int i = d-1; i >= 0; i--) {
2135      I = maxideal(i), I;
2136    } kill i;
2137  }
2138  for (int i = ncols(I); i >= 1; i--) {
2139    if (lpLmDivides(J, I[i])) {
2140      I = delete(I, i);
2141    }
2142  } kill i;
2143  return (I);
2144}
2145example
2146{
2147  "EXAMPLE:"; echo = 2;
2148  ring r = 0,(x,y),dp;
2149  def R = freeAlgebra(r, 7); setring R;
2150  ideal J = x*y*x - y*x*y;
2151  option(redSB); option(redTail);
2152  J = letplaceGBasis(J);
2153  J;
2154  //monomials of degree 2 only in K<x,y>:
2155  lpMonomialBasis(2,1,ideal(0));
2156  //monomials of degree <=2 in K<x,y>
2157  lpMonomialBasis(2,0,ideal(0));
2158  //monomials of degree 3 only in K<x,y>/J
2159  lpMonomialBasis(3,1,J);
2160  //monomials of degree <=3 in K<x,y>/J
2161  lpMonomialBasis(3,0,J);
2162}
2163
2164///////////////////////////////////////////////////////////////////////////////
2165
2166/*
2167   Here are some examples one may try. Just copy them into your console.
2168   These are relations for braid groups, up to degree d:
2169
2170   LIB "fpadim.lib";
2171   ring r = 0,(x,y,z),dp;
2172   int d =10; // degree
2173   def R = freeAlgebra(r, d);
2174   setring R;
2175   ideal I = y*x*y - z*y*z, x*y*x - z*x*y,
2176   z*x*z - y*z*x, x*x*x + y*y*y +
2177   z*z*z + x*y*z;
2178   option(prot);
2179   option(redSB);option(redTail);option(mem);
2180   ideal J = system("freegb",I,d,3);
2181   lpKDimCheck(J);
2182   sickle(J,1,1,1,d);//Computes mistletoes, K-dimension and the Hilbert series
2183
2184
2185
2186   LIB "fpadim.lib";
2187   ring r = 0,(x,y,z),dp;
2188   int d =11; // degree
2189   def R = freeAlgebra(r, d);
2190   setring R;
2191   ideal I = y*x*y - z*y*z, x*y*z - z*x*y,
2192   z*x*z - y*z*x, x*x*x + y*y*y +
2193   z*z*z + x*y*z;
2194   option(prot);
2195   option(redSB);option(redTail);option(mem);
2196   ideal J = system("freegb",I,d,3);
2197   lpKDimCheck(J);
2198   sickle(J,1,1,1,d);
2199
2200
2201
2202   LIB "fpadim.lib";
2203   ring r = 0,(x,y,z),dp;
2204   int d  = 6; // degree
2205   def R  = freeAlgebra(r, d);
2206   setring R;
2207   ideal I = y*x*y - z*y*z, x*y*x - z*x*y,
2208   z*x*z - y*z*x, x*x*x -2*y*y*y + 3*z*z*z -4*x*y*z + 5*x*z*z- 6*x*y*y +7*x*x*z - 8*x*x*y;
2209   option(prot);
2210   option(redSB);option(redTail);option(mem);
2211   ideal J = system("freegb",I,d,3);
2212   lpKDimCheck(J);
2213   sickle(J,1,1,1,d);
2214 */
2215
2216/*
2217   Here are some examples, which can also be found in [studzins]:
2218
2219// takes up to 880Mb of memory
2220LIB "fpadim.lib";
2221ring r = 0,(x,y,z),dp;
2222int d =10; // degree
2223def R = freeAlgebra(r, d);
2224setring R;
2225ideal I =
2226z*z*z*z + y*x*y*x - x*y*y*x - 3*z*y*x*z, x*x*x + y*x*y - x*y*x, z*y*x-x*y*z + z*x*z;
2227option(prot);
2228option(redSB);option(redTail);option(mem);
2229ideal J = system("freegb",I,d,nvars(r));
2230lpKDimCheck(J);
2231sickle(J,1,1,1,d); // dimension is 24872
2232
2233
2234LIB "fpadim.lib";
2235ring r = 0,(x,y,z),dp;
2236int d =10; // degree
2237def R = freeAlgebra(r, d);
2238setring R;
2239ideal I = x*y + y*z, x*x + x*y - y*x - y*y;
2240option(prot);
2241option(redSB);option(redTail);option(mem);
2242ideal J = system("freegb",I,d,3);
2243lpKDimCheck(J);
2244sickle(J,1,1,1,d);
2245 */
2246
2247
2248/*
2249   Example for Compute GK dimension:
2250   returns a ring which contains an ideal I
2251   run gkDim(I) inside this ring and it should return 2n (the GK dimension
2252   of n-th Weyl algebra including evaluation operators).
2253
2254   static proc createWeylEx(int n, int d)
2255   "
2256   "
2257   {
2258   int baseringdef;
2259   if (defined(basering)) // if a basering is defined, it should be saved for later use
2260   {
2261   def save = basering;
2262   baseringdef = 1;
2263   }
2264   ring r = 0,(d(1..n),x(1..n),e(1..n)),dp;
2265   def R = freeAlgebra(r, d);
2266   setring R;
2267   ideal I; int i,j;
2268
2269   for (i = 1; i <= n; i++)
2270   {
2271   for (j = i+1; j<= n; j++)
2272   {
2273   I[size(I)+1] = lpMult(var(i),var(j));
2274   }
2275   }
2276
2277   for (i = 1; i <= n; i++)
2278   {
2279   for (j = i+1; j<= n; j++)
2280   {
2281   I[size(I)+1] = lpMult(var(n+i),var(n+j));
2282   }
2283   }
2284   for (i = 1; i <= n; i++)
2285   {
2286   for (j = 1; j<= n; j++)
2287   {
2288   I[size(I)+1] = lpMult(var(i),var(n+j));
2289   }
2290   }
2291   for (i = 1; i <= n; i++)
2292   {
2293   for (j = 1; j<= n; j++)
2294   {
2295   I[size(I)+1] = lpMult(var(i),var(2*n+j));
2296   }
2297   }
2298   for (i = 1; i <= n; i++)
2299   {
2300   for (j = 1; j<= n; j++)
2301   {
2302   I[size(I)+1] = lpMult(var(2*n+i),var(n+j));
2303   }
2304   }
2305   for (i = 1; i <= n; i++)
2306   {
2307   for (j = 1; j<= n; j++)
2308   {
2309   I[size(I)+1] = lpMult(var(2*n+i),var(2*n+j));
2310   }
2311   }
2312   I = simplify(I,2+4);
2313   I = letplaceGBasis(I);
2314   export(I);
2315   if (baseringdef == 1) {setring save;}
2316   return(R);
2317   }
2318
2319proc TestGKAuslander3()
2320{
2321  ring r = (0,q),(z,x,y),(dp(2),dp(2));
2322  def R = freeAlgebra(r, 5); // constructs a Letterplace ring
2323  R; setring R; // sets basering to Letterplace ring
2324  ideal I;
2325  I = q*x*y - y*x, z*y - y*z, z*x - x*z;
2326  I = letplaceGBasis(I);
2327  lpGkDim(I); // must be 3
2328  I = x*y*z - y*x, z*y - y*z, z*x - x*z;//gkDim = 2
2329  I = letplaceGBasis(I); // not finite BUT contains a poly in x,y only
2330  lpGkDim(I); // must be 4
2331
2332  ring r = 0,(y,x,z),dp;
2333  def R = freeAlgebra(r, 10); // constructs a Letterplace ring
2334  R; setring R; // sets basering to Letterplace ring
2335  ideal I;
2336  I = x*y*z - y*x, z*y - y*z, z*x - x*z;//gkDim = 2
2337  I = letplaceGBasis(I); // computed as it would be homogenized; infinite
2338  poly p = x*y*y*x-y*x*x*y;
2339  lpNF(p, I); // 0 as expected
2340
2341  // with inverse of z
2342  ring r = 0,(iz,z,x,y),dp;
2343  def R = freeAlgebra(r, 11); // constructs a Letterplace ring
2344  R; setring R; // sets basering to Letterplace ring
2345  ideal I;
2346  I = x*y*z - y*x, z*y - y*z, z*x - x*z,
2347    iz*y - y*iz, iz*x - x*iz, iz*z-1, z*iz -1;
2348  I = letplaceGBasis(I); //
2349  setring r;
2350  def R2 = freeAlgebra(r, 23); // constructs a Letterplace ring
2351  setring R2; // sets basering to Letterplace ring
2352  ideal I = imap(R,I);
2353  lpGkDim(I);
2354
2355
2356  ring r = 0,(t,z,x,y),(dp,dp);
2357  def R = freeAlgebra(r, 20); // constructs a Letterplace ring
2358  R; setring R; // sets basering to Letterplace ring
2359  ideal I;
2360  I = x*y*z - y*x*t, z*y - y*z, z*x - x*z,
2361    t*y - y*t, t*x - x*t, t*z - z*t;//gkDim = 2
2362  I = letplaceGBasis(I); // computed as it would be homogenized; infinite
2363  LIB "elim.lib";
2364  ideal Inoz = nselect(I,intvec(2,6,10,14,18,22,26,30));
2365  for(int i=1; i<=20; i++)
2366  {
2367    Inoz=subst(Inoz,t(i),1);
2368  }
2369  ideal J = x*y*y*x-y*x*x*y;
2370  J = letplaceGBasis(J);
2371
2372  poly p = x*y*y*x-y*x*x*y;
2373  lpNF(p, I); // 0 as expected
2374
2375  ring r2 = 0,(x,y),dp;
2376  def R2 = freeAlgebra(r2, 50); // constructs a Letterplace ring
2377  setring R2;
2378  ideal J = x*y*y*x-y*x*x*y;
2379  J = letplaceGBasis(J);
2380}
2381
2382*/
2383
2384
2385/*   more tests : downup algebra A
2386LIB "fpadim.lib";
2387ring r = (0,a,b,g),(x,y),Dp;
2388def R = freeAlgebra(r, 6); // constructs a Letterplace ring
2389setring R;
2390poly F1 = g*x;
2391poly F2 = g*y;
2392ideal J = x*x*y-a*x*y*x - b*y*x*x - F1,
2393x*y*y-a*y*x*y - b*y*y*x - F2;
2394J = letplaceGBasis(J);
2395lpGkDim(J); // 3 == correct
2396
2397// downup algebra B
2398LIB "fpadim.lib";
2399ring r = (0,a,b,g, p(1..7),q(1..7)),(x,y),Dp;
2400def R = freeAlgebra(r, 6); // constructs a Letterplace ring
2401setring R;
2402ideal imn = 1, y*y*y, x*y, y*x, x*x, y*y, x, y;
2403int i;
2404poly F1, F2;
2405for(i=1;i<=7;i++)
2406{
2407F1 = F1 + p(i)*imn[i];
2408F2 = F2 + q(i)*imn[i];
2409}
2410ideal J = x*x*y-a*x*y*x - b*y*x*x - F1,
2411x*y*y-a*y*x*y - b*y*y*x - F2;
2412J = letplaceGBasis(J);
2413lpGkDim(J); // 3 == correct
2414 */
Note: See TracBrowser for help on using the repository browser.