# source:git/Singular/LIB/freegb.lib@805b2d5

jengelh-datetimespielwiese
Last change on this file since 805b2d5 was 805b2d5, checked in by Viktor Levandovskyy <levandov@…>, 14 years ago
*levandov: numerous bugfixes and improvements in vct2str mod2str lst2str git-svn-id: file:///usr/local/Singular/svn/trunk@11543 2c84dea3-7e68-4137-9b89-c4e89433aadc
• Property mode set to `100644`
File size: 53.8 KB
Line
1//////////////////////////////////////////////////////////////////////////////
2version="\$Id: freegb.lib,v 1.19 2009-03-10 18:15:13 levandov Exp \$";
3category="Noncommutative";
4info="
5LIBRARY: freegb.lib   Twosided Noncommutative Groebner bases in Free Algebras via Letterplace
6AUTHOR: Viktor Levandovskyy,     levandov@math.rwth-aachen.de
7
8THEORY: See chapter 'LETTERPLACE' in the Singular Manual.
9
10PROCEDURES:
11makeLetterplaceRing(d);    creates a ring with d blocks of shifted original variables
12freeGBasis(L, n);   compute two-sided Groebner basis of ideal, encoded via L, up to degree n
13setLetterplaceAttributes(R,d,b);  supplies ring R with the letterplace structure
14
15AUXILIARY PROCEDURES:
16
17lpMult(f,g);        letterplace multiplication of letterplace polynomials
18lp2lstr(K, s);      convert letter-place ideal to a list of modules
19lst2str(L[, n]);     convert a list (of modules) into polynomials in free algebra
20mod2str(M[, n]); convert a module into a polynomial in free algebra
21vct2str(M[, n]);   convert a vector into a word in free algebra
22lieBracket(a,b[, N]);    compute Lie bracket ab-ba of two letterplace polynomials
23serreRelations(A,z);   compute the ideal of Serre's relations associated to a generalized Cartan matrix A
24isVar(p);                   check whether p is a power of a single variable
25ademRelations(i,j);    compute the ideal of Adem relations for i<2j in char 0
26
28"
29
30// this library computes two-sided GB of an ideal
31// in a free associative algebra
32
33// a monomial is encoded via a vector V
34// where V[1] = coefficient
35// V[1+i] = the corresponding symbol
36
37LIB "discretize.lib"; // for replace
38LIB "qhmoduli.lib"; // for Max
39
40proc testfreegblib()
41{
42  example makeLetterplaceRing;
43  example freeGBasis;
44  example setLetterplaceAttributes;
45    "AUXILIARY PROCEDURES: ";
46  example shiftPoly;
47  example lpMult;
48  example lp2lstr;
49  example lst2str;
50  example mod2str;
51  example vct2str;
52  example lieBracket;
53  example serreRelations;
54  example isVar;
55}
56
57
58proc setLetterplaceAttributes(def R, int uptodeg, int lV)
59"USAGE: setLetterplaceAttributes(R, d, b); R a ring, b,d integers
60RETURN: ring with special attributes set
61PURPOSE: sets attributes for a letterplace ring:
62@*      'isLetterplaceRing' = true, 'uptodeg' = d, 'lV' = b, where
63@*      'uptodeg' stands for the degree bound,
64@*      'lV' for the number of variables in the block 0.
65"
66{
67  if (uptodeg*lV != nvars(R))
68  {
69    ERROR("uptodeg and lV do not agree on the basering!");
70  }
71
72    // Set letterplace-specific attributes for the output ring!
73  attrib(R, "uptodeg", uptodeg);
74  attrib(R, "lV", lV);
75  attrib(R, "isLetterplaceRing", 1);
76  return (R);
77}
78example
79{
80  "EXAMPLE:"; echo = 2;
81  ring r = 0,(x(1),y(1),x(2),y(2),x(3),y(3),x(4),y(4)),dp;
82  def R = setLetterplaceAttributes(r, 4, 2); setring R;
83  attrib(R,"isLetterplaceRing");
84  lieBracket(x(1),y(1),2);
85}
86
87
88// obsolete?
89
90static proc lshift(module M, int s, string varing, def lpring)
91{
92  // FINALLY IMPLEMENTED AS A PART OT THE CODE
93  // shifts a poly from the ring @R to s positions
94  // M lives in varing, the result in lpring
95  // to be run from varing
96  int i, j, k, sm, sv;
97  vector v;
98  //  execute("setring "+lpring);
99  setring lpring;
100  poly @@p;
101  ideal I;
102  execute("setring "+varing);
103  sm = ncols(M);
104  for (i=1; i<=s; i++)
105  {
106    // modules, e.g. free polynomials
107    for (j=1; j<=sm; j++)
108    {
109      //vectors, e.g. free monomials
110      v  = M[j];
111      sv = size(v);
112      sp = "@@p = @@p + ";
113      for (k=2; k<=sv; k++)
114      {
115        sp = sp + string(v[k])+"("+string(k-1+s)+")*";
116      }
117      sp = sp + string(v[1])+";"; // coef;
118      setring lpring;
119      //      execute("setring "+lpring);
120      execute(sp);
121      execute("setring "+varing);
122    }
123    setring lpring;
124    //    execute("setring "+lpring);
125    I = I,@@p;
126    @@p = 0;
127  }
128  setring lpring;
129  //execute("setring "+lpring);
130  export(I);
131  //  setring varing;
132  execute("setring "+varing);
133}
134
135static proc skip0(vector v)
136{
137  // skips zeros in a vector, producing another vector
138  if ( (v[1]==0) || (v==0) ) { return(vector(0)); }
139  int sv = nrows(v);
140  int sw = size(v);
141  if (sv == sw)
142  {
143    return(v);
144  }
145  int i;
146  int j=1;
147  vector w;
148  for (i=1; i<=sv; i++)
149  {
150    if (v[i] != 0)
151    {
152      w = w + v[i]*gen(j);
153      j++;
154    }
155  }
156  return(w);
157}
158
159proc lst2str(list L, list #)
160"USAGE:  lst2str(L[,n]);  L a list of modules, n an optional integer
161RETURN:  list (of strings)
162PURPOSE: convert a list (of modules) into polynomials in free algebra
163EXAMPLE: example lst2str; shows examples
164NOTE: if an optional integer is not 0, stars signs are used in multiplication
165"
166{
167  // returns a list of strings
168  // being sentences in words built from L
169  // if #[1] = 1, use * between generators
170  int useStar = 0;
171  if ( size(#)>0 )
172  {
173    if ( typeof(#[1]) != "int")
174    {
175      ERROR("Second argument of type int expected");
176    }
177    if (#[1])
178    {
179      useStar = 1;
180    }
181  }
182  int i;
183  int s    = size(L);
184  if (s<1) { return(list(""));}
185  list N;
186  for(i=1; i<=s; i++)
187  {
188    if ((typeof(L[i]) == "module") || (typeof(L[i]) == "matrix") )
189    {
190      N[i] = mod2str(L[i],useStar);
191    }
192    else
193    {
194      "module or matrix expected in the list";
195      return(N);
196    }
197  }
198  return(N);
199}
200example
201{
202  "EXAMPLE:"; echo = 2;
203  ring r = 0,(x,y,z),(dp(1),dp(2));
204  module M = [-1,x,y],[-7,y,y],[3,x,x];
205  module N = [1,x,y,x,y],[-2,y,x,y,x],[6,x,y,y,x,y];
206  list L; L[1] = M; L[2] = N;
207  lst2str(L);
208  lst2str(L[1],1);
209}
210
211
212proc mod2str(module M, list #)
213"USAGE:  mod2str(M[,n]);  M a module, n an optional integer
214RETURN:  string
215PURPOSE: convert a module into a polynomial in free algebra
216EXAMPLE: example mod2str; shows examples
217NOTE: if an optional integer is not 0, stars signs are used in multiplication
218"
219{
220  if (size(M)==0) { return(""); }
221  // returns a string
222  // a sentence in words built from M
223  // if #[1] = 1, use * between generators
224  int useStar = 0;
225  if ( size(#)>0 )
226  {
227    if ( typeof(#[1]) != "int")
228    {
229      ERROR("Second argument of type int expected");
230    }
231    if (#[1])
232    {
233      useStar = 1;
234    }
235  }
236  int i;
237  int s    = ncols(M);
238  string t;
239  string mp;
240  for(i=1; i<=s; i++)
241  {
242    mp = vct2str(M[i],useStar);
243    if (mp[1] == "-")
244    {
245      t = t + mp;
246    }
247    else
248    {
249      if (mp != "")
250      {
251         t = t + "+" + mp;
252      }
253    }
254  }
255  if (t[1]=="+")
256  {
257    t = t[2..size(t)]; // remove first "+"
258  }
259  return(t);
260}
261example
262{
263  "EXAMPLE:"; echo = 2;
264  ring r = 0,(x,y,z),(dp);
265  module M = [1,x,y,x,y],[-2,y,x,y,x],[6,x,y,y,x,y];
266  mod2str(M);
267  mod2str(M,1);
268}
269
270proc vct2str(vector v, list #)
271"USAGE:  vct2str(v[,n]);  v a vector, n an optional integer
272RETURN:  string
273PURPOSE: convert a vector into a word in free algebra
274EXAMPLE: example vct2str; shows examples
275NOTE: if an optional integer is not 0, stars signs are used in multiplication
276"
277{
278  if (v==0) { return(""); }
279  // if #[1] = 1, use * between generators
280  int useStar = 0;
281  if ( size(#)>0 )
282  {
283    if (#[1])
284    {
285      useStar = 1;
286    }
287  }
288  int ppl = printlevel-voice+2;
289  // for a word, encoded by v
290  // produces a string for it
291  v = skip0(v);
292  if (v==0) { return(string(""));}
294  int s = size(v);
295  string vs,vv,vp,err;
296  int i,j,p,q;
297  for (i=1; i<=s-1; i++)
298  {
299    p     = isVar(v[i+1]);
300    if (p==0)
301    {
302      err = "Error: monomial expected at nonzero position " + string(i+1);
303      ERROR(err+" in vct2str");
304      //      dbprint(ppl,err);
305      //      return("_");
306    }
307    if (p==1)
308    {
309      if (useStar && (size(vs) >0))       {   vs = vs + "*"; }
310        vs = vs + string(v[i+1]);
311    }
312    else //power
313    {
314      vv = string(v[i+1]);
315      q = find(vv,"^");
316      if (q==0)
317      {
318        q = find(vv,string(p));
319        if (q==0)
320        {
321          err = "error in find for string "+vv;
322          dbprint(ppl,err);
323          return("_");
324        }
325      }
326      // q>0
327      vp = vv[1..q-1];
328      for(j=1;j<=p;j++)
329      {
330         if (useStar && (size(vs) >0))       {   vs = vs + "*"; }
331         vs = vs + vp;
332      }
333    }
334  }
335  string scf;
336  if (cf == -1)
337  {
338    scf = "-";
339  }
340  else
341  {
342    scf = string(cf);
343    if ( (cf == 1) && (size(vs)>0) )
344    {
345      scf = "";
346    }
347  }
348  if (useStar && (size(scf) >0) && (scf!="-") )       {   scf = scf + "*"; }
349  vs = scf + vs;
350  return(vs);
351}
352example
353{
354  "EXAMPLE:"; echo = 2;
355  ring r = (0,a),(x,y3,z(1)),dp;
356  vector v = [-7,x,y3^4,x2,z(1)^3];
357  vct2str(v);
358  vct2str(v,1);
359  vector w = [-7a^5+6a,x,y3,y3,x,z(1),z(1)];
360  vct2str(w);
361  vct2str(w,1);
362}
363
364proc isVar(poly p)
365"USAGE:  isVar(p);  poly p
366RETURN:  int
367PURPOSE: check, whether leading monomial of p is a power of a single variable
368@* from the basering. Returns the exponent or 0 if p is multivariate.
369EXAMPLE: example isVar; shows examples
370"
371{
372  // checks whether p is a variable indeed
373  // if it's a power of a variable, returns the power
374  if (p==0) {  return(0); } //"p=0";
376  if ( (p-lead(p)) !=0 ) { return(0); } // "p-lm(p)>0";
378  int s = size(v);
379  int i=1;
380  int cnt = 0;
381  int pwr = 0;
382  for (i=1; i<=s; i++)
383  {
384    if (v[i] != 0)
385    {
386      cnt++;
387      pwr = v[i];
388    }
389  }
390  //  "cnt:";  cnt;
391  if (cnt==1) { return(pwr); }
392  else { return(0); }
393}
394example
395{
396  "EXAMPLE:"; echo = 2;
397  ring r = 0,(x,y),dp;
398  poly f = xy+1;
399  isVar(f);
400  poly g = y^3;
401  isVar(g);
402  poly h = 7*x^3;
403  isVar(h);
404  poly i = 1;
405  isVar(i);
406}
407
408// new conversion routines
409
410static proc id2words(ideal I, int d)
411{
412  // NOT FINISHED
413  // input: ideal I of polys in letter-place notation
414  // in the ring with d real vars
415  // output: the list of strings: associative words
416  // extract names of vars
417  int i,m,n; string s; string place = "(1)";
418  list lv;
419  for(i=1; i<=d; i++)
420  {
421    s = string(var(i));
422    // get rid of place
423    n = find(s, place);
424    if (n>0)
425    {
426      s = s[1..n-1];
427    }
428    lv[i] = s;
429  }
430  poly p,q;
431  for (i=1; i<=ncols(I); i++)
432  {
433    if (I[i] != 0)
434    {
435      p = I[i];
436      while (p!=0)
437      {
439      }
440    }
441  }
442
443  return(lv);
444}
445example
446{
447  "EXAMPLE:"; echo = 2;
448  ring r = 0,(x(1),y(1),z(1),x(2),y(2),z(2)),dp;
449  ideal I = x(1)*y(2) -z(1)*x(2);
450  id2words(I,3);
451}
452
453static proc mono2word(poly p, int d)
454{
455}
456
457// given the element -7xy^2x, it is represented as [-7,x,y^2,x] or as [-7,x,y,y,x]
458// use the orig ord on (x,y,z) and expand it blockwise to (x(i),y(i),z(i))
459
460// the correspondences:
461// monomial in K<x,y,z>    <<--->> vector in R
462// polynomial in K<x,y,z>  <<--->> list of vectors (matrix/module) in R
463// ideal in K<x,y,z>       <<--->> list of matrices/modules in R
464
465
466// 1. form a new ring
467// 2. NOP
468// 3. compute GB -> with the kernel stuff
469// 4. skip shifted elts (check that no such exist?)
470// 5. go back to orig vars, produce strings/modules
471// 6. return the result
472
473proc freeGBasis(list LM, int d)
474"USAGE:  freeGBasis(L, d);  L a list of modules, d an integer
475RETURN:  ring
476PURPOSE: compute the two-sided Groebner basis of an ideal, encoded by L in
477the free associative algebra, up to degree d
478EXAMPLE: example freeGBasis; shows examples
479"
480{
481  // d = up to degree, will be shifted to d+1
482  if (d<1) {"bad d"; return(0);}
483
484  int ppl = printlevel-voice+2;
485  string err = "";
486
487  int i,j,s;
488  def save = basering;
489  // determine max no of places in the input
490  int slm = size(LM); // numbers of polys in the ideal
491  int sm;
492  intvec iv;
493  module M;
494  for (i=1; i<=slm; i++)
495  {
496    // modules, e.g. free polynomials
497    M  = LM[i];
498    sm = ncols(M);
499    for (j=1; j<=sm; j++)
500    {
501      //vectors, e.g. free monomials
502      iv = iv, size(M[j])-1; // 1 place is reserved by the coeff
503    }
504  }
505  int D = Max(iv); // max size of input words
506  if (d<D) {"bad d"; return(LM);}
507  D = D + d-1;
508  //  D = d;
509  list LR  = ringlist(save);
510  list L, tmp;
511  L[1] = LR[1]; // ground field
512  L[4] = LR[4]; // quotient ideal
513  tmp  = LR[2]; // varnames
514  s = size(LR[2]);
515  for (i=1; i<=D; i++)
516  {
517    for (j=1; j<=s; j++)
518    {
519      tmp[i*s+j] = string(tmp[j])+"("+string(i+1)+")";
520    }
521  }
522  for (i=1; i<=s; i++)
523  {
524    tmp[i] = string(tmp[i])+"("+string(1)+")";
525  }
526  L[2] = tmp;
527  list OrigNames = LR[2];
528  // ordering: d blocks of the ord on r
529  // try to get whether the ord on r is blockord itself
530  s = size(LR[3]);
531  if (s==2)
532  {
533    // not a blockord, 1 block + module ord
534    tmp = LR[3][s]; // module ord
535    for (i=1; i<=D; i++)
536    {
537      LR[3][s-1+i] = LR[3][1];
538    }
539    LR[3][s+D] = tmp;
540  }
541  if (s>2)
542  {
543    // there are s-1 blocks
544    int nb = s-1;
545    tmp = LR[3][s]; // module ord
546    for (i=1; i<=D; i++)
547    {
548      for (j=1; j<=nb; j++)
549      {
550        LR[3][i*nb+j] = LR[3][j];
551      }
552    }
553    //    size(LR[3]);
554    LR[3][nb*(D+1)+1] = tmp;
555  }
556  L[3] = LR[3];
557  def @R = ring(L);
558  setring @R;
559  ideal I;
560  poly @p;
561  s = size(OrigNames);
562  //  "s:";s;
563  // convert LM to canonical vectors (no powers)
564  setring save;
565  kill M; // M was defined earlier
566  module M;
567  slm = size(LM); // numbers of polys in the ideal
568  int sv,k,l;
569  vector v;
570  //  poly p;
571  string sp;
572  setring @R;
573  poly @@p=0;
574  setring save;
575  for (l=1; l<=slm; l++)
576  {
577    // modules, e.g. free polynomials
578    M  = LM[l];
579    sm = ncols(M); // in intvec iv the sizes are stored
580    // modules, e.g. free polynomials
581    for (j=1; j<=sm; j++)
582    {
583      //vectors, e.g. free monomials
584      v  = M[j];
585      sv = size(v);
586      //        "sv:";sv;
587      sp = "@@p = @@p + ";
588      for (k=2; k<=sv; k++)
589      {
590        sp = sp + string(v[k])+"("+string(k-1)+")*";
591      }
592      sp = sp + string(v[1])+";"; // coef;
593      setring @R;
594      execute(sp);
595      setring save;
596    }
597    setring @R;
598    //      "@@p:"; @@p;
599    I = I,@@p;
600    @@p = 0;
601    setring save;
602  }
603  kill sp;
604  // 3. compute GB
605  setring @R;
606  dbprint(ppl,"computing GB");
607  ideal J = system("freegb",I,d,nvars(save));
608  //  ideal J = slimgb(I);
609  dbprint(ppl,J);
610  // 4. skip shifted elts
611  ideal K = select1(J,1..s); // s = size(OrigNames)
612  dbprint(ppl,K);
613  dbprint(ppl, "done with GB");
614  // K contains vars x(1),...z(1) = images of originals
615  // 5. go back to orig vars, produce strings/modules
616  if (K[1] == 0)
617  {
618    "no reasonable output, GB gives 0";
619    return(0);
620  }
621  int sk = size(K);
622  int sp, sx, a, b;
623  intvec x;
624  poly p,q;
625  poly pn;
626  // vars in 'save'
627  setring save;
628  module N;
629  list LN;
630  vector V;
631  poly pn;
632  // test and skip exponents >=2
633  setring @R;
634  for(i=1; i<=sk; i++)
635  {
636    p  = K[i];
637    while (p!=0)
638    {
640      //      "processing q:";q;
642      sx = size(x);
643      for(k=1; k<=sx; k++)
644      {
645        if ( x[k] >= 2 )
646        {
647          err = "skip: the value x[k] is " + string(x[k]);
648          dbprint(ppl,err);
649          //            return(0);
650          K[i] = 0;
651          p    = 0;
652          q    = 0;
653          break;
654        }
655      }
656      p  = p - q;
657    }
658  }
659  K  = simplify(K,2);
660  sk = size(K);
661  for(i=1; i<=sk; i++)
662  {
663    //    setring save;
664    //    V  = 0;
665    setring @R;
666    p  = K[i];
667    while (p!=0)
668    {
670      err =  "processing q:" + string(q);
671      dbprint(ppl,err);
673      sx = size(x);
675      setring save;
676      pn = imap(@R,pn);
677      V  = V + leadcoef(pn)*gen(1);
678      for(k=1; k<=sx; k++)
679      {
680        if (x[k] ==1)
681        {
682          a = k / s; // block number=a+1, a!=0
683          b = k % s; // remainder
684          //          printf("a: %s, b: %s",a,b);
685          if (b == 0)
686          {
687            // that is it's the last var in the block
688            b = s;
689            a = a-1;
690          }
691          V = V + var(b)*gen(a+2);
692        }
693//         else
694//         {
695//           printf("error: the value x[k] is %s", x[k]);
696//           return(0);
697//         }
698      }
699      err = "V: " + string(V);
700      dbprint(ppl,err);
701      //      printf("V: %s", string(V));
702      N = N,V;
703      V  = 0;
704      setring @R;
705      p  = p - q;
706      pn = 0;
707    }
708    setring save;
709    LN[i] = simplify(N,2);
710    N     = 0;
711  }
712  setring save;
713  return(LN);
714}
715example
716{
717  "EXAMPLE:"; echo = 2;
718  ring r = 0,(x,y,z),(dp(1),dp(2));
719  module M = [-1,x,y],[-7,y,y],[3,x,x];
720  module N = [1,x,y,x],[-1,y,x,y];
721  list L; L[1] = M; L[2] = N;
722  lst2str(L);
723  def U = freeGBasis(L,5);
724  lst2str(U);
725}
726
727static proc crs(list LM, int d)
728"USAGE:  crs(L, d);  L a list of modules, d an integer
729RETURN:  ring
730PURPOSE: create a ring and shift the ideal
731EXAMPLE: example crs; shows examples
732"
733{
734  // d = up to degree, will be shifted to d+1
735  if (d<1) {"bad d"; return(0);}
736
737  int ppl = printlevel-voice+2;
738  string err = "";
739
740  int i,j,s;
741  def save = basering;
742  // determine max no of places in the input
743  int slm = size(LM); // numbers of polys in the ideal
744  int sm;
745  intvec iv;
746  module M;
747  for (i=1; i<=slm; i++)
748  {
749    // modules, e.g. free polynomials
750    M  = LM[i];
751    sm = ncols(M);
752    for (j=1; j<=sm; j++)
753    {
754      //vectors, e.g. free monomials
755      iv = iv, size(M[j])-1; // 1 place is reserved by the coeff
756    }
757  }
758  int D = Max(iv); // max size of input words
759  if (d<D) {"bad d"; return(LM);}
760  D = D + d-1;
761  //  D = d;
762  list LR  = ringlist(save);
763  list L, tmp;
764  L[1] = LR[1]; // ground field
765  L[4] = LR[4]; // quotient ideal
766  tmp  = LR[2]; // varnames
767  s = size(LR[2]);
768  for (i=1; i<=D; i++)
769  {
770    for (j=1; j<=s; j++)
771    {
772      tmp[i*s+j] = string(tmp[j])+"("+string(i)+")";
773    }
774  }
775  for (i=1; i<=s; i++)
776  {
777    tmp[i] = string(tmp[i])+"("+string(0)+")";
778  }
779  L[2] = tmp;
780  list OrigNames = LR[2];
781  // ordering: d blocks of the ord on r
782  // try to get whether the ord on r is blockord itself
783  s = size(LR[3]);
784  if (s==2)
785  {
786    // not a blockord, 1 block + module ord
787    tmp = LR[3][s]; // module ord
788    for (i=1; i<=D; i++)
789    {
790      LR[3][s-1+i] = LR[3][1];
791    }
792    LR[3][s+D] = tmp;
793  }
794  if (s>2)
795  {
796    // there are s-1 blocks
797    int nb = s-1;
798    tmp = LR[3][s]; // module ord
799    for (i=1; i<=D; i++)
800    {
801      for (j=1; j<=nb; j++)
802      {
803        LR[3][i*nb+j] = LR[3][j];
804      }
805    }
806    //    size(LR[3]);
807    LR[3][nb*(D+1)+1] = tmp;
808  }
809  L[3] = LR[3];
810  def @R = ring(L);
811  setring @R;
812  ideal I;
813  poly @p;
814  s = size(OrigNames);
815  //  "s:";s;
816  // convert LM to canonical vectors (no powers)
817  setring save;
818  kill M; // M was defined earlier
819  module M;
820  slm = size(LM); // numbers of polys in the ideal
821  int sv,k,l;
822  vector v;
823  //  poly p;
824  string sp;
825  setring @R;
826  poly @@p=0;
827  setring save;
828  for (l=1; l<=slm; l++)
829  {
830    // modules, e.g. free polynomials
831    M  = LM[l];
832    sm = ncols(M); // in intvec iv the sizes are stored
833    for (i=0; i<=d-iv[l]; i++)
834    {
835      // modules, e.g. free polynomials
836      for (j=1; j<=sm; j++)
837      {
838        //vectors, e.g. free monomials
839        v  = M[j];
840        sv = size(v);
841        //        "sv:";sv;
842        sp = "@@p = @@p + ";
843        for (k=2; k<=sv; k++)
844        {
845          sp = sp + string(v[k])+"("+string(k-2+i)+")*";
846        }
847        sp = sp + string(v[1])+";"; // coef;
848        setring @R;
849        execute(sp);
850        setring save;
851      }
852      setring @R;
853      //      "@@p:"; @@p;
854      I = I,@@p;
855      @@p = 0;
856      setring save;
857    }
858  }
859  setring @R;
860  export I;
861  return(@R);
862}
863example
864{
865  "EXAMPLE:"; echo = 2;
866  ring r = 0,(x,y,z),(dp(1),dp(2));
867  module M = [-1,x,y],[-7,y,y],[3,x,x];
868  module N = [1,x,y,x],[-1,y,x,y];
869  list L; L[1] = M; L[2] = N;
870  lst2str(L);
871  def U = crs(L,5);
872  setring U; U;
873  I;
874}
875
876static proc polylen(ideal I)
877{
878  // returns the ideal of length of polys
879  int i;
880  intvec J;
881  number s = 0;
882  for(i=1;i<=ncols(I);i++)
883  {
884    J[i] = size(I[i]);
885    s = s + J[i];
886  }
887  printf("the sum of length %s",s);
888  //  print(s);
889  return(J);
890}
891
892//proc freegbRing(int d)
893proc makeLetterplaceRing(int d)
894"USAGE:  makeLetterplaceRing(d); d an integer
895RETURN:  ring
896PURPOSE: creates a ring with d blocks of shifted original variables
897EXAMPLE: example makeLetterplaceRing; shows examples
898"
899{
900  // d = up to degree, will be shifted to d+1
901  if (d<1) {"bad d"; return(0);}
902
903  int uptodeg = d; int lV = nvars(basering);
904
905  int ppl = printlevel-voice+2;
906  string err = "";
907
908  int i,j,s;
909  def save = basering;
910  int D = d-1;
911  list LR  = ringlist(save);
912  list L, tmp;
913  L[1] = LR[1]; // ground field
914  L[4] = LR[4]; // quotient ideal
915  tmp  = LR[2]; // varnames
916  s = size(LR[2]);
917  for (i=1; i<=D; i++)
918  {
919    for (j=1; j<=s; j++)
920    {
921      tmp[i*s+j] = string(tmp[j])+"("+string(i+1)+")";
922    }
923  }
924  for (i=1; i<=s; i++)
925  {
926    tmp[i] = string(tmp[i])+"("+string(1)+")";
927  }
928  L[2] = tmp;
929  list OrigNames = LR[2];
930  // ordering: d blocks of the ord on r
931  // try to get whether the ord on r is blockord itself
932  // TODO: make L(2) ordering! exponent is maximally 2
933  s = size(LR[3]);
934  if (s==2)
935  {
936    // not a blockord, 1 block + module ord
937    tmp = LR[3][s]; // module ord
938    for (i=1; i<=D; i++)
939    {
940      LR[3][s-1+i] = LR[3][1];
941    }
942    LR[3][s+D] = tmp;
943  }
944  if (s>2)
945  {
946    // there are s-1 blocks
947    int nb = s-1;
948    tmp = LR[3][s]; // module ord
949    for (i=1; i<=D; i++)
950    {
951      for (j=1; j<=nb; j++)
952      {
953        LR[3][i*nb+j] = LR[3][j];
954      }
955    }
956    //    size(LR[3]);
957    LR[3][nb*(D+1)+1] = tmp;
958  }
959  L[3] = LR[3];
960  def @R = ring(L);
961  //  setring @R;
962  //  int uptodeg = d; int lV = nvars(basering); // were defined before
963  def @@R = setLetterplaceAttributes(@R,uptodeg,lV);
964  return (@@R);
965}
966example
967{
968  "EXAMPLE:"; echo = 2;
969  ring r = 0,(x,y,z),(dp(1),dp(2));
970  def A = makeLetterplaceRing(2);
971  setring A;
972  A;
973  attrib(A,"isLetterplaceRing");
974  attrib(A,"uptodeg");  // degree bound
975  attrib(A,"lV"); // number of variables in the main block
976}
977
978/* EXAMPLES:
979
980//static proc ex_shift()
981{
982  LIB "freegb.lib";
983  ring r = 0,(x,y,z),(dp(1),dp(2));
984  module M = [-1,x,y],[-7,y,y],[3,x,x];
985  module N = [1,x,y,x],[-1,y,x,y];
986  list L; L[1] = M; L[2] = N;
987  lst2str(L);
988  def U = crs(L,5);
989  setring U; U;
990  I;
991  poly p = I[2]; // I[8];
992  p;
993  system("stest",p,7,7,3); // error -> the world is ok
994  poly q1 = system("stest",p,1,7,3); //ok
995  poly q6 = system("stest",p,6,7,3); //ok
996  system("btest",p,3); //ok
997  system("btest",q1,3); //ok
998  system("btest",q6,3); //ok
999}
1000
1001//static proc test_shrink()
1002{
1003  LIB "freegb.lib";
1004  ring r =0,(x,y,z),dp;
1005  int d = 5;
1006  def R = makeLetterplaceRing(d);
1007  setring R;
1008  poly p1 = x(1)*y(2)*z(3);
1009  poly p2 = x(1)*y(4)*z(5);
1010  poly p3 = x(1)*y(1)*z(3);
1011  poly p4 = x(1)*y(2)*z(2);
1012  poly p5 = x(3)*z(5);
1013  poly p6 = x(1)*y(1)*x(3)*z(5);
1014  poly p7 = x(1)*y(2)*x(3)*y(4)*z(5);
1015  poly p8 = p1+p2+p3+p4+p5 + p6 + p7;
1016  p1; system("shrinktest",p1,3);
1017  p2; system("shrinktest",p2,3);
1018  p3; system("shrinktest",p3,3);
1019  p4; system("shrinktest",p4,3);
1020  p5; system("shrinktest",p5,3);
1021  p6; system("shrinktest",p6,3);
1022  p7; system("shrinktest",p7,3);
1023  p8; system("shrinktest",p8,3);
1024  poly p9 = p1 + 2*p2 + 5*p5 + 7*p7;
1025  p9; system("shrinktest",p9,3);
1026}
1027
1028//static proc ex2()
1029{
1030  option(prot);
1031  LIB "freegb.lib";
1032  ring r = 0,(x,y),dp;
1033  module M = [-1,x,y],[3,x,x]; // 3x^2 - xy
1034  def U = freegb(M,7);
1035  lst2str(U);
1036}
1037
1038//static proc ex_nonhomog()
1039{
1040  option(prot);
1041  LIB "freegb.lib";
1042  ring r = 0,(x,y,h),dp;
1043  list L;
1044  module M;
1045  M = [-1,y,y],[1,x,x,x];  // x3-y2
1046  L[1] = M;
1047  M = [1,x,h],[-1,h,x];  // xh-hx
1048  L[2] = M;
1049  M = [1,y,h],[-1,h,y];  // yh-hy
1050  L[3] = M;
1051  def U = freegb(L,4);
1052  lst2str(U);
1053  // strange elements in the basis
1054}
1055
1056//static proc ex_nonhomog_comm()
1057{
1058  option(prot);
1059  LIB "freegb.lib";
1060  ring r = 0,(x,y),dp;
1061  module M = [-1,y,y],[1,x,x,x];
1062  def U = freegb(M,5);
1063  lst2str(U);
1064}
1065
1066//static proc ex_nonhomog_h()
1067{
1068  option(prot);
1069  LIB "freegb.lib";
1070  ring r = 0,(x,y,h),(a(1,1),dp);
1071  module M = [-1,y,y,h],[1,x,x,x]; // x3 - y2h
1072  def U = freegb(M,6);
1073  lst2str(U);
1074}
1075
1076//static proc ex_nonhomog_h2()
1077{
1078  option(prot);
1079  LIB "freegb.lib";
1080  ring r = 0,(x,y,h),(dp);
1081  list L;
1082  module M;
1083  M = [-1,y,y,h],[1,x,x,x]; // x3 - y2h
1084  L[1] = M;
1085  M = [1,x,h],[-1,h,x]; // xh - hx
1086  L[2] = M;
1087  M = [1,y,h],[-1,h,y]; // yh - hy
1088  L[3] = M;
1089  def U = freeGBasis(L,3);
1090  lst2str(U);
1092}
1093
1094
1095//static proc ex_nonhomog_3()
1096{
1097  option(prot);
1098  LIB "./freegb.lib";
1099  ring r = 0,(x,y,z),(dp);
1100  list L;
1101  module M;
1102  M = [1,z,y],[-1,x]; // zy - x
1103  L[1] = M;
1104  M = [1,z,x],[-1,y]; // zx - y
1105  L[2] = M;
1106  M = [1,y,x],[-1,z]; // yx - z
1107  L[3] = M;
1108  lst2str(L);
1109  list U = freegb(L,4);
1110  lst2str(U);
1112}
1113
1114//static proc ex_densep_2()
1115{
1116  option(prot);
1117  LIB "freegb.lib";
1118  ring r = (0,a,b,c),(x,y),(Dp); // deglex
1119  module M = [1,x,x], [a,x,y], [b,y,x], [c,y,y];
1120  lst2str(M);
1121  list U = freegb(M,5);
1122  lst2str(U);
1123  // a=b is important -> finite basis!!!
1124  module M = [1,x,x], [a,x,y], [a,y,x], [c,y,y];
1125  lst2str(M);
1126  list U = freegb(M,5);
1127  lst2str(U);
1128}
1129
1130// END COMMENTED EXAMPLES
1131
1132*/
1133
1134// 1. form a new ring
1135// 2. produce shifted generators
1136// 3. compute GB
1137// 4. skip shifted elts
1138// 5. go back to orig vars, produce strings/modules
1139// 6. return the result
1140
1141static proc freegbold(list LM, int d)
1142"USAGE:  freegbold(L, d);  L a list of modules, d an integer
1143RETURN:  ring
1144PURPOSE: compute the two-sided Groebner basis of an ideal, encoded by L in
1145the free associative algebra, up to degree d
1146EXAMPLE: example freegbold; shows examples
1147"
1148{
1149  // d = up to degree, will be shifted to d+1
1150  if (d<1) {"bad d"; return(0);}
1151
1152  int ppl = printlevel-voice+2;
1153  string err = "";
1154
1155  int i,j,s;
1156  def save = basering;
1157  // determine max no of places in the input
1158  int slm = size(LM); // numbers of polys in the ideal
1159  int sm;
1160  intvec iv;
1161  module M;
1162  for (i=1; i<=slm; i++)
1163  {
1164    // modules, e.g. free polynomials
1165    M  = LM[i];
1166    sm = ncols(M);
1167    for (j=1; j<=sm; j++)
1168    {
1169      //vectors, e.g. free monomials
1170      iv = iv, size(M[j])-1; // 1 place is reserved by the coeff
1171    }
1172  }
1173  int D = Max(iv); // max size of input words
1174  if (d<D) {"bad d"; return(LM);}
1175  D = D + d-1;
1176  //  D = d;
1177  list LR  = ringlist(save);
1178  list L, tmp;
1179  L[1] = LR[1]; // ground field
1180  L[4] = LR[4]; // quotient ideal
1181  tmp  = LR[2]; // varnames
1182  s = size(LR[2]);
1183  for (i=1; i<=D; i++)
1184  {
1185    for (j=1; j<=s; j++)
1186    {
1187      tmp[i*s+j] = string(tmp[j])+"("+string(i+1)+")";
1188    }
1189  }
1190  for (i=1; i<=s; i++)
1191  {
1192    tmp[i] = string(tmp[i])+"("+string(1)+")";
1193  }
1194  L[2] = tmp;
1195  list OrigNames = LR[2];
1196  // ordering: d blocks of the ord on r
1197  // try to get whether the ord on r is blockord itself
1198  // TODO: make L(2) ordering! exponent is maximally 2
1199  s = size(LR[3]);
1200  if (s==2)
1201  {
1202    // not a blockord, 1 block + module ord
1203    tmp = LR[3][s]; // module ord
1204    for (i=1; i<=D; i++)
1205    {
1206      LR[3][s-1+i] = LR[3][1];
1207    }
1208    LR[3][s+D] = tmp;
1209  }
1210  if (s>2)
1211  {
1212    // there are s-1 blocks
1213    int nb = s-1;
1214    tmp = LR[3][s]; // module ord
1215    for (i=1; i<=D; i++)
1216    {
1217      for (j=1; j<=nb; j++)
1218      {
1219        LR[3][i*nb+j] = LR[3][j];
1220      }
1221    }
1222    //    size(LR[3]);
1223    LR[3][nb*(D+1)+1] = tmp;
1224  }
1225  L[3] = LR[3];
1226  def @R = ring(L);
1227  setring @R;
1228  ideal I;
1229  poly @p;
1230  s = size(OrigNames);
1231  //  "s:";s;
1232  // convert LM to canonical vectors (no powers)
1233  setring save;
1234  kill M; // M was defined earlier
1235  module M;
1236  slm = size(LM); // numbers of polys in the ideal
1237  int sv,k,l;
1238  vector v;
1239  //  poly p;
1240  string sp;
1241  setring @R;
1242  poly @@p=0;
1243  setring save;
1244  for (l=1; l<=slm; l++)
1245  {
1246    // modules, e.g. free polynomials
1247    M  = LM[l];
1248    sm = ncols(M); // in intvec iv the sizes are stored
1249    for (i=0; i<=d-iv[l]; i++)
1250    {
1251      // modules, e.g. free polynomials
1252      for (j=1; j<=sm; j++)
1253      {
1254        //vectors, e.g. free monomials
1255        v  = M[j];
1256        sv = size(v);
1257        //        "sv:";sv;
1258        sp = "@@p = @@p + ";
1259        for (k=2; k<=sv; k++)
1260        {
1261          sp = sp + string(v[k])+"("+string(k-1+i)+")*";
1262        }
1263        sp = sp + string(v[1])+";"; // coef;
1264        setring @R;
1265        execute(sp);
1266        setring save;
1267      }
1268      setring @R;
1269      //      "@@p:"; @@p;
1270      I = I,@@p;
1271      @@p = 0;
1272      setring save;
1273    }
1274  }
1275  kill sp;
1276  // 3. compute GB
1277  setring @R;
1278  dbprint(ppl,"computing GB");
1279  //  ideal J = groebner(I);
1280  ideal J = slimgb(I);
1281  dbprint(ppl,J);
1282  // 4. skip shifted elts
1283  ideal K = select1(J,1..s); // s = size(OrigNames)
1284  dbprint(ppl,K);
1285  dbprint(ppl, "done with GB");
1286  // K contains vars x(1),...z(1) = images of originals
1287  // 5. go back to orig vars, produce strings/modules
1288  if (K[1] == 0)
1289  {
1290    "no reasonable output, GB gives 0";
1291    return(0);
1292  }
1293  int sk = size(K);
1294  int sp, sx, a, b;
1295  intvec x;
1296  poly p,q;
1297  poly pn;
1298  // vars in 'save'
1299  setring save;
1300  module N;
1301  list LN;
1302  vector V;
1303  poly pn;
1304  // test and skip exponents >=2
1305  setring @R;
1306  for(i=1; i<=sk; i++)
1307  {
1308    p  = K[i];
1309    while (p!=0)
1310    {
1312      //      "processing q:";q;
1314      sx = size(x);
1315      for(k=1; k<=sx; k++)
1316      {
1317        if ( x[k] >= 2 )
1318        {
1319          err = "skip: the value x[k] is " + string(x[k]);
1320          dbprint(ppl,err);
1321          //            return(0);
1322          K[i] = 0;
1323          p    = 0;
1324          q    = 0;
1325          break;
1326        }
1327      }
1328      p  = p - q;
1329    }
1330  }
1331  K  = simplify(K,2);
1332  sk = size(K);
1333  for(i=1; i<=sk; i++)
1334  {
1335    //    setring save;
1336    //    V  = 0;
1337    setring @R;
1338    p  = K[i];
1339    while (p!=0)
1340    {
1342      err =  "processing q:" + string(q);
1343      dbprint(ppl,err);
1345      sx = size(x);
1347      setring save;
1348      pn = imap(@R,pn);
1349      V  = V + leadcoef(pn)*gen(1);
1350      for(k=1; k<=sx; k++)
1351      {
1352        if (x[k] ==1)
1353        {
1354          a = k / s; // block number=a+1, a!=0
1355          b = k % s; // remainder
1356          //          printf("a: %s, b: %s",a,b);
1357          if (b == 0)
1358          {
1359            // that is it's the last var in the block
1360            b = s;
1361            a = a-1;
1362          }
1363          V = V + var(b)*gen(a+2);
1364        }
1365//         else
1366//         {
1367//           printf("error: the value x[k] is %s", x[k]);
1368//           return(0);
1369//         }
1370      }
1371      err = "V: " + string(V);
1372      dbprint(ppl,err);
1373      //      printf("V: %s", string(V));
1374      N = N,V;
1375      V  = 0;
1376      setring @R;
1377      p  = p - q;
1378      pn = 0;
1379    }
1380    setring save;
1381    LN[i] = simplify(N,2);
1382    N     = 0;
1383  }
1384  setring save;
1385  return(LN);
1386}
1387example
1388{
1389  "EXAMPLE:"; echo = 2;
1390  ring r = 0,(x,y,z),(dp(1),dp(2));
1391  module M = [-1,x,y],[-7,y,y],[3,x,x];
1392  module N = [1,x,y,x],[-1,y,x,y];
1393  list L; L[1] = M; L[2] = N;
1394  lst2str(L);
1395  def U = freegbold(L,5);
1396  lst2str(U);
1397}
1398
1399/* begin older procs and tests
1400
1401static proc sgb(ideal I, int d)
1402{
1403  // new code
1404  // map x_i to x_i(1) via map()
1405  //LIB "freegb.lib";
1406  def save = basering;
1407  //int d =7;// degree
1408  int nv = nvars(save);
1409  def R = makeLetterplaceRing(d);
1410  setring R;
1411  int i;
1412  ideal Imap;
1413  for (i=1; i<=nv; i++)
1414  {
1415    Imap[i] = var(i);
1416  }
1417  //ideal I = x(1)*y(2), y(1)*x(2)+z(1)*z(2);
1418  ideal I = x(1)*x(2),x(1)*y(2) + z(1)*x(2);
1419  option(prot);
1420  //option(teach);
1421  ideal J = system("freegb",I,d,nv);
1422}
1423
1424static proc checkCeq()
1425{
1426  ring r = 0,(x,y),Dp;
1427  def A = makeLetterplaceRing(4);
1428  setring A;
1429  A;
1430  // I = x2-xy
1431  ideal I = x(1)*x(2) - x(1)*y(2), x(2)*x(3) - x(2)*y(3), x(3)*x(4) - x(3)*y(4);
1432  ideal C = x(2)-x(1),x(3)-x(2),x(4)-x(3),y(2)-y(1),y(3)-y(2),y(4)-y(3);
1433  ideal K = I,C;
1434  groebner(K);
1435}
1436
1437static proc exHom1()
1438{
1440  // z*y - x, z*x - y, y*x - z
1441  LIB "freegb.lib";
1442  LIB "elim.lib";
1443  ring r = 0,(x,y,z,h),dp;
1444  list L;
1445  module M;
1446  M = [1,z,y],[-1,x,h]; // zy - xh
1447  L[1] = M;
1448  M = [1,z,x],[-1,y,h]; // zx - yh
1449  L[2] = M;
1450  M = [1,y,x],[-1,z,h]; // yx - zh
1451  L[3] = M;
1452  lst2str(L);
1453  def U = crs(L,4);
1454  setring U;
1455  I = I,
1456    y(2)*h(3)+z(2)*x(3),     y(3)*h(4)+z(3)*x(4),
1457    y(2)*x(3)-z(2)*h(3),     y(3)*x(4)-z(3)*h(4);
1458  I = simplify(I,2);
1459  ring r2 = 0,(x(0..4),y(0..4),z(0..4),h(0..4)),dp;
1460  ideal J = imap(U,I);
1461  //  ideal K = homog(J,h);
1462  option(redSB);
1463  option(redTail);
1464  ideal L = groebner(J); //(K);
1465  ideal LL = sat(L,ideal(h))[1];
1466  ideal M = subst(LL,h,1);
1467  M = simplify(M,2);
1468  setring U;
1469  ideal M = imap(r2,M);
1470  lst2str(U);
1471}
1472
1473static proc test1()
1474{
1475  LIB "freegb.lib";
1476  ring r = 0,(x,y),Dp;
1477  int d = 10; // degree
1478  def R = makeLetterplaceRing(d);
1479  setring R;
1480  ideal I = x(1)*x(2) - y(1)*y(2);
1481  option(prot);
1482  option(teach);
1483  ideal J = system("freegb",I,d,2);
1484  J;
1485}
1486
1487static proc test2()
1488{
1489  LIB "freegb.lib";
1490  ring r = 0,(x,y),Dp;
1491  int d = 10; // degree
1492  def R = makeLetterplaceRing(d);
1493  setring R;
1494  ideal I = x(1)*x(2) - x(1)*y(2);
1495  option(prot);
1496  option(teach);
1497  ideal J = system("freegb",I,d,2);
1498  J;
1499}
1500
1501static proc test3()
1502{
1503  LIB "freegb.lib";
1504  ring r = 0,(x,y,z),dp;
1505  int d =5; // degree
1506  def R = makeLetterplaceRing(d);
1507  setring R;
1508  ideal I = x(1)*y(2), y(1)*x(2)+z(1)*z(2);
1509  option(prot);
1510  option(teach);
1511  ideal J = system("freegb",I,d,3);
1512}
1513
1514static proc schur2-3()
1515{
1516  // nonhomog:
1517  //  h^4-10*h^2+9,f*e-e*f+h, h*2-e*h-2*e,h*f-f*h+2*f
1518  // homogenized with t
1519  //  h^4-10*h^2*t^2+9*t^4,f*e-e*f+h*t, h*2-e*h-2*e*t,h*f-f*h+2*f*t,
1520  // t*h - h*t, t*f - f*t, t*e - e*t
1521}
1522
1523end older procs and tests */
1524
1527RETURN:  ring (and exports ideal)
1528ASSUME: there are at least i+j variables in the basering
1529PURPOSE: compute the ideal of Adem relations for i<2j in characteristic 0
1530@*  the ideal is exported under the name AdemRel in the output ring
1532"
1533{
1534  // produces Adem relations for i<2j in char 0
1535  // assume: 0<i<2j
1536  // requires presence of vars up to i+j
1537  if ( (i<0) || (i >= 2*j) )
1538  {
1539    ERROR("arguments out of range"); return(0);
1540  }
1541  ring @r = 0,(s(i+j..0)),lp;
1542  poly p,q;
1543  number n;
1544  int ii = i div 2; int k;
1545  // k=0 => s(0)=1
1546  n = binomial(j-1,i);
1547  q = n*s(i+j)*s(0);
1548  //  printf("k=0, term=%s",q);
1549  p = p + q;
1550  for (k=1; k<= ii; k++)
1551  {
1552    n = binomial(j-k-1,i-2*k);
1553    q = n*s(i+j-k)*s(k);;
1554    //    printf("k=%s, term=%s",k,q);
1555    p = p + q;
1556  }
1559  return(@r);
1560}
1561example
1562{
1563  "EXAMPLE:"; echo = 2;
1565  setring A;
1567}
1568
1569/*
15701,1: 0
15711,2: s(3)*s(0) == s(3) -> def for s(3):=s(1)s(2)
15732,2: s(3)*s(1) == s(1)s(2)s(1)
15741,3: 0 ( since 2*s(4)*s(0) = 0 mod 2)
15762,3: s(5)*s(0)+s(4)*s(1) == s(5)+s(4)*s(1)
15773,2: 0
15783,3: s(5)*s(1)
15791,4: 3*s(5)*s(0) == s(5)  -> def for s(5):=s(1)*s(4)
15812,4: 3*s(6)*s(0)+s(5)*s(1) == s(6) + s(5)*s(1) == s(6) + s(1)*s(4)*s(1)
15834,3: s(5)*s(2)
15843,4: s(7)*s(0)+2*s(6)*s(1) == s(7) -> def for s(7):=s(3)*s(4)
15854,4: s(7)*s(1)+s(6)*s(2)
1586*/
1587
1588/* s1,s2:
1589s1*s1 =0, s2*s2 = s1*s2*s1
1590*/
1591
1592/*
1593try char 0:
1594s1,s2:
1595s1*s1 =0, s2*s2 = s1*s2*s1, s(1)*s(3)== s(1)*s(1)*s(3) == 0 = 2*s(4) ->def for s(4)
1596hence 2==0! only in char 2
1597 */
1598
1599  // Adem rels modulo 2 are interesting
1600
1601static proc stringpoly2lplace(string s)
1602{
1603  // decomposes sentence into terms
1604  s = replace(s,newline,""); // get rid of newlines
1605  s = replace(s," ",""); // get rid of empties
1606  //arith symbols: +,-
1607  // decompose into words with coeffs
1608  list LS;
1609  int i,j,ie,je,k,cnt;
1610  // s[1]="-" situation
1611  if (s[1]=="-")
1612  {
1613    LS = stringpoly2lplace(string(s[2..size(s)]));
1614    LS[1] = string("-"+string(LS[1]));
1615    return(LS);
1616  }
1617  i = find(s,"-",2);
1618  // i==1 might happen if the 1st symbol coeff is negative
1619  j = find(s,"+");
1620  list LL;
1621  if (i==j)
1622  {
1623    "return a monomial";
1624    // that is both are 0 -> s is a monomial
1625    LS[1] = s;
1626    return(LS);
1627  }
1628  if (i==0)
1629  {
1630    "i==0 situation";
1631    // no minuses at all => pluses only
1632    cnt++;
1633    LS[cnt] = string(s[1..j-1]);
1634    s = s[j+1..size(s)];
1635    while (s!= "")
1636    {
1637      j = find(s,"+");
1638      cnt++;
1639      if (j==0)
1640      {
1641        LS[cnt] = string(s);
1642        s = "";
1643      }
1644      else
1645      {
1646        LS[cnt] = string(s[1..j-1]);
1647        s = s[j+1..size(s)];
1648      }
1649    }
1650    return(LS);
1651  }
1652  if (j==0)
1653  {
1654    "j==0 situation";
1655    // no pluses at all except the lead coef => the rest are minuses only
1656    cnt++;
1657    LS[cnt] = string(s[1..i-1]);
1658    s = s[i..size(s)];
1659    while (s!= "")
1660    {
1661      i = find(s,"-",2);
1662      cnt++;
1663      if (i==0)
1664      {
1665        LS[cnt] = string(s);
1666        s = "";
1667      }
1668      else
1669      {
1670        LS[cnt] = string(s[1..i-1]);
1671        s = s[i..size(s)];
1672      }
1673    }
1674    return(LS);
1675  }
1676  // now i, j are nonzero
1677  if (i>j)
1678  {
1679    "i>j situation";
1680    // + comes first, at place j
1681    cnt++;
1682    //    "cnt:"; cnt; "j:"; j;
1683    LS[cnt] = string(s[1..j-1]);
1684    s = s[j+1..size(s)];
1685    LL = stringpoly2lplace(s);
1686    LS = LS + LL;
1687    kill LL;
1688    return(LS);
1689  }
1690  else
1691  {
1692    "j>i situation";
1693    // - might come first, at place i
1694    if (i>1)
1695    {
1696      cnt++;
1697      LS[cnt] = string(s[1..i-1]);
1698      s = s[i..size(s)];
1699    }
1700    else
1701    {
1702      // i==1->  minus at leadcoef
1703      ie = find(s,"-",i+1);
1704      je = find(s,"+",i+1);
1705      if (je == ie)
1706      {
1707         "ie=je situation";
1708        //monomial
1709        cnt++;
1710        LS[cnt] = s;
1711        return(LS);
1712      }
1713      if (je < ie)
1714      {
1715         "je<ie situation";
1716        // + comes first
1717        cnt++;
1718        LS[cnt] = s[1..je-1];
1719        s = s[je+1..size(s)];
1720      }
1721      else
1722      {
1723        // ie < je
1724         "ie<je situation";
1725        cnt++;
1726        LS[cnt] = s[1..ie-1];
1727        s = s[ie..size(s)];
1728      }
1729    }
1730    "going into recursion with "+s;
1731    LL = stringpoly2lplace(s);
1732    LS = LS + LL;
1733    return(LS);
1734  }
1735}
1736example
1737{
1738  "EXAMPLE:"; echo = 2;
1739  string s = "x*y+y*z+z*t"; // + only
1740  stringpoly2lplace(s);
1741  string s2 = "x*y - y*z-z*t*w*w"; // +1, - only
1742  stringpoly2lplace(s2);
1743  string s3 = "-x*y + y - 2*x +7*w*w*w";
1744  stringpoly2lplace(s3);
1745}
1746
1748{
1749  // adds places to the list of strings
1750  // according to their order in the list
1751  int s = size(L);
1752  int i;
1753  for (i=1; i<=s; i++)
1754  {
1755    if (typeof(L[i]) == "string")
1756    {
1757      L[i] = L[i] + "(" + string(i) + ")";
1758    }
1759    else
1760    {
1761      ERROR("entry of type string expected");
1762      return(0);
1763    }
1764  }
1765  return(L);
1766}
1767example
1768{
1769  "EXAMPLE:"; echo = 2;
1770  string a = "f1";   string b = "f2";
1771  list L = a,b,a;
1773}
1774
1775static proc sent2lplace(string s)
1776{
1777  // SENTence of words TO LetterPLACE
1778  list L =   stringpoly2lplace(s);
1779  int i; int ss = size(L);
1780  for(i=1; i<=ss; i++)
1781  {
1782    L[i] = str2lplace(L[i]);
1783  }
1784  return(L);
1785}
1786example
1787{
1788  "EXAMPLE:"; echo = 2;
1789  ring r = 0,(f2,f1),dp;
1790  string s = "f2*f1*f1 - 2*f1*f2*f1+ f1*f1*f2";
1791  sent2lplace(s);
1792}
1793
1794static proc testnumber(string s)
1795{
1796  string t;
1797  if (s[1]=="-")
1798  {
1799    // two situations: either there's a negative number
1800    t = s[2..size(s)];
1801    if (testnumber(t))
1802    {
1803      //a negative number
1804    }
1805    else
1806    {
1807      // a variable times -1
1808    }
1809    // or just a "-" for -1
1810  }
1811  t = "ring @r=(";
1812  t = t + charstr(basering)+"),";
1813  t = t + string(var(1))+",dp;";
1814  //  write(":w tstnum.tst",t);
1815  t = t+ "number @@Nn = " + s + ";"+"\$";
1816  write(":w tstnum.tst",t);
1817  string runsing = system("Singular");
1818  int k;
1819  t = runsing+ " -teq <tstnum.tst >tstnum.out";
1820  k = system("sh",t);
1821  if (k!=0)
1822  {
1823    ERROR("Problems running Singular");
1824  }
1825  int i = system("sh", "grep error tstnum.out > /dev/NULL");
1826  if (i!=0)
1827  {
1828    // no error: s is a number
1829    i = 1;
1830  }
1831  k = system("sh","rm tstnum.tst tstnum.out > /dev/NULL");
1832  return(i);
1833}
1834example
1835{
1836  "EXAMPLE:"; echo = 2;
1837  ring r = (0,a),x,dp;
1838  string s = "a^2+7*a-2";
1839  testnumber(s);
1840  s = "b+a";
1841  testnumber(s);
1842}
1843
1844static proc str2lplace(string s)
1845{
1846  // converts a word (monomial) with coeff into letter-place
1847  // string: coef*var1^exp1*var2^exp2*...varN^expN
1848  s = strpower2rep(s); // expand powers
1849  if (size(s)==0) { return(0); }
1850  int i,j,k,insC;
1851  string a,b,c,d,t;
1852  // 1. get coeff
1853  i = find(s,"*");
1854  if (i==0) { return(s); }
1855  list VN;
1856  c = s[1..i-1]; // incl. the case like (-a^2+1)
1857  int tn = testnumber(c);
1858  if (tn == 0)
1859  {
1860    // failed test
1861    if (c[1]=="-")
1862    {
1863      // two situations: either there's a negative number
1864      t = c[2..size(c)];
1865      if (testnumber(t))
1866      {
1867         //a negative number
1868        // nop here
1869      }
1870      else
1871      {
1872         // a variable times -1
1873          c = "-1";
1874          j++; VN[j] = t; //string(c[2..size(c)]);
1875          insC = 1;
1876      }
1877    }
1878    else
1879    {
1880      // just a variable with coeff 1
1881          j++; VN[j] = string(c);
1882          c = "1";
1883          insC = 1;
1884    }
1885  }
1886 // get vars
1887  t = s;
1888  //  t = s[i+1..size(s)];
1889  k = size(t); //j = 0;
1890  while (k>0)
1891  {
1892    t = t[i+1..size(t)]; //next part
1893    i = find(t,"*"); // next *
1894    if (i==0)
1895    {
1896      // last monomial
1897      j++;
1898      VN[j] = t;
1899      k = size(t);
1900      break;
1901    }
1902    b = t[1..i-1];
1903    //    print(b);
1904    j++;
1905    VN[j] = b;
1906    k = size(t);
1907  }
1909  VN[size(VN)+1] = string(c);
1910  return(VN);
1911}
1912example
1913{
1914  "EXAMPLE:"; echo = 2;
1915  ring r = (0,a),(f2,f1),dp;
1916  str2lplace("-2*f2^2*f1^2*f2");
1917  str2lplace("-f1*f2");
1918  str2lplace("(-a^2+7a)*f1*f2");
1919}
1920
1921static proc strpower2rep(string s)
1922{
1923  // makes x*x*x*x out of x^4 ., rep statys for repetitions
1924  // looks for "-" problem
1925  // exception: "-" as coeff
1926  string ex,t;
1927  int i,j,k;
1928
1929  i = find(s,"^"); // first ^
1930  if (i==0) { return(s); } // no ^ signs
1931
1932  if (s[1] == "-")
1933  {
1934    // either -coef or -1
1935    // got the coeff:
1936    i = find(s,"*");
1937    if (i==0)
1938    {
1939      // no *'s   => coef == -1 or s == -23
1940      i = size(s)+1;
1941    }
1942    t = string(s[2..i-1]); // without "-"
1943    if ( testnumber(t) )
1944    {
1945      // a good number
1946      t = strpower2rep(string(s[2..size(s)]));
1947      t = "-"+t;
1948      return(t);
1949    }
1950    else
1951    {
1952      // a variable
1953      t = strpower2rep(string(s[2..size(s)]));
1954      t = "-1*"+ t;
1955      return(t);
1956    }
1957  }
1958  // the case when leadcoef is a number in ()
1959  if (s[1] == "(")
1960  {
1961    i = find(s,")",2);    // must be nonzero
1962    t = s[2..i-1];
1963    if ( testnumber(t) )
1964    {
1965      // a good number
1966    }
1967    else {"strpower2rep: bad number as coef";}
1968    ex = string(s[i+2..size(s)]); // 2 because of *
1969    ex =  strpower2rep(ex);
1970    t = "("+t+")*"+ex;
1971    return(t);
1972  }
1973
1974  i = find(s,"^"); // first ^
1975  j = find(s,"*",i+1); // next * == end of ^
1976  if (j==0)
1977  {
1978    ex = s[i+1..size(s)];
1979  }
1980  else
1981  {
1982    ex = s[i+1..j-1];
1983  }
1984  execute("int @exp = " + ex + ";"); //@exp = exponent
1985  // got varname
1986  for (k=i-1; k>0; k--)
1987  {
1988    if (s[k] == "*") break;
1989  }
1990  string varn = s[k+1..i-1];
1991  //  "varn:";  varn;
1992  string pref;
1993  if (k>0)
1994  {
1995    pref = s[1..k]; // with * on the k-th place
1996  }
1997  //  "pref:";  pref;
1998  string suf;
1999  if ( (j>0) && (j+1 <= size(s)) )
2000  {
2001    suf = s[j+1..size(s)]; // without * on the 1st place
2002  }
2003  //  "suf:"; suf;
2004  string toins;
2005  for (k=1; k<=@exp; k++)
2006  {
2007    toins = toins + varn+"*";
2008  }
2009  //  "toins: ";  toins;
2010  if (size(suf) == 0)
2011  {
2012    toins = toins[1..size(toins)-1]; // get rid of trailing *
2013  }
2014  else
2015  {
2016    suf = strpower2rep(suf);
2017  }
2018  ex = pref + toins + suf;
2019  return(ex);
2020  //  return(strpower2rep(ex));
2021}
2022example
2023{
2024  "EXAMPLE:"; echo = 2;
2025  ring r = (0,a),(x,y,z,t),dp;
2026  strpower2rep("-x^4");
2027  strpower2rep("-2*x^4*y^3*z*t^2");
2028  strpower2rep("-a^2*x^4");
2029}
2030
2031proc lieBracket(poly a, poly b, list #)
2032"USAGE:  lieBracket(a,b[,N]); a,b letterplace polynomials, N an optional integer
2033RETURN:  poly
2034ASSUME: basering has a letterplace ring structure
2035PURPOSE: compute the Lie bracket [a,b] = ab - ba between letterplace polynomials
2036NOTE: if N>1 is specified, then the left normed bracket [a,[...[a,b]]]] is computed.
2037EXAMPLE: example lieBracket; shows examples
2038"
2039{
2040  if (lpAssumeViolation())
2041  {
2042    //    ERROR("Either 'uptodeg' or 'lV' global variables are not set!");
2043    ERROR("Incomplete Letterplace structure on the basering!");
2044  }
2045  // alias ppLiebr;
2046  //if int N is given compute [a,[...[a,b]]]] left normed bracket
2047  poly q;
2048  int N=1;
2049  if (size(#)>0)
2050  {
2051    if (typeof(#[1])=="int")
2052    {
2053      N = int(#[1]);
2054    }
2055  }
2056  if (N<=0) { return(q); }
2057  while (b!=0)
2058  {
2059    q = q + pmLiebr(a,lead(b));
2060    b = b - lead(b);
2061  }
2062  int i;
2063  if (N >1)
2064  {
2065    for(i=1; i<=N; i++)
2066    {
2067      q = lieBracket(a,q);
2068    }
2069  }
2070  return(q);
2071}
2072example
2073{
2074  "EXAMPLE:"; echo = 2;
2075  ring r = 0,(x(1),y(1),x(2),y(2),x(3),y(3),x(4),y(4)),dp;
2076  def R = setLetterplaceAttributes(r,4,2); // supply R with letterplace structure
2077  setring R;
2078  poly a = x(1)*y(2); poly b = y(1);
2079  lieBracket(a,b);
2080  lieBracket(x(1),y(1),2);
2081}
2082
2083static proc pmLiebr(poly a, poly b)
2084{
2085  //  a poly, b mono
2086  poly s;
2087  while (a!=0)
2088  {
2090    a = a - lead(a);
2091  }
2092  return(s);
2093}
2094
2095proc shiftPoly(poly a, int i)
2096"USAGE:  shiftPoly(p,i); p letterplace poly, i int
2097RETURN: poly
2098ASSUME: basering has letterplace ring structure
2099PURPOSE: compute the i-th shift of letterplace polynomial p
2100EXAMPLE: example shiftPoly; shows examples
2101"
2102{
2103  // shifts a monomial a by i
2104  // calls pLPshift(p,sh,uptodeg,lVblock);
2105  if (lpAssumeViolation())
2106  {
2107    ERROR("Incomplete Letterplace structure on the basering!");
2108  }
2109  int uptodeg = attrib(basering,"uptodeg");
2110  int lV = attrib(basering,"lV");
2111  if (deg(a) + i > uptodeg)
2112  {
2113    ERROR("degree bound violated by the shift!");
2114  }
2115  return(system("stest",a,i,uptodeg,lV));
2116}
2117example
2118{
2119  "EXAMPLE:"; echo = 2;
2120  ring r = 0,(x,y,z),dp;
2121  int uptodeg = 5; int lV = 3;
2122  def R = makeLetterplaceRing(uptodeg);
2123  setring R;
2124  poly f = x(1)*z(2)*y(3) - 2*z(1)*y(2) + 3*x(1);
2125  shiftPoly(f,1);
2126  shiftPoly(f,2);
2127}
2128
2129
2130static proc mmLiebr(poly a, poly b)
2131{
2132  // a,b, monomials
2135  int sa = deg(a);
2136  int sb = deg(b);
2137  poly v = a*shiftPoly(b,sa) - b*shiftPoly(a,sb);
2138  return(v);
2139}
2140
2141static proc test_shift()
2142{
2143  LIB "freegb.lib";
2144  ring r = 0,(a,b),dp;
2145  int d =5;
2146  def R = makeLetterplaceRing(d);
2147  setring R;
2148  int uptodeg = d;
2149  int lV = 2;
2150  def R = setLetterplaceAttributes(r,uptodeg,2); // supply R with letterplace structure
2151  setring R;
2152  poly p = mmLiebr(a(1),b(1));
2153  poly p = lieBracket(a(1),b(1));
2154}
2155
2156proc serreRelations(intmat A, int zu)
2157"USAGE:  serreRelations(A,z); A an intmat, z an int
2158RETURN:  ideal
2159ASSUME: basering has a letterplace ring structure and
2160@*          A is a generalized Cartan matrix with integer entries
2161PURPOSE: compute the ideal of Serre's relations associated to A
2162EXAMPLE: example serreRelations; shows examples
2163"
2164{
2165  // zu = 1 -> with commutators [f_i,f_j]; zu == 0 without them
2166  // suppose that A is cartan matrix
2167  // then Serre's relations are
2168  // (ad f_j)^{1-A_{ij}} ( f_i)
2169  int ppl = printlevel-voice+2;
2170  int n = ncols(A); // hence n variables
2171  int i,j,k,el;
2172  poly p,q;
2173  ideal I;
2174  for (i=1; i<=n; i++)
2175  {
2176    for (j=1; j<=n; j++)
2177    {
2178      el = 1 - A[i,j];
2179      //     printf("i:%s, j: %s, l: %s",i,j,l);
2180      dbprint(ppl,"i, j, l: ",i,j,el);
2181      //      if ((i!=j) && (l >0))
2182      //      if ( (i!=j) &&  ( ((zu ==0) &&  (l >=2)) || ((zu ==1) &&  (l >=1)) ) )
2183      if ((i!=j) && (el >0))
2184      {
2185        q = lieBracket(var(j),var(i));
2186        dbprint(ppl,"first bracket: ",q);
2187        //        if (l >=2)
2188        //        {
2189          for (k=1; k<=el-1; k++)
2190          {
2191            q = lieBracket(var(j),q);
2192            dbprint(ppl,"further bracket:",q);
2193          }
2194          //        }
2195      }
2196      if (q!=0) { I = I,q; q=0;}
2197    }
2198  }
2199  I = simplify(I,2);
2200  return(I);
2201}
2202example
2203{
2204  "EXAMPLE:"; echo = 2;
2205  intmat A[3][3] =
2206    2, -1, 0,
2207    -1, 2, -3,
2208    0, -1, 2; // G^1_2 Cartan matrix
2209  ring r = 0,(f1,f2,f3),dp;
2210  int uptodeg = 5;
2211  def R = makeLetterplaceRing(uptodeg);
2212  setring R;
2213  ideal I = serreRelations(A,1); I = simplify(I,1+2+8);
2214  I;
2215}
2216
2217/* setup for older example:
2218  intmat A[2][2] = 2, -1, -1, 2; // sl_3 == A_2
2219  ring r = 0,(f1,f2),dp;
2220  int uptodeg = 5; int lV = 2;
2221*/
2222
2223proc lp2lstr(ideal K, def save)
2224"USAGE:  lp2lstr(K,s); K an ideal, s a ring
2225RETURN:  nothing (exports object @LN into s)
2226ASSUME: basering has a letterplace ring structure
2227PURPOSE: converts letterplace ideal to list of modules
2228NOTE: useful as preprocessing to 'lst2str'
2229EXAMPLE: example lp2lstr; shows examples
2230"
2231{
2232  def @R = basering;
2233  string err;
2234  int s = nvars(save);
2235  int i,j,k;
2236    // K contains vars x(1),...z(1) = images of originals
2237  // 5. go back to orig vars, produce strings/modules
2238  int sk = size(K);
2239  int sp, sx, a, b;
2240  intvec x;
2241  poly p,q;
2242  poly pn;
2243  // vars in 'save'
2244  setring save;
2245  module N;
2246  list LN;
2247  vector V;
2248  poly pn;
2249  // test and skip exponents >=2
2250  setring @R;
2251  for(i=1; i<=sk; i++)
2252  {
2253    p  = K[i];
2254    while (p!=0)
2255    {
2257      //      "processing q:";q;
2259      sx = size(x);
2260      for(k=1; k<=sx; k++)
2261      {
2262        if ( x[k] >= 2 )
2263        {
2264          err = "skip: the value x[k] is " + string(x[k]);
2265          dbprint(ppl,err);
2266          //            return(0);
2267          K[i] = 0;
2268          p    = 0;
2269          q    = 0;
2270          break;
2271        }
2272      }
2273      p  = p - q;
2274    }
2275  }
2276  K  = simplify(K,2);
2277  sk = size(K);
2278  for(i=1; i<=sk; i++)
2279  {
2280    //    setring save;
2281    //    V  = 0;
2282    setring @R;
2283    p  = K[i];
2284    while (p!=0)
2285    {
2287      err =  "processing q:" + string(q);
2288      dbprint(ppl,err);
2290      sx = size(x);
2292      setring save;
2293      pn = imap(@R,pn);
2294      V  = V + leadcoef(pn)*gen(1);
2295      for(k=1; k<=sx; k++)
2296      {
2297        if (x[k] ==1)
2298        {
2299          a = k / s; // block number=a+1, a!=0
2300          b = k % s; // remainder
2301          //          printf("a: %s, b: %s",a,b);
2302          if (b == 0)
2303          {
2304            // that is it's the last var in the block
2305            b = s;
2306            a = a-1;
2307          }
2308          V = V + var(b)*gen(a+2);
2309        }
2310      }
2311      err = "V: " + string(V);
2312      dbprint(ppl,err);
2313      //      printf("V: %s", string(V));
2314      N = N,V;
2315      V  = 0;
2316      setring @R;
2317      p  = p - q;
2318      pn = 0;
2319    }
2320    setring save;
2321    LN[i] = simplify(N,2);
2322    N     = 0;
2323  }
2324  setring save;
2325  list @LN = LN;
2326  export @LN;
2327  //  return(LN);
2328}
2329example
2330{
2331  "EXAMPLE:"; echo = 2;
2332  intmat A[2][2] = 2, -1, -1, 2; // sl_3 == A_2
2333  ring r = 0,(f1,f2),dp;
2334  def R = makeLetterplaceRing(3);
2335  setring R;
2336  ideal I = serreRelations(A,1);
2337  lp2lstr(I,r);
2338  setring r;
2339  lst2str(@LN,1);
2340}
2341
2342static proc strList2poly(list L)
2343{
2344  //  list L comes from sent2lplace (which takes a poly on the input)
2345  // each entry of L is a sublist with the coef on the last place
2346  int s = size(L); int t;
2347  int i,j;
2348  list M;
2349  poly p,q;
2350  string Q;
2351  for(i=1; i<=s; i++)
2352  {
2353    M = L[i];
2354    t = size(M);
2355    //    q = M[t]; // a constant
2356    Q = string(M[t]);
2357    for(j=1; j<t; j++)
2358    {
2359      //      q = q*M[j];
2360      Q = Q+"*"+string(M[j]);
2361    }
2362    execute("q="+Q+";");
2363    //    q;
2364    p = p + q;
2365  }
2366  kill Q;
2367  return(p);
2368}
2369example
2370{
2371  "EXAMPLE:"; echo = 2;
2372  ring r =0,(x,y,z,t),Dp;
2373  def A = makeLetterplaceRing(4);
2374  setring A;
2375  string t = "-2*y*z*y*z + y*t*z*z - z*x*x*y  + 2*z*y*z*y";
2376  list L = sent2lplace(t);
2377  L;
2378  poly p = strList2poly(L);
2379  p;
2380}
2381
2382static proc file2lplace(string fname)
2383"USAGE:  file2lplace(fnm);  fnm a string
2384RETURN:  ideal
2385PURPOSE: convert the contents of the file fnm into ideal of polynomials in free algebra
2386EXAMPLE: example file2lplace; shows examples
2387"
2388{
2389  // format: from the usual string to letterplace
2391  // assume: file is a comma-sep list of polys
2392  // the vars are declared before
2393  // the file ends with ";"
2394  string t; int i;
2395  ideal I;
2396  list tst;
2397  while (s!="")
2398  {
2399    i = find(s,",");
2400    "i"; i;
2401    if (i==0)
2402    {
2403      i = find(s,";");
2404      if (i==0)
2405      {
2406        // no ; ??
2407         "no colon or semicolon found anymore";
2408         return(I);
2409      }
2410      // no "," but ";" on the i-th place
2411      t = s[1..i-1];
2412      s = "";
2413      "processing: "; t;
2414      tst = sent2lplace(t);
2415      tst;
2416      I = I, strList2poly(tst);
2417      return(I);
2418    }
2419    // here i !=0
2420    t = s[1..i-1];
2421    s = s[i+1..size(s)];
2422    "processing: "; t;
2423    tst = sent2lplace(t);
2424    tst;
2425    I = I, strList2poly(tst);
2426  }
2427  return(I);
2428}
2429example
2430{
2431  "EXAMPLE:"; echo = 2;
2432  ring r =0,(x,y,z,t),dp;
2433  def A = makeLetterplaceRing(4);
2434  setring A;
2435  string fn = "myfile";
2436  string s1 = "z*y*y*y - 3*y*z*x*y  + 3*y*y*z*y - y*x*y*z,";
2437  string s2 = "-2*y*x*y*z + y*y*z*z - z*z*y*y + 2*z*y*z*y,";
2438  string s3 = "z*y*x*t - 2*y*z*y*t + y*y*z*t - t*z*y*y + 2*t*y*z*y - t*x*y*z;";
2439  write(":w "+fn,s1);  write(":a "+fn,s2);   write(":a "+fn,s3);
2441  ideal I = file2lplace(fn);
2442  I;
2443}
2444
2445/* EXAMPLES AGAIN:
2446//static proc get_ls3nilp()
2447{
2448//first app of file2lplace
2449  ring r =0,(x,y,z,t),dp;
2450  int d = 10;
2451  def A = makeLetterplaceRing(d);
2452  setring A;
2453  ideal I = file2lplace("./ls3nilp.bg");
2454  // and now test the correctness: go back from lplace to strings
2455  lp2lstr(I,r);
2456  setring r;
2457  lst2str(@LN,1); // agree!
2458}
2459
2460//static proc doc_example()
2461{
2462  LIB "freegb.lib";
2463  ring r = 0,(x,y,z),dp;
2464  int d =4; // degree bound
2465  def R = makeLetterplaceRing(d);
2466  setring R;
2467  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);
2468  option(redSB);option(redTail);
2469  ideal J = system("freegb",I,d,nvars(r));
2470  J;
2471  // visualization:
2472  lp2lstr(J,r); // export an object called @LN to the ring r
2473  setring r;  // change to the ring r
2474  lst2str(@LN,1); // output the strings
2475}
2476
2477*/
2478
2479// TODO:
2480// multiply two letterplace polynomials, lpMult
2481// reduction/ Normalform? needs kernel stuff
2482
2483proc lpMult(poly f, poly g)
2484"USAGE:  lpMult(f,g); f,g letterplace polynomials
2485RETURN:  poly
2486ASSUME: basering has a letterplace ring structure
2487PURPOSE: compute the letterplace form of f*g
2488EXAMPLE: example lpMult; shows examples
2489"
2490{
2491  if (lpAssumeViolation())
2492  {
2493    ERROR("Incomplete Letterplace structure on the basering!");
2494  }
2495  int sf = deg(f);
2496  int sg = deg(g);
2497  int uptodeg = attrib(basering, "uptodeg");
2498  if (sf+sg > uptodeg)
2499  {
2500    ERROR("degree bound violated by the product!");
2501  }
2502  //  if (sf>1) { sf = sf -1; }
2503  poly v = f*shiftPoly(g,sf);
2504  return(v);
2505}
2506example
2507{
2508  "EXAMPLE:"; echo = 2;
2509  // define a ring in letterplace form as follows:
2510  ring r = 0,(x(1),y(1),x(2),y(2),x(3),y(3),x(4),y(4)),dp;
2511  poly a = x(1)*y(2); poly b = y(1);
2512  def R = setLetterplaceAttributes(r,4,2); // supply R with letterplace structure
2513  setring R;
2514  lpMult(b,a);
2515  lpMult(a,b);
2516}
2517
2518static proc lpAssumeViolation()
2519{
2520  // checks whether the global vars
2521  // uptodeg and lV are defined
2522  // returns Boolean : yes/no [for assume violation]
2523  def lpring = attrib(basering,"isLetterplaceRing");
2524  if ( typeof(lpring)!="int" )
2525  {
2526    //  if ( typeof(lpring)=="string" ) ??
2527    // basering is NOT lp Ring
2528
2529    return(1);
2530  }
2531  def uptodeg = attrib(basering,"uptodeg");
2532  if ( typeof(uptodeg)!="int" )
2533  {
2534    return(1);
2535  }
2536  def lV = attrib(basering,"lV");
2537  if ( typeof(lV)!="int" )
2538  {
2539    return(1);
2540  }
2541  //  int i = ( defined(uptodeg) && (defined(lV)) );
2542  //  return ( !i );
2543  return(0);
2544}
2545
2546// alias libs for compatibility with older examples
2547proc freegbRing(int d)
2548{
2549  return(makeLetterplaceRing(d));
2550}
2551
2552proc freegbasis( list L, int n)
2553{
2554  return(freeGBasis(L, n));
2555}
Note: See TracBrowser for help on using the repository browser.