///////////////////////////////////////////////////////////////////////////// version="version freegb.lib 4.1.2.0 Feb_2019 "; // $Id$ category="Noncommutative"; info=" LIBRARY: freegb.lib Two-sided Groebner bases in free algebras and tools via Letterplace approach AUTHORS: Viktor Levandovskyy, viktor.levandovskyy at math.rwth-aachen.de @* Karim Abou Zeid, karim.abou.zeid at rwth-aachen.de @* Grischa Studzinski, grischa.studzinski at math.rwth-aachen.de OVERVIEW: For the theory, see chapter 'Letterplace' in the Singular Manual. This library provides access to kernel functions and also contains legacy code (partially as static procedures) for compatibility reasons. KEYWORDS: free associative algebra; tensor algebra; free noncommutative Groebner basis; Letterplace Groebner basis; finitely presented algebra Support: Joint projects LE 2697/2-1 and KR 1907/3-1 of the Priority Programme SPP 1489: 'Algorithmische und Experimentelle Methoden in Algebra, Geometrie und Zahlentheorie' of the German DFG and Project II.6 of the transregional collaborative research centre SFB-TRR 195 'Symbolic Tools in Mathematics and their Application' of the German DFG PROCEDURES: isFreeAlgebra(r); check whether r is a letterplace ring (free algebra) lpDegBound(R); returns the degree bound of a letterplace ring lpVarBlockSize(R); returns the size of the letterplace blocks lpNcgenCount(R); returns the number of ncgen variables lpDivision(f,I); two-sided division with remainder lpGBPres2Poly(L,I); reconstructs a polynomial from the output of lpDivision isOrderingShiftInvariant(i); tests shift-invariance of the monomial ordering makeLetterplaceRing(d); (deprecated, use freeAlgebra) creates a Letterplace ring out of given data letplaceGBasis(I); (deprecated, use twostd) two-sided Groebner basis of a letterplace ideal I lieBracket(a,b[, N]); (deprecated, use bracket) iterated Lie bracket of two letterplace polynomials setLetterplaceAttributes(R,d,b); (for testing purposes) supplies ring R with the letterplace structure testLift(M,T); verify the output of lift testSyz(M,S); verify the output of syz SEE ALSO: fpadim_lib, fpaprops_lib, fpalgebras_lib, LETTERPLACE "; // Remark Oct 2018: iv2lp, lp2iv etc are NOT IN HEADER because // they should not be used anymore /* more legacy: lpPrint(I, r); represents Letterplace ideal in the form of words (legacy routine) freeGBasis(L, n); computes two-sided Groebner basis of an ideal, encoded via list L (legacy routine) lp2lstr(K, s); convert a letterplace ideal into a list of modules lst2str(L[, n]); convert a list (of modules) into polynomials in free algebra via strings mod2str(M[, n]); convert a module into a polynomial in free algebra via strings vct2str(M[, n]); convert a vector into a word in free algebra //also, there were shiftPoly; lpPower; */ LIB "qhmoduli.lib"; // for Max LIB "fpalgebras.lib"; // for compatibility /* very fast and cheap test of consistency and functionality DO NOT make it static ! after adding the new proc, add it here */ proc tstfreegb() { example makeLetterplaceRing; example letplaceGBasis; example lpNF; example lpDivision; example lpGBPres2Poly; example freeGBasis; example setLetterplaceAttributes; example isOrderingShiftInvariant; /* secondary */ example lieBracket; example lpPrint; example ivL2lpI; example iv2lp; example iv2lpList; example iv2lpMat; example lp2iv; example lp2ivId; example lpId2ivLi; } proc setLetterplaceAttributes(def R, int uptodeg, int lV) "USAGE: setLetterplaceAttributes(R, d, b); R a ring, b,d integers RETURN: ring with special attributes set PURPOSE: sets attributes for a letterplace ring: 'isLetterplaceRing' = 'lV' = b, 'uptodeg' = d, where 'uptodeg' stands for the degree bound, 'lV' for the number of variables in the block 0. NOTE: Activate the resulting ring by using @code{setring} " { if (uptodeg*lV != nvars(R)) { ERROR("uptodeg and lV do not agree on the basering!"); } // Set letterplace-specific attributes for the output ring! // a kind of dirty hack, getting the ringlist again list RL = ringlist(R); attrib(RL, "isLetterplaceRing", lV); attrib(RL, "maxExp", 1); def @R = ring(RL); //attrib(@R, "uptodeg", uptodeg); // no longer needed attrib(@R, "isLetterplaceRing", lV); return (@R); } example { "EXAMPLE:"; echo = 2; ring r = 0,(x(1),y(1),x(2),y(2),x(3),y(3),x(4),y(4)),dp; def R = setLetterplaceAttributes(r, 4, 2); setring R; lpVarBlockSize(R); lieBracket(x(1),y(1),2); } static proc lst2str(list L, list #) "USAGE: lst2str(L[,n]); L a list of modules, n an optional integer RETURN: list (of strings) PURPOSE: convert a list (of modules) into polynomials in free algebra EXAMPLE: example lst2str; shows examples NOTE: if an optional integer is not 0, stars signs are used in multiplication " { // returns a list of strings // being sentences in words built from L // if #[1] = 1, use * between generators int useStar = 0; if ( size(#)>0 ) { if ( typeof(#[1]) != "int") { ERROR("Second argument of type int expected"); } if (#[1]) { useStar = 1; } } int i; int s = size(L); if (s<1) { return(list(""));} list N; for(i=1; i<=s; i++) { if ((typeof(L[i]) == "module") || (typeof(L[i]) == "matrix") ) { N[i] = mod2str(L[i],useStar); } else { "module or matrix expected in the list"; return(N); } } return(N); } example { "EXAMPLE:"; echo = 2; ring r = 0,(x,y,z),(dp(1),dp(2)); module M = [-1,x,y],[-7,y,y],[3,x,x]; module N = [1,x,y,x,y],[-2,y,x,y,x],[6,x,y,y,x,y]; list L; L[1] = M; L[2] = N; lst2str(L); lst2str(L[1],1); } static proc mod2str(module M, list #) "USAGE: mod2str(M[,n]); M a module, n an optional integer RETURN: string PURPOSE: convert a module into a polynomial in free algebra EXAMPLE: example mod2str; shows examples NOTE: if an optional integer is not 0, stars signs are used in multiplication " { if (size(M)==0) { return(""); } // returns a string // a sentence in words built from M // if #[1] = 1, use * between generators int useStar = 0; if ( size(#)>0 ) { if ( typeof(#[1]) != "int") { ERROR("Second argument of type int expected"); } if (#[1]) { useStar = 1; } } int i; int s = ncols(M); string t; string mp; for(i=1; i<=s; i++) { mp = vct2str(M[i],useStar); if (mp[1] == "-") { t = t + mp; } else { if (mp != "") { t = t + "+" + mp; } } } if (t[1]=="+") { t = t[2..size(t)]; // remove first "+" } return(t); } example { "EXAMPLE:"; echo = 2; ring r = 0,(x,y,z),(dp); module M = [1,x,y,x,y],[-2,y,x,y,x],[6,x,y,y,x,y]; mod2str(M); mod2str(M,1); } static proc vct2str(vector v, list #) "USAGE: vct2str(v[,n]); v a vector, n an optional integer RETURN: string PURPOSE: convert a vector into a word in free algebra EXAMPLE: example vct2str; shows examples NOTE: if an optional integer is not 0, stars signs are used in multiplication " { if (v==0) { return(""); } // if #[1] = 1, use * between generators int useStar = 0; if ( size(#)>0 ) { if (#[1]) { useStar = 1; } } int ppl = printlevel-voice+2; // for a word, encoded by v // produces a string for it v = skip0(v); if (v==0) { return(string(""));} number cf = leadcoef(v[1]); int s = size(v); string vs,vv,vp,err; int i,j,p,q; for (i=1; i<=s-1; i++) { p = isVar(v[i+1]); if (p==0) { err = "Error: monomial expected at nonzero position " + string(i+1); ERROR(err+" in vct2str"); // dbprint(ppl,err); // return("_"); } if (p==1) { if (useStar && (size(vs) >0)) { vs = vs + "*"; } vs = vs + string(v[i+1]); } else //power { vv = string(v[i+1]); q = find(vv,"^"); if (q==0) { q = find(vv,string(p)); if (q==0) { err = "error in find for string "+vv; dbprint(ppl,err); return("_"); } } // q>0 vp = vv[1..q-1]; for(j=1;j<=p;j++) { if (useStar && (size(vs) >0)) { vs = vs + "*"; } vs = vs + vp; } } } string scf; if (cf == -1) { scf = "-"; } else { scf = string(cf); if ( (cf == 1) && (size(vs)>0) ) { scf = ""; } } if (useStar && (size(scf) >0) && (scf!="-") ) { scf = scf + "*"; } vs = scf + vs; return(vs); } example { "EXAMPLE:"; echo = 2; ring r = (0,a),(x,y3,z(1)),dp; vector v = [-7,x,y3^4,x2,z(1)^3]; vct2str(v); vct2str(v,1); vector w = [-7a^5+6a,x,y3,y3,x,z(1),z(1)]; vct2str(w); vct2str(w,1); } static proc isVar(poly p) "USAGE: isVar(p); poly p RETURN: int PURPOSE: check, whether leading monomial of p is a power of a single variable from the basering. Returns the exponent or 0 if p is multivariate. EXAMPLE: example isVar; shows examples " { // checks whether p is a variable indeed // if it's a power of a variable, returns the power if (p==0) { return(0); } //"p=0"; poly q = leadmonom(p); if ( (p-lead(p)) !=0 ) { return(0); } // "p-lm(p)>0"; intvec v = leadexp(p); int s = size(v); int i=1; int cnt = 0; int pwr = 0; for (i=1; i<=s; i++) { if (v[i] != 0) { cnt++; pwr = v[i]; } } // "cnt:"; cnt; if (cnt==1) { return(pwr); } else { return(0); } } example { "EXAMPLE:"; echo = 2; ring r = 0,(x,y),dp; poly f = xy+1; isVar(f); poly g = y^3; isVar(g); poly h = 7*x^3; isVar(h); poly i = 1; isVar(i); } proc letplaceGBasis(def I) "USAGE: letplaceGBasis(I); I an ideal/module RETURN: ideal/module ASSUME: basering is a Letterplace ring, input consists of Letterplace polynomials PURPOSE: compute the two-sided Groebner basis of I via Letterplace algorithm (legacy routine) NOTE: the degree bound for this computation is read off the letterplace structure of basering EXAMPLE: example letplaceGBasis; shows examples " { return(std(I)); } example { "EXAMPLE:"; echo = 2; ring r = 0,(x,y,z),Dp; int degree_bound = 5; def R = freeAlgebra(r, 5); setring R; ideal I = -x*y-7*y*y+3*x*x, x*y*x-y*x*y; ideal J = letplaceGBasis(I); J; } /* // temporary name for testing */ /* proc lpRightStd(ideal F, ideal Q) */ /* { */ /* return (system("rightgb", F, Q)); */ /* } */ /* //// this was the part of example in the old good Letterplace // now transform letterplace polynomials into strings of words lp2lstr(J,r); // export an object called @code{@LN} to the ring r setring r; // change to the ring r lst2str(@LN,1); */ proc lieBracket(poly a, poly b, list #) "USAGE: lieBracket(a,b[,N]); a,b letterplace polynomials, N an optional integer RETURN: poly ASSUME: basering has a letterplace ring structure PURPOSE:compute the Lie bracket [a,b] = ab - ba between letterplace polynomials NOTE: if N>1 is specified, then the left normed bracket [a,[...[a,b]]]] is computed. EXAMPLE: example lieBracket; shows examples " { int N=1; if (size(#)>0) { if (typeof(#[1])=="int") { N = int(#[1]); } } return (bracket(a,b,N)); /* if (lpAssumeViolation()) */ /* { */ /* // ERROR("Either 'uptodeg' or 'lV' global variables are not set!"); */ /* ERROR("Incomplete Letterplace structure on the basering!"); */ /* } */ /* // alias ppLiebr; */ /* //if int N is given compute [a,[...[a,b]]]] right normed bracket */ /* int N=1; */ /* if (size(#)>0) */ /* { */ /* if (typeof(#[1])=="int") */ /* { */ /* N = int(#[1]); */ /* } */ /* } */ /* if (N<=0) { return(q); } */ /* poly q = a*b - b*a; */ /* if (N >1) */ /* { */ /* for(int i=1; i<=N-1; i++) */ /* { */ /* q = lieBracket(a,q); */ /* } */ /* } */ /* return(q); */ } example { "EXAMPLE:"; echo = 2; ring r = 0,(x,y),dp; ring R = freeAlgebra(r, 4); poly a = x*y; poly b = y; lieBracket(a,b); lieBracket(x,y,2); } proc lpPrint(ideal I, def @r) "USAGE: lpPrint(I, r); I an ideal, r a ring RETURN: list of strings PURPOSE: represent Letterplace ideal in the form of words (legacy routine) ASSUME: - basering is a Letterplace ring, r is the commutative ring from which basering has been built EXAMPLE: example lpPrint; shows example " { def save = basering; lp2lstr(I,@r); // export an object called @code{@LN} to the ring r setring @r; // change to the ring r list @L = lst2str(@LN,1); export @L; setring save; list @@L = @L; setring @r; kill @L; kill @LN; setring save; return(@@L); } example { "EXAMPLE:"; echo = 2; ring r = (0,a,b,g),(x,y),Dp; ring R = freeAlgebra(r, 4); // downup algebra A ideal J = x*x*y-a*x*y*x - b*y*x*x - g*x, x*y*y-a*y*x*y - b*y*y*x - g*y; list L = lpPrint(J,r); L; } /* HISTORICAL STUFF from 2007 // given the element -7xy^2x, it is represented as [-7,x,y^2,x] or as [-7,x,y,y,x] // use the orig ord on (x,y,z) and expand it blockwise to (x(i),y(i),z(i)) // the correspondences: // monomial in K <<--->> vector in R // polynomial in K <<--->> list of vectors (matrix/module) in R // ideal in K <<--->> list of matrices/modules in R // 1. form a new ring // 2. NOP // 3. compute GB -> with the kernel stuff // 4. skip shifted elts (check that no such exist?) // 5. go back to orig vars, produce strings/modules // 6. return the result */ proc freeGBasis(list LM, int d) "USAGE: freeGBasis(L, d); L a list of modules, d an integer RETURN: ring ASSUME: L has a special form. Namely, it is a list of modules, where - each generator of every module stands for a monomial times coefficient in free algebra, - in such a vector generator, the 1st entry is a nonzero coefficient from the ground field - and each next entry hosts a variable from the basering. PURPOSE: compute the two-sided Groebner basis of an ideal, encoded by L in the free associative algebra, up to degree d NOTE: Apply @code{lst2str} to the output in order to obtain a better readable presentation EXAMPLE: example freeGBasis; shows examples " { // d = up to degree, will be shifted to d+1 if (d<1) {"bad d"; return(0);} int ppl = printlevel-voice+2; string err = ""; int i,j,s; def save = basering; // determine max no of places in the input int slm = size(LM); // numbers of polys in the ideal int sm; intvec iv; module M; for (i=1; i<=slm; i++) { // modules, e.g. free polynomials M = LM[i]; sm = ncols(M); for (j=1; j<=sm; j++) { //vectors, e.g. free monomials iv = iv, size(M[j])-1; // 1 place is reserved by the coeff } } int D = Max(iv); // max size of input words if (d2) { // there are s-1 blocks int nb = s-1; tmp = LR[3][s]; // module ord for (i=1; i<=D; i++) { for (j=1; j<=nb; j++) { LR[3][i*nb+j] = LR[3][j]; } } // size(LR[3]); LR[3][nb*(D+1)+1] = tmp; } L[3] = LR[3]; attrib(L,"isLetterplaceRing",s); attrib(L, "maxExp", 1); def @R = ring(L); @R = setLetterplaceAttributes(@R, D+1, nvars(save)); setring @R; ideal I; poly @p; s = size(OrigNames); // "s:";s; // convert LM to canonical vectors (no powers) setring save; kill M; // M was defined earlier module M; slm = size(LM); // numbers of polys in the ideal int sv,k,l; vector v; // poly p; string sp; setring @R; poly @@p=0; setring save; for (l=1; l<=slm; l++) { // modules, e.g. free polynomials M = LM[l]; sm = ncols(M); // in intvec iv the sizes are stored // modules, e.g. free polynomials for (j=1; j<=sm; j++) { //vectors, e.g. free monomials v = M[j]; sv = size(v); // "sv:";sv; sp = "@@p = @@p + "; for (k=2; k<=sv; k++) { sp = sp + string(v[k])+"*"; } sp = sp + string(v[1])+";"; // coef; setring @R; execute(sp); setring save; } setring @R; // "@@p:"; @@p; I = I,@@p; @@p = 0; setring save; } kill sp; // 3. compute GB setring @R; dbprint(ppl,"computing GB"); ideal J = std(I); // ideal J = slimgb(I); dbprint(ppl,J); // 4. skip shifted elts attrib(@R, "isLetterplaceRing", 0); // select1 doesn't want to work with letterplace enabled ideal K = select1(J,1..s); // s = size(OrigNames) dbprint(ppl,K); dbprint(ppl, "done with GB"); // K contains vars x(1),...z(1) = images of originals // 5. go back to orig vars, produce strings/modules if (K[1] == 0) { "no reasonable output, GB gives 0"; return(0); } int sk = size(K); int sp, sx, a, b; intvec x; poly p,q; poly pn; // vars in 'save' setring save; module N; list LN; vector V; poly pn; // test and skip exponents >=2 setring @R; for(i=1; i<=sk; i++) { p = K[i]; while (p!=0) { q = lead(p); // "processing q:";q; x = leadexp(q); sx = size(x); for(k=1; k<=sx; k++) { if ( x[k] >= 2 ) { err = "skip: the value x[k] is " + string(x[k]); dbprint(ppl,err); // return(0); K[i] = 0; p = 0; q = 0; break; } } p = p - q; } } K = simplify(K,2); sk = size(K); for(i=1; i<=sk; i++) { // setring save; // V = 0; setring @R; p = K[i]; while (p!=0) { q = lead(p); err = "processing q:" + string(q); dbprint(ppl,err); x = leadexp(q); sx = size(x); pn = leadcoef(q); setring save; pn = imap(@R,pn); V = V + leadcoef(pn)*gen(1); for(k=1; k<=sx; k++) { if (x[k] ==1) { a = k div s; // block number=a+1, a!=0 b = k % s; // remainder // printf("a: %s, b: %s",a,b); if (b == 0) { // that is it's the last var in the block b = s; a = a-1; } V = V + var(b)*gen(a+2); } // else // { // printf("error: the value x[k] is %s", x[k]); // return(0); // } } err = "V: " + string(V); dbprint(ppl,err); // printf("V: %s", string(V)); N = N,V; V = 0; setring @R; p = p - q; pn = 0; } setring save; LN[i] = simplify(N,2); N = 0; } setring save; return(LN); } example { "EXAMPLE:"; echo = 2; ring r = 0,(x,y,z),(dp(1),dp(2)); // ring r = 0,(x,y,z),(a(3,0,2), dp(2)); module M = [-1,x,y],[-7,y,y],[3,x,x]; // stands for free poly -xy - 7yy - 3xx module N = [1,x,y,x],[-1,y,x,y]; // stands for free poly xyx - yxy list L; L[1] = M; L[2] = N; // list of modules stands for an ideal in free algebra lst2str(L); // list to string conversion of input polynomials def U = freeGBasis(L,5); // 5 is the degree bound lst2str(U); } static proc crs(list LM, int d) "USAGE: crs(L, d); L a list of modules, d an integer RETURN: ring PURPOSE: create a ring and shift the ideal EXAMPLE: example crs; shows examples " { // d = up to degree, will be shifted to d+1 if (d<1) {"bad d"; return(0);} int ppl = printlevel-voice+2; string err = ""; int i,j,s; def save = basering; // determine max no of places in the input int slm = size(LM); // numbers of polys in the ideal int sm; intvec iv; module M; for (i=1; i<=slm; i++) { // modules, e.g. free polynomials M = LM[i]; sm = ncols(M); for (j=1; j<=sm; j++) { //vectors, e.g. free monomials iv = iv, size(M[j])-1; // 1 place is reserved by the coeff } } int D = Max(iv); // max size of input words if (d2) { // there are s-1 blocks int nb = s-1; tmp = LR[3][s]; // module ord for (i=1; i<=D; i++) { for (j=1; j<=nb; j++) { LR[3][i*nb+j] = LR[3][j]; } } // size(LR[3]); LR[3][nb*(D+1)+1] = tmp; } L[3] = LR[3]; def @R = ring(L); setring @R; ideal I; poly @p; s = size(OrigNames); // "s:";s; // convert LM to canonical vectors (no powers) setring save; kill M; // M was defined earlier module M; slm = size(LM); // numbers of polys in the ideal int sv,k,l; vector v; // poly p; string sp; setring @R; poly @@p=0; setring save; for (l=1; l<=slm; l++) { // modules, e.g. free polynomials M = LM[l]; sm = ncols(M); // in intvec iv the sizes are stored for (i=0; i<=d-iv[l]; i++) { // modules, e.g. free polynomials for (j=1; j<=sm; j++) { //vectors, e.g. free monomials v = M[j]; sv = size(v); // "sv:";sv; sp = "@@p = @@p + "; for (k=2; k<=sv; k++) { sp = sp + string(v[k])+"("+string(k-2+i)+")*"; } sp = sp + string(v[1])+";"; // coef; setring @R; execute(sp); setring save; } setring @R; // "@@p:"; @@p; I = I,@@p; @@p = 0; setring save; } } setring @R; export I; return(@R); } example { "EXAMPLE:"; echo = 2; ring r = 0,(x,y,z),(dp(1),dp(2)); module M = [-1,x,y],[-7,y,y],[3,x,x]; module N = [1,x,y,x],[-1,y,x,y]; list L; L[1] = M; L[2] = N; lst2str(L); def U = crs(L,5); setring U; U; I; } static proc polylen(ideal I) { // returns the ideal of length of polys int i; intvec J; number s = 0; for(i=1;i<=ncols(I);i++) { J[i] = size(I[i]); s = s + J[i]; } printf("the sum of length %s",s); // print(s); return(J); } proc lpDegBound(def R) "USAGE: lpDegBound(R); R a letterplace ring RETURN: int PURPOSE: returns the degree bound of the letterplace ring EXAMPLE: example lpDegBound; shows examples " { int lV = attrib(R, "isLetterplaceRing"); if (lV < 1) { ERROR("not a letterplace ring"); } return (nvars(R) div lV); } example { "EXAMPLE:"; echo = 2; ring r = 0,(x,y,z),dp; def R = freeAlgebra(r, 7); lpDegBound(R); } proc lpVarBlockSize(def R) "USAGE: lpVarBlockSize(R); R a letterplace ring RETURN: int PURPOSE: returns the variable block size of the letterplace ring, that is the number of variables of the original ring. EXAMPLE: example lpVarBlockSize; shows examples " { int lV = attrib(R, "isLetterplaceRing"); if (lV < 1) { ERROR("not a letterplace ring"); } return (lV); } example { "EXAMPLE:"; echo = 2; ring r = 0,(x,y,z),dp; ring R = freeAlgebra(r, 7); lpVarBlockSize(R); } proc isFreeAlgebra(def r) "USAGE: isFreeAlgebra(r); r a ring RETURN: boolean PURPOSE: check whether R is a letterplace ring (free algebra) EXAMPLE: example isFreeAlgebra; shows examples " { int lV = attrib(r, "isLetterplaceRing"); if (lV < 1) { return (0); } return (1); } example { "EXAMPLE:"; echo = 2; ring r = 0,(x,y,z),dp; isFreeAlgebra(r); ring R = freeAlgebra(r, 7); isFreeAlgebra(R); } proc lpNcgenCount(def R) "USAGE: lpNcgenCount(R); R a letterplace ring RETURN: int PURPOSE: returns the number of ncgen variables in the letterplace ring. EXAMPLE: example ncgenCount; shows examples " { return(attrib(R, "ncgenCount")); } example { "EXAMPLE:"; echo = 2; ring r = 0,(x,y,z),dp; ring R = freeAlgebra(r, 7, 3); lpNcgenCount(R); // should be 3 } // united all previous makes, including mLR1 (homog) and mLR2 (nonhomog) proc makeLetterplaceRing(int d, list #) "USAGE: makeLetterplaceRing(d [,h]); d an integer, h an optional integer (deprecated, use freeAlgebra instead) RETURN: ring PURPOSE: creates a ring with the ordering, used in letterplace computations NOTE: h = -1 (default) : the ordering of the current ring will be used h = 0 : Dp ordering will be used h = 2 : weights 1 used for all the variables, a tie breaker is a list of block of original ring h = 1 : the pure homogeneous letterplace block ordering (applicable in the situation of homogeneous input ideals) will be used. EXAMPLE: example makeLetterplaceRing; shows examples " { int alternativeVersion = -1; if ( size(#)>0 ) { if (typeof(#[1]) == "int") { alternativeVersion = #[1]; } } if (alternativeVersion == 1) { def @A = makeLetterplaceRing1(d); } else { if (alternativeVersion == 2) { def @A = makeLetterplaceRing2(d); } else { if (alternativeVersion == 0) { def @A = makeLetterplaceRing4(d); } else { def @A = freeAlgebra(basering, d); } } } return(@A); } example { "EXAMPLE:"; echo = 2; ring r = 0,(x,y,z),Dp; def A = makeLetterplaceRing(2); // same as makeLetterplaceRing(2,0) setring A; A; lpVarBlockSize(A); lpDegBound(A); // degree bound setring r; def B = makeLetterplaceRing(2,1); // to compare: setring B; B; lpVarBlockSize(B); lpDegBound(B); // degree bound setring r; def C = makeLetterplaceRing(2,2); // to compare: setring C; C; lpDegBound(C); lpDegBound(C); // degree bound } static proc makeLetterplaceRing1(int d) "USAGE: makeLetterplaceRing1(d); d an integer RETURN: ring PURPOSE: creates a ring with a special ordering, suitable for @* the use of homogeneous letterplace (d blocks of shifted original variables) EXAMPLE: example makeLetterplaceRing1; shows examples " { // d = up to degree, will be shifted to d+1 if (d<1) {"bad d"; return(0);} int uptodeg = d; int lV = nvars(basering); int ppl = printlevel-voice+2; string err = ""; int i,j,s; def save = basering; int D = d-1; list LR = ringlist(save); list L, tmp; L[1] = LR[1]; // ground field L[4] = LR[4]; // quotient ideal tmp = LR[2]; // varnames s = size(LR[2]); for (i=1; i<=D; i++) { for (j=1; j<=s; j++) { tmp[i*s+j] = tmp[j]; } } L[2] = tmp; list OrigNames = LR[2]; // ordering: d blocks of the ord on r // try to get whether the ord on r is blockord itself // TODO: make L(2) ordering! exponent is maximally 2 s = size(LR[3]); if (s==2) { // not a blockord, 1 block + module ord tmp = LR[3][s]; // module ord for (i=1; i<=D; i++) { LR[3][s-1+i] = LR[3][1]; } LR[3][s+D] = tmp; } if (s>2) { // there are s-1 blocks int nb = s-1; tmp = LR[3][s]; // module ord for (i=1; i<=D; i++) { for (j=1; j<=nb; j++) { LR[3][i*nb+j] = LR[3][j]; } } // size(LR[3]); LR[3][nb*(D+1)+1] = tmp; } L[3] = LR[3]; attrib(L,"maxExp",1); attrib(L,"isLetterplaceRing",lV); def @R = ring(L); // setring @R; // int uptodeg = d; int lV = nvars(basering); // were defined before def @@R = setLetterplaceAttributes(@R,uptodeg,lV); return (@@R); } example { "EXAMPLE:"; echo = 2; ring r = 0,(x,y,z),(dp(1),dp(2)); def A = makeLetterplaceRing1(2); setring A; A; lpVarBlockSize(A);// number of variables in the main block lpDegBound(A); // degree bound } static proc makeLetterplaceRing2(int d) "USAGE: makeLetterplaceRing2(d); d an integer RETURN: ring PURPOSE: creates a ring with a special ordering, suitable for @* the use of non-homogeneous letterplace NOTE: the matrix for the ordering looks as follows: first row is 1,1,...,1 @* then there come 'd' blocks of shifted original variables EXAMPLE: example makeLetterplaceRing2; shows examples " { // ToDo future: inherit positive weights in the orig ring // complain on nonpositive ones // d = up to degree, will be shifted to d+1 if (d<1) {"bad d"; return(0);} int uptodeg = d; int lV = nvars(basering); int ppl = printlevel-voice+2; string err = ""; int i,j,s; def save = basering; int D = d-1; list LR = ringlist(save); list L, tmp, tmp2, tmp3; L[1] = LR[1]; // ground field L[4] = LR[4]; // quotient ideal tmp = LR[2]; // varnames s = size(LR[2]); for (i=1; i<=D; i++) { for (j=1; j<=s; j++) { tmp[i*s+j] =tmp[j]; } } L[2] = tmp; list OrigNames = LR[2]; // ordering: one 1..1 a above // ordering: d blocks of the ord on r // try to get whether the ord on r is blockord itself // TODO: make L(2) ordering! exponent is maximally 2 s = size(LR[3]); if (s==2) { // not a blockord, 1 block + module ord tmp = LR[3][s]; // module ord for (i=1; i<=d; i++) { LR[3][s-1+i] = LR[3][1]; } // LR[3][s+D] = tmp; LR[3][s+1+D] = tmp; LR[3][1] = list("a",intvec(1: int(d*lV))); // deg-ord } if (s>2) { // there are s-1 blocks int nb = s-1; tmp = LR[3][s]; // module ord to place at the very end tmp2 = LR[3]; tmp2 = tmp2[1..nb]; tmp3[1] = list("a",intvec(1: int(d*lV))); // deg-ord, insert as the 1st for (i=1; i<=d; i++) { tmp3 = tmp3 + tmp2; } tmp3 = tmp3 + list(tmp); LR[3] = tmp3; // for (i=1; i<=d; i++) // { // for (j=1; j<=nb; j++) // { // // LR[3][i*nb+j+1]= LR[3][j]; // LR[3][i*nb+j+1]= tmp2[j]; // } // } // // size(LR[3]); // LR[3][(s-1)*d+2] = tmp; // LR[3] = list("a",intvec(1: int(d*lV))) + LR[3]; // deg-ord, insert as the 1st // remove everything behind nb*(D+1)+1 ? // tmp = LR[3]; // LR[3] = tmp[1..size(tmp)-1]; } L[3] = LR[3]; attrib(L,"maxExp",1); attrib(L,"isLetterplaceRing",lV); def @R = ring(L); // setring @R; // int uptodeg = d; int lV = nvars(basering); // were defined before def @@R = setLetterplaceAttributes(@R,uptodeg,lV); return (@@R); } example { "EXAMPLE:"; echo = 2; ring r = 0,(x,y,z),(dp(1),dp(2)); def A = makeLetterplaceRing2(2); setring A; A; lpVarBlockSize(A); // number of variables in the main block lpDegBound(A); // degree bound } static proc makeLetterplaceRing4(int d) "USAGE: makeLetterplaceRing4(d); d an integer RETURN: ring PURPOSE: creates a Letterplace ring with a Dp ordering, suitable for @* the use of non-homogeneous letterplace NOTE: the matrix for the ordering looks as follows: first row is 1,1,...,1 EXAMPLE: example makeLetterplaceRing4; shows examples " { // ToDo future: inherit positive weights in the orig ring // complain on nonpositive ones // d = up to degree, will be shifted to d+1 if (d<1) {"bad d"; return(0);} int uptodeg = d; int lV = nvars(basering); int ppl = printlevel-voice+2; string err = ""; int i,j,s; def save = basering; int D = d-1; list LR = ringlist(save); list L, tmp, tmp2, tmp3; L[1] = LR[1]; // ground field L[4] = LR[4]; // quotient ideal tmp = LR[2]; // varnames s = size(LR[2]); for (i=1; i<=D; i++) { for (j=1; j<=s; j++) { tmp[i*s+j] =tmp[j]; } } L[2] = tmp; list OrigNames = LR[2]; s = size(LR[3]); list ordering; ordering[1] = list("Dp",intvec(1: int(d*lV))); ordering[2] = LR[3][s]; // module ord to place at the very end LR[3] = ordering; L[3] = LR[3]; attrib(L,"maxExp",1); attrib(L,"isLetterplaceRing",lV); def @R = ring(L); def @@R = setLetterplaceAttributes(@R,uptodeg,lV); return (@@R); } example { "EXAMPLE:"; echo = 2; ring r = 0,(x,y,z),(dp(1),dp(2)); def A = makeLetterplaceRing4(2); setring A; A; lpVarBlockSize(A); // number of variables in the main block lpDegBound(A); // degree bound } // P[s;sigma] approach static proc makeLetterplaceRing3(int d) "USAGE: makeLetterplaceRing3(d); d an integer RETURN: ring PURPOSE: creates a ring with a special ordering, representing @* the original P[s,sigma] (adds d blocks of shifted s) ASSUME: basering is a letterplace ring NOTE: experimental status EXAMPLE: example makeLetterplaceRing3; shows examples " { // d = up to degree, will be shifted to d+1 if (d<1) {"bad d"; return(0);} int uptodeg = d; int lV = nvars(basering); int ppl = printlevel-voice+2; string err = ""; int i,j,s; def save = basering; int D = d-1; list LR = ringlist(save); list L, tmp; L[1] = LR[1]; // ground field L[4] = LR[4]; // quotient ideal tmp = LR[2]; // varnames tmp[size(tmp)+1] = "s"; // add s's // string newSname = "@s"; s = size(LR[2]); for (i=1; i<=D; i++) { for (j=1; j<=s; j++) { tmp[i*s+j] = tmp[j]; } } // the final index is D*s+s = (D+1)*s = degBound*s L[2] = tmp; list OrigNames = LR[2]; // ordering: d blocks of the MODIFIED ord on r // try to get whether the ord on r is blockord itself // TODO: make L(2) ordering! exponent is maximally 2 s = size(LR[3]); // assume: basering was a letterplace, so get its block tmp = LR[3][1]; // ASSUME: it's a nice block // modify it // add (0,..,0,1) ... as antiblock part intvec iv; list ttmp, tmp1; for (i=1; i<=d; i++) { // the position to hold 1: iv = intvec( gen( i*(lV+1)-1 ) ); ttmp[1] = "a"; ttmp[2] = iv; tmp1[i] = ttmp; } // finished: antiblock part //TOCONTINUE if (s==2) { // not a blockord, 1 block + module ord tmp = LR[3][s]; // module ord for (i=1; i<=D; i++) { LR[3][s-1+i] = LR[3][1]; } LR[3][s+D] = tmp; } if (s>2) { // there are s-1 blocks int nb = s-1; tmp = LR[3][s]; // module ord for (i=1; i<=D; i++) { for (j=1; j<=nb; j++) { LR[3][i*nb+j] = LR[3][j]; } } // size(LR[3]); LR[3][nb*(D+1)+1] = tmp; } L[3] = LR[3]; attrib(L,"maxExp",1); attrib(L,"isLetterplaceRing",lV); def @R = ring(L); // setring @R; // int uptodeg = d; int lV = nvars(basering); // were defined before def @@R = setLetterplaceAttributes(@R,uptodeg,lV); return (@@R); } example { "EXAMPLE:"; echo = 2; ring r = 0,(x,y,z),(dp(1),dp(2)); def A = makeLetterplaceRing3(2); setring A; A; lpVarBlockSize(A); // number of variables in the main block lpDegBound(A); // degree bound } /* EXAMPLES: //static proc ex_shift() { LIB "freegb.lib"; ring r = 0,(x,y,z),(dp(1),dp(2)); module M = [-1,x,y],[-7,y,y],[3,x,x]; module N = [1,x,y,x],[-1,y,x,y]; list L; L[1] = M; L[2] = N; lst2str(L); def U = crs(L,5); setring U; U; I; poly p = I[2]; // I[8]; p; stest(p,7,7,3); // error -> the world is ok poly q1 = stest(p,1,7,3); //ok poly q6 = stest(p,6,7,3); //ok btest(p,3); //ok btest(q1,3); //ok btest(q6,3); //ok } //static proc test_shrink() { LIB "freegb.lib"; ring r =0,(x,y,z),dp; int d = 5; def R = freeAlgebra(r, d); setring R; poly p1 = x(1)*y(2)*z(3); poly p2 = x(1)*y(4)*z(5); poly p3 = x(1)*y(1)*z(3); poly p4 = x(1)*y(2)*z(2); poly p5 = x(3)*z(5); poly p6 = x(1)*y(1)*x(3)*z(5); poly p7 = x(1)*y(2)*x(3)*y(4)*z(5); poly p8 = p1+p2+p3+p4+p5 + p6 + p7; p1; system("shrinktest",p1,3); p2; system("shrinktest",p2,3); p3; system("shrinktest",p3,3); p4; system("shrinktest",p4,3); p5; system("shrinktest",p5,3); p6; system("shrinktest",p6,3); p7; system("shrinktest",p7,3); p8; system("shrinktest",p8,3); poly p9 = p1 + 2*p2 + 5*p5 + 7*p7; p9; system("shrinktest",p9,3); } //static proc ex2() { option(prot); LIB "freegb.lib"; ring r = 0,(x,y),dp; module M = [-1,x,y],[3,x,x]; // 3x^2 - xy def U = freegb(M,7); lst2str(U); } //static proc ex_nonhomog() { option(prot); LIB "freegb.lib"; ring r = 0,(x,y,h),dp; list L; module M; M = [-1,y,y],[1,x,x,x]; // x3-y2 L[1] = M; M = [1,x,h],[-1,h,x]; // xh-hx L[2] = M; M = [1,y,h],[-1,h,y]; // yh-hy L[3] = M; def U = freegb(L,4); lst2str(U); // strange elements in the basis } //static proc ex_nonhomog_comm() { option(prot); LIB "freegb.lib"; ring r = 0,(x,y),dp; module M = [-1,y,y],[1,x,x,x]; def U = freegb(M,5); lst2str(U); } //static proc ex_nonhomog_h() { option(prot); LIB "freegb.lib"; ring r = 0,(x,y,h),(a(1,1),dp); module M = [-1,y,y,h],[1,x,x,x]; // x3 - y2h def U = freegb(M,6); lst2str(U); } //static proc ex_nonhomog_h2() { option(prot); LIB "freegb.lib"; ring r = 0,(x,y,h),(dp); list L; module M; M = [-1,y,y,h],[1,x,x,x]; // x3 - y2h L[1] = M; M = [1,x,h],[-1,h,x]; // xh - hx L[2] = M; M = [1,y,h],[-1,h,y]; // yh - hy L[3] = M; def U = freeGBasis(L,3); lst2str(U); // strange answer CHECK } //static proc ex_nonhomog_3() { option(prot); LIB "./freegb.lib"; ring r = 0,(x,y,z),(dp); list L; module M; M = [1,z,y],[-1,x]; // zy - x L[1] = M; M = [1,z,x],[-1,y]; // zx - y L[2] = M; M = [1,y,x],[-1,z]; // yx - z L[3] = M; lst2str(L); list U = freegb(L,4); lst2str(U); // strange answer CHECK } //static proc ex_densep_2() { option(prot); LIB "freegb.lib"; ring r = (0,a,b,c),(x,y),(Dp); // deglex module M = [1,x,x], [a,x,y], [b,y,x], [c,y,y]; lst2str(M); list U = freegb(M,5); lst2str(U); // a=b is important -> finite basis!!! module M = [1,x,x], [a,x,y], [a,y,x], [c,y,y]; lst2str(M); list U = freegb(M,5); lst2str(U); } // END COMMENTED EXAMPLES */ // 1. form a new ring // 2. produce shifted generators // 3. compute GB // 4. skip shifted elts // 5. go back to orig vars, produce strings/modules // 6. return the result static proc freegbold(list LM, int d) "USAGE: freegbold(L, d); L a list of modules, d an integer RETURN: ring PURPOSE: compute the two-sided Groebner basis of an ideal, encoded by L in the free associative algebra, up to degree d EXAMPLE: example freegbold; shows examples " { // d = up to degree, will be shifted to d+1 if (d<1) {"bad d"; return(0);} int ppl = printlevel-voice+2; string err = ""; int i,j,s; def save = basering; // determine max no of places in the input int slm = size(LM); // numbers of polys in the ideal int sm; intvec iv; module M; for (i=1; i<=slm; i++) { // modules, e.g. free polynomials M = LM[i]; sm = ncols(M); for (j=1; j<=sm; j++) { //vectors, e.g. free monomials iv = iv, size(M[j])-1; // 1 place is reserved by the coeff } } int D = Max(iv); // max size of input words if (d2) { // there are s-1 blocks int nb = s-1; tmp = LR[3][s]; // module ord for (i=1; i<=D; i++) { for (j=1; j<=nb; j++) { LR[3][i*nb+j] = LR[3][j]; } } // size(LR[3]); LR[3][nb*(D+1)+1] = tmp; } L[3] = LR[3]; attrib(L,"maxExp",1); attrib(L,"isLetterplaceRing",s); def @R = ring(L); setring @R; ideal I; poly @p; s = size(OrigNames); // "s:";s; // convert LM to canonical vectors (no powers) setring save; kill M; // M was defined earlier module M; slm = size(LM); // numbers of polys in the ideal int sv,k,l; vector v; // poly p; string sp; setring @R; poly @@p=0; setring save; for (l=1; l<=slm; l++) { // modules, e.g. free polynomials M = LM[l]; sm = ncols(M); // in intvec iv the sizes are stored for (i=0; i<=d-iv[l]; i++) { // modules, e.g. free polynomials for (j=1; j<=sm; j++) { //vectors, e.g. free monomials v = M[j]; sv = size(v); // "sv:";sv; sp = "@@p = @@p + "; for (k=2; k<=sv; k++) { sp = sp + string(v[k])+")*"; } sp = sp + string(v[1])+";"; // coef; setring @R; execute(sp); setring save; } setring @R; // "@@p:"; @@p; I = I,@@p; @@p = 0; setring save; } } kill sp; // 3. compute GB setring @R; dbprint(ppl,"computing GB"); // ideal J = groebner(I); ideal J = slimgb(I); dbprint(ppl,J); // 4. skip shifted elts ideal K = select1(J,1..s); // s = size(OrigNames) dbprint(ppl,K); dbprint(ppl, "done with GB"); // K contains vars x(1),...z(1) = images of originals // 5. go back to orig vars, produce strings/modules if (K[1] == 0) { "no reasonable output, GB gives 0"; return(0); } int sk = size(K); int sp, sx, a, b; intvec x; poly p,q; poly pn; // vars in 'save' setring save; module N; list LN; vector V; poly pn; // test and skip exponents >=2 setring @R; for(i=1; i<=sk; i++) { p = K[i]; while (p!=0) { q = lead(p); // "processing q:";q; x = leadexp(q); sx = size(x); for(k=1; k<=sx; k++) { if ( x[k] >= 2 ) { err = "skip: the value x[k] is " + string(x[k]); dbprint(ppl,err); // return(0); K[i] = 0; p = 0; q = 0; break; } } p = p - q; } } K = simplify(K,2); sk = size(K); for(i=1; i<=sk; i++) { // setring save; // V = 0; setring @R; p = K[i]; while (p!=0) { q = lead(p); err = "processing q:" + string(q); dbprint(ppl,err); x = leadexp(q); sx = size(x); pn = leadcoef(q); setring save; pn = imap(@R,pn); V = V + leadcoef(pn)*gen(1); for(k=1; k<=sx; k++) { if (x[k] ==1) { a = k div s; // block number=a+1, a!=0 b = k % s; // remainder // printf("a: %s, b: %s",a,b); if (b == 0) { // that is it's the last var in the block b = s; a = a-1; } V = V + var(b)*gen(a+2); } // else // { // printf("error: the value x[k] is %s", x[k]); // return(0); // } } err = "V: " + string(V); dbprint(ppl,err); // printf("V: %s", string(V)); N = N,V; V = 0; setring @R; p = p - q; pn = 0; } setring save; LN[i] = simplify(N,2); N = 0; } setring save; return(LN); } example { "EXAMPLE:"; echo = 2; ring r = 0,(x,y,z),(dp(1),dp(2)); module M = [-1,x,y],[-7,y,y],[3,x,x]; module N = [1,x,y,x],[-1,y,x,y]; list L; L[1] = M; L[2] = N; lst2str(L); def U = freegbold(L,5); lst2str(U); } /* begin older procs and tests static proc exHom1() { // we start with // z*y - x, z*x - y, y*x - z LIB "freegb.lib"; LIB "elim.lib"; ring r = 0,(x,y,z,h),dp; list L; module M; M = [1,z,y],[-1,x,h]; // zy - xh L[1] = M; M = [1,z,x],[-1,y,h]; // zx - yh L[2] = M; M = [1,y,x],[-1,z,h]; // yx - zh L[3] = M; lst2str(L); def U = crs(L,4); setring U; I = I, y(2)*h(3)+z(2)*x(3), y(3)*h(4)+z(3)*x(4), y(2)*x(3)-z(2)*h(3), y(3)*x(4)-z(3)*h(4); I = simplify(I,2); ring r2 = 0,(x(0..4),y(0..4),z(0..4),h(0..4)),dp; ideal J = imap(U,I); // ideal K = homog(J,h); option(redSB); option(redTail); ideal L = groebner(J); //(K); ideal LL = sat(L,ideal(h)); ideal M = subst(LL,h,1); M = simplify(M,2); setring U; ideal M = imap(r2,M); lst2str(U); } static proc test1() { LIB "freegb.lib"; ring r = 0,(x,y),Dp; int d = 10; // degree def R = freeAlgebra(r, d); setring R; ideal I = x(1)*x(2) - y(1)*y(2); option(prot); option(teach); ideal J = system("freegb",I,d,2); J; } static proc test2() { LIB "freegb.lib"; ring r = 0,(x,y),Dp; int d = 10; // degree def R = freeAlgebra(r, d); setring R; ideal I = x(1)*x(2) - x(1)*y(2); option(prot); option(teach); ideal J = system("freegb",I,d,2); J; } static proc test3() { LIB "freegb.lib"; ring r = 0,(x,y,z),dp; int d =5; // degree def R = freeAlgebra(r, d); setring R; ideal I = x(1)*y(2), y(1)*x(2)+z(1)*z(2); option(prot); option(teach); ideal J = system("freegb",I,d,3); } end older procs and tests */ static proc stringpoly2lplace(string s) { // decomposes sentence into terms s = replace(s,newline,""); // get rid of newlines s = replace(s," ",""); // get rid of empties //arith symbols: +,- // decompose into words with coeffs list LS; int i,j,ie,je,k,cnt; // s[1]="-" situation if (s[1]=="-") { LS = stringpoly2lplace(string(s[2..size(s)])); LS[1] = string("-"+string(LS[1])); return(LS); } i = find(s,"-",2); // i==1 might happen if the 1st symbol coeff is negative j = find(s,"+"); list LL; if (i==j) { "return a monomial"; // that is both are 0 -> s is a monomial LS[1] = s; return(LS); } if (i==0) { "i==0 situation"; // no minuses at all => pluses only cnt++; LS[cnt] = string(s[1..j-1]); s = s[j+1..size(s)]; while (s!= "") { j = find(s,"+"); cnt++; if (j==0) { LS[cnt] = string(s); s = ""; } else { LS[cnt] = string(s[1..j-1]); s = s[j+1..size(s)]; } } return(LS); } if (j==0) { "j==0 situation"; // no pluses at all except the lead coef => the rest are minuses only cnt++; LS[cnt] = string(s[1..i-1]); s = s[i..size(s)]; while (s!= "") { i = find(s,"-",2); cnt++; if (i==0) { LS[cnt] = string(s); s = ""; } else { LS[cnt] = string(s[1..i-1]); s = s[i..size(s)]; } } return(LS); } // now i, j are nonzero if (i>j) { "i>j situation"; // + comes first, at place j cnt++; // "cnt:"; cnt; "j:"; j; LS[cnt] = string(s[1..j-1]); s = s[j+1..size(s)]; LL = stringpoly2lplace(s); LS = LS + LL; kill LL; return(LS); } else { "j>i situation"; // - might come first, at place i if (i>1) { cnt++; LS[cnt] = string(s[1..i-1]); s = s[i..size(s)]; } else { // i==1-> minus at leadcoef ie = find(s,"-",i+1); je = find(s,"+",i+1); if (je == ie) { "ie=je situation"; //monomial cnt++; LS[cnt] = s; return(LS); } if (je < ie) { "jetstnum.out"; k = system("sh",t); if (k!=0) { ERROR("Problems running Singular"); } int i = system("sh", "grep error tstnum.out > /dev/NULL"); if (i!=0) { // no error: s is a number i = 1; } k = system("sh","rm tstnum.tst tstnum.out > /dev/NULL"); return(i); } example { "EXAMPLE:"; echo = 2; ring r = (0,a),x,dp; string s = "a^2+7*a-2"; testnumber(s); s = "b+a"; testnumber(s); } static proc str2lplace(string s) { // converts a word (monomial) with coeff into letter-place // string: coef*var1^exp1*var2^exp2*...varN^expN s = strpower2rep(s); // expand powers if (size(s)==0) { return(0); } int i,j,k,insC; string a,b,c,d,t; // 1. get coeff i = find(s,"*"); if (i==0) { return(s); } list VN; c = s[1..i-1]; // incl. the case like (-a^2+1) int tn = testnumber(c); if (tn == 0) { // failed test if (c[1]=="-") { // two situations: either there's a negative number t = c[2..size(c)]; if (testnumber(t)) { //a negative number // nop here } else { // a variable times -1 c = "-1"; j++; VN[j] = t; //string(c[2..size(c)]); insC = 1; } } else { // just a variable with coeff 1 j++; VN[j] = string(c); c = "1"; insC = 1; } } // get vars t = s; // t = s[i+1..size(s)]; k = size(t); //j = 0; while (k>0) { t = t[i+1..size(t)]; //next part i = find(t,"*"); // next * if (i==0) { // last monomial j++; VN[j] = t; k = size(t); break; } b = t[1..i-1]; // print(b); j++; VN[j] = b; k = size(t); } VN = addplaces(VN); VN[size(VN)+1] = string(c); return(VN); } example { "EXAMPLE:"; echo = 2; ring r = (0,a),(f2,f1),dp; str2lplace("-2*f2^2*f1^2*f2"); str2lplace("-f1*f2"); str2lplace("(-a^2+7a)*f1*f2"); } static proc strpower2rep(string s) { // makes x*x*x*x out of x^4 ., rep statys for repetitions // looks for "-" problem // exception: "-" as coeff string ex,t; int i,j,k; i = find(s,"^"); // first ^ if (i==0) { return(s); } // no ^ signs if (s[1] == "-") { // either -coef or -1 // got the coeff: i = find(s,"*"); if (i==0) { // no *'s => coef == -1 or s == -23 i = size(s)+1; } t = string(s[2..i-1]); // without "-" if ( testnumber(t) ) { // a good number t = strpower2rep(string(s[2..size(s)])); t = "-"+t; return(t); } else { // a variable t = strpower2rep(string(s[2..size(s)])); t = "-1*"+ t; return(t); } } // the case when leadcoef is a number in () if (s[1] == "(") { i = find(s,")",2); // must be nonzero t = s[2..i-1]; if ( testnumber(t) ) { // a good number } else {"strpower2rep: bad number as coef";} ex = string(s[i+2..size(s)]); // 2 because of * ex = strpower2rep(ex); t = "("+t+")*"+ex; return(t); } i = find(s,"^"); // first ^ j = find(s,"*",i+1); // next * == end of ^ if (j==0) { ex = s[i+1..size(s)]; } else { ex = s[i+1..j-1]; } execute("int @exp = " + ex + ";"); //@exp = exponent // got varname for (k=i-1; k>0; k--) { if (s[k] == "*") break; } string varn = s[k+1..i-1]; // "varn:"; varn; string pref; if (k>0) { pref = s[1..k]; // with * on the k-th place } // "pref:"; pref; string suf; if ( (j>0) && (j+1 <= size(s)) ) { suf = s[j+1..size(s)]; // without * on the 1st place } // "suf:"; suf; string toins; for (k=1; k<=@exp; k++) { toins = toins + varn+"*"; } // "toins: "; toins; if (size(suf) == 0) { toins = toins[1..size(toins)-1]; // get rid of trailing * } else { suf = strpower2rep(suf); } ex = pref + toins + suf; return(ex); // return(strpower2rep(ex)); } example { "EXAMPLE:"; echo = 2; ring r = (0,a),(x,y,z,t),dp; strpower2rep("-x^4"); strpower2rep("-2*x^4*y^3*z*t^2"); strpower2rep("-a^2*x^4"); } static proc shiftPoly(poly a, int i) "USAGE: shiftPoly(p,i); p letterplace poly, i int RETURN: poly ASSUME: basering has letterplace ring structure PURPOSE: compute the i-th shift of letterplace polynomial p EXAMPLE: example shiftPoly; shows examples " { // shifts a monomial a by i // calls pLPshift(p,sh,uptodeg,lVblock); if (lpAssumeViolation()) { ERROR("Incomplete Letterplace structure on the basering!"); } return(stest(a,i)); } example { "EXAMPLE:"; echo = 2; ring r = 0,(x,y,z),dp; int uptodeg = 5; int lV = 3; def R = freeAlgebra(r, uptodeg); setring R; poly f = x*z*y - 2*z*y + 3*x; shiftPoly(f,1); shiftPoly(f,2); } static proc lastBlock(poly p) "USAGE: lastBlock(p); p letterplace poly RETURN: int ASSUME: basering has letterplace ring structure PURPOSE: get the number of the last block occurring in the poly EXAMPLE: example lastBlock; shows examples " { if (lpAssumeViolation()) { ERROR("Incomplete Letterplace structure on the basering!"); } // calls pLastVblock(p); return(btest(p)); } example { "EXAMPLE:"; echo = 2; ring r = 0,(x,y,z),dp; int uptodeg = 5; def R = freeAlgebra(r, uptodeg); setring R; poly f = x*z*y - 2*z*y + 3*x; lastBlock(f); // should be 3 } static proc test_shift() { LIB "freegb.lib"; ring r = 0,(a,b),dp; int d =5; def R = freeAlgebra(r, d); setring R; int uptodeg = d; int lV = 2; def R = setLetterplaceAttributes(r,uptodeg,2); // supply R with letterplace structure setring R; poly p = mmLiebr(a,b); poly p = lieBracket(a,b); } proc lp2lstr(ideal K, def save) "USAGE: lp2lstr(K,s); K an ideal, s a ring name RETURN: nothing (exports object @LN into the ring named s) ASSUME: basering has a letterplace ring structure PURPOSE: converts letterplace ideal to list of modules NOTE: useful as preprocessing to 'lst2str' EXAMPLE: example lp2lstr; shows examples " { def @R = basering; string err; int s = nvars(save); int i,j,k; // K contains vars x(1),...z(1) = images of originals // 5. go back to orig vars, produce strings/modules int sk = size(K); int sp, sx, a, b; intvec x; poly p,q; poly pn; // vars in 'save' setring save; module N; list LN; vector V; poly pn; // test and skip exponents >=2 setring @R; for(i=1; i<=sk; i++) { p = K[i]; while (p!=0) { q = lead(p); // "processing q:";q; x = leadexp(q); sx = size(x); for(k=1; k<=sx; k++) { if ( x[k] >= 2 ) { err = "skip: the value x[k] is " + string(x[k]); dbprint(ppl,err); // return(0); K[i] = 0; p = 0; q = 0; break; } } p = p - q; } } K = simplify(K,2); sk = size(K); for(i=1; i<=sk; i++) { // setring save; // V = 0; setring @R; p = K[i]; while (p!=0) { q = lead(p); err = "processing q:" + string(q); dbprint(ppl,err); x = leadexp(q); sx = size(x); pn = leadcoef(q); setring save; pn = imap(@R,pn); V = V + leadcoef(pn)*gen(1); for(k=1; k<=sx; k++) { if (x[k] ==1) { a = k div s; // block number=a+1, a!=0 b = k % s; // remainder // printf("a: %s, b: %s",a,b); if (b == 0) { // that is it's the last var in the block b = s; a = a-1; } V = V + var(b)*gen(a+2); } } err = "V: " + string(V); dbprint(ppl,err); // printf("V: %s", string(V)); N = N,V; V = 0; setring @R; p = p - q; pn = 0; } setring save; LN[i] = simplify(N,2); N = 0; } setring save; list @LN = LN; export @LN; // return(LN); } example { "EXAMPLE:"; echo = 2; intmat A[2][2] = 2, -1, -1, 2; // sl_3 == A_2 ring r = 0,(f1,f2),dp; def R = freeAlgebra(r, 3); setring R; ideal I = serreRelations(A,1); lp2lstr(I,r); setring r; lst2str(@LN,1); } static proc strList2poly(list L) { // list L comes from sent2lplace (which takes a polynomial as input) // each entry of L is a sublist with the coef on the last place int s = size(L); int t; int i,j; list M; poly p,q; string Q; for(i=1; i<=s; i++) { M = L[i]; t = size(M); // q = M[t]; // a constant Q = string(M[t]); for(j=1; j deg(_,w) for the length // // shrink the result => don't need to decompose polys // // since the shift is big enough // // // indeed it's better to have that // // ASSUME: both f and g are quasi-homogeneous // // if (lpAssumeViolation()) // { // ERROR("Incomplete Letterplace structure on the basering!"); // } // intvec w = 1:nvars(basering); // int sf = deg(f,w); // VL Oct 2010: we need rather length than degree // int sg = deg(g,w); // esp. in the case of weighted ordering // int uptodeg = attrib(basering, "uptodeg"); // if (sf+sg > uptodeg) // { // ERROR("degree bound violated by the product!"); // } // // if (sf>1) { sf = sf -1; } // poly v = f*shiftPoly(g,sf); // // bug, reported by Simon King: in nonhomog case [solved] // // we need to shrink // return( system("shrinktest",v,attrib(basering, "isLetterplaceRing")) ); // } // example // { // "EXAMPLE:"; echo = 2; // // define a ring in letterplace form as follows: // ring r = 0,(x(1),y(1),x(2),y(2),x(3),y(3),x(4),y(4)),dp; // def R = setLetterplaceAttributes(r,4,2); // supply R with letterplace structure // setring R; // poly a = x(1)*y(2)+x(1)+y(1); poly b = y(1)+3; // lpMult(b,a); // lpMult(a,b); // } static proc lpPower(poly f, int n) "USAGE: lpPower(f,n); f letterplace polynomial, int n RETURN: poly ASSUME: basering has a letterplace ring structure PURPOSE: compute the letterplace form of f^n EXAMPLE: example lpPower; shows examples " { if (n<0) { ERROR("the power must be a natural number!"); } if (n==0) { return(poly(1)); } if (n==1) { return(f); } poly p = 1; for(int i = 1; i <= n; i++) { p = p*f; } return(p); } example { "EXAMPLE:"; echo = 2; // define a ring in letterplace form as follows: ring r = 0,(x,y),dp; def R = freeAlgebra(r, 4,2); // supply R with letterplace structure setring R; poly a = x*y + y; poly b = y - 1; lpPower(a,2); lpPower(b,4); } //Main normal form procedure for the user // TODO Oct 18: replace by legacy call to the kernel function proc lpNF(poly p, ideal G) "USAGE: lpNF(p,G); poly p, ideal G (deprecated in favor of reduce(). will be removed soon) RETURN: poly PURPOSE: computation of the normal form of p with respect to G ASSUME: p is a Letterplace polynomial, G is a set Letterplace polynomials, being a Letterplace Groebner basis (no check for this will be done) NOTE: Strategy: take the smallest monomial wrt ordering for reduction - For homogeneous ideals the shift does not matter - For non-homogenous ideals the first shift will be the smallest monomial EXAMPLE: example lpNF; shows examples " {if ((p==0) || (size(G) == 0)){return(p);} checkAssumptions(p,G); G = sort(G)[1]; list L = makeDVecI(G); return(lpNormalForm2(p,G,L)); } example { "EXAMPLE:"; echo = 2; ring r = 0,(x,y),dp; def R = freeAlgebra(r, 4); setring R; ideal I = x*x + y*y - 1; // 2D sphere ideal J = letplaceGBasis(I); // compute a Letterplace Groebner basis J; // it is finite and nice poly f = lieBracket(x,y); f; lpNF(f,J); poly g = lieBracket(x,y*y); g; lpNF(g,J); } /* old and more complicated example { "EXAMPLE:"; echo = 2; ring r = 0,(x,y,z),dp; int d = 5; // degree ring R = freeAlgebra(r, d); ideal I = y*x*y - z*y*z, x*y*x - z*x*y, z*x*z - y*z*x, x*x*x + y*y*y + z*z*z + x*y*z; ideal J = letplaceGBasis(I); // compute a Letterplace Groebner basis poly p = y*x*y*z*y - y*z*z*y + z*y*z; poly q = z*x*z*y*z - y*z*x*y*z; lpNF(p,J); lpNF(q,J); } */ // analog of division(); but the output HAS different structure proc lpDivision(poly p, ideal I) "USAGE: lpDivision(p,G); poly p, ideal G PURPOSE: compute a two-sided division with remainder of p wrt G; two-sided noncommutative analogue of the procedure division ASSUME: G = {g1,...,gN} is a Groebner basis, the original ring of the Letterplace ring has the name 'r' and no variable is called 'tag_i' for i in 1...N RETURN: list L NOTE: - L[1] is NF(p,I) - L[2] is the list of expressions [i,l_(ij),r_(ij)] with \sum_(i,j) l_(ij) g_i r_(ij) = p - NF(p,I) - procedure lpGBPres2Poly, applied to L, reconstructs p EXAMPLE: example lpDivision; shows examples " { if (p == 0 || size(I) == 0) { list L = 0; list empty; L[2] = empty; return (L); } //poly pNF = lpNF(p,I); poly pNF = reduce(p,I); p = p - pNF; // make new ring def save = basering; int norigvars = lpVarBlockSize(save); def Rtagged; def temp = save; for (int i = 1; i <= size(I); i++) { Rtagged = temp + ("tag_" + string(i)); temp = Rtagged; } kill i; // currently R + "var" doesn't preserve uptodeg Rtagged = setLetterplaceAttributes(Rtagged, lpVarBlockSize(Rtagged), lpDegBound(save)); setring Rtagged; // restore vars poly p = imap(save, p); poly pNF = imap(save, pNF); ideal I = imap(save, I); for (int i = 1; i <= size(I); i++) { I[i] = I[i] - var(norigvars + i); } kill i; list summands; list L = pNF; poly pTaggedNF = lpNF(p,I); for (int i = 1; i <= size(pTaggedNF); i++) { intvec iv = lp2iv(pTaggedNF[i]); for (int j = 1; j <= size(iv); j++) { if (iv[j] > norigvars) { intvec left; intvec right; if (j > 1) { left = iv[1..(j-1)]; } if (j < size(iv)) { right = iv[(j+1)..size(iv)]; } list summand = (iv[j] - norigvars), leadcoef(pTaggedNF[i])*iv2lp(left), iv2lp(right); summands = insert(summands, summand, size(summands)); kill left; kill right; kill summand; break; } } kill j; kill iv; } kill i; L[2] = summands; setring save; list L = imap(Rtagged,L); return (L); } example { "EXAMPLE:"; echo = 2; ring r = 0,(x,y),dp; ring R = freeAlgebra(r, 4); ideal I = x*x + y*y - 1; // 2D sphere ideal J = twostd(I); // compute a two-sided Groebner basis J; // it is finite and nice poly h = x*x*y-y*x*x+x*y; list L = lpDivision(h,J); L; // what means that the NF of h wrt J is x*y h - lpNF(h,J); // and this poly has the following two-sided Groebner presentation: -y*J[1] + J[1]*y; lpGBPres2Poly(L,J); // reconstructs the above automatically } proc lpGBPres2Poly(list L, ideal I) "USAGE: lpGBPres2Poly(p,G); poly p, ideal G ASSUME: L is a valid Groebner presentation like the result of lpDivision RETURN: poly NOTE: assembles p = \sum_(i,j) l_(ij) g_i r_(ij) + NF(p,I) = \sum_(i) L[2][i][2] I[L[2][i][1]] L[2][i][3] + L[1] EXAMPLE: example lpGBPres2Poly; shows examples " { poly p; for (int i = 1; i <= size(L[2]); i++) { p = p + L[2][i][2] * I[L[2][i][1]] * L[2][i][3]; } p = p + L[1]; return (p); } example { "EXAMPLE:"; echo = 2; ring r = 0,(x,y),dp; ring R = freeAlgebra(r, 4); ideal I = x*x + y*y - 1; // 2D sphere ideal J = twostd(I); // compute a two-sided Groebner basis J; // it is finite and nice poly h = x*x*y-y*x*x+x*y; list L = lpDivision(h,J); L[1]; // what means that the normal form (or the remainder) of h wrt J is x*y lpGBPres2Poly(L,J); // we see, that it is equal to h from above } //procedures to convert monomials into the DVec representation, all static //////////////////////////////////////////////////////// static proc getExpVecs(ideal G) "USAGE: getExpVecs(G); RETURN: list of intvecs PURPOSE: convert G into a list of intvecs, corresponding to the exponent vector of the leading monomials of G " {int i; list L; for (i = 1; i <= size(G); i++) {L[i] = leadexp(G[i]); } return(L); } static proc delSupZero(intvec I) "USAGE:delSupZero(I); RETURN: intvec PURPOSE: Deletes superfluous zero blocks of an exponent vector ASSUME: Intvec is an exponent vector of a letterplace monomial contained in V' " {if (I==intvec(0)) {return(intvec(0));} int j,k,l; int n = lpVarBlockSize(basering); int d = lpDegBound(basering); intvec w; j = 1; while (j <= d) {w = I[1..n]; if (w<>intvec(0)){break;} else {I = I[(n+1)..(n*d)]; d = d-1; j++;} } for (j = 1; j <= d; j++) {l=(j-1)*n+1; k= j*n; w = I[l..k]; if (w==intvec(0)){w = I[1..(l-1)]; return(w);}//if a zero block is found there are only zero blocks left, //otherwise there would be a hole in the monomial // shrink should take care that this will not happen } return(I); } static proc delSupZeroList(list L) "USAGE:delSupZeroList(L); L a list, containing intvecs RETURN: list, containing intvecs PURPOSE: Deletes all superfluous zero blocks for a list of exponent vectors ASSUME: All intvecs are exponent vectors of letterplace monomials contained in V' " {int i; for (i = size(L); 0 < i; i--){L[i] = delSupZero(L[i]);} return(L); } static proc makeDVec(intvec V) "USAGE:makeDVec(V); RETURN: intvec PURPOSE: Converts an modified exponent vector into an Dvec NOTE: Superfluous zero blocks must have been deleted before using this procedure " {int i,j,k,r1,r2; intvec D; int n = lpVarBlockSize(basering); k = size(V) div n; r1 = 0; r2 = 0; for (i=1; i<= k; i++) {for (j=(1+((i-1)*n)); j <= (i*n); j++) {if (V[j]>0){r2 = j - ((i-1)*n); j = (j mod n); break;} } D[size(D)+1] = r1+r2; if (j == 0) {r1 = 0;} else{r1= n-j;} } D = D[2..size(D)]; return(D); } static proc makeDVecL(list L) "USAGE:makeDVecL(L); L, a list containing intvecs RETURN: list, containing intvecs ASSUME: " {int i; list R; for (i=1; i <= size(L); i++) {R[i] = makeDVec(L[i]);} return(R); } static proc makeDVecI(ideal G) "USAGE:makeDVecI(G); RETURN:list, containing intvecs PURPOSE:computing the DVec representation for lead(G) ASSUME: " {list L = delSupZeroList(getExpVecs(G)); return(makeDVecL(L)); } //procedures, which are dealing with the DVec representation, all static static proc dShiftDiv(intvec V, intvec W) "USAGE: dShiftDiv(V,W); RETURN: a list,containing integers, or -1, if no shift of W divides V PURPOSE: find all possible shifts s, such that s.W|V ASSUME: V,W are DVecs of monomials contained in V' " {if(size(V)1) {T[2..size(W)] = V[(i+1)..(size(W)+i-1)];} if (T-W == 0) {R[size(R)+1] = i-1;} } if (size(R)>0) {return(R);} else {return(list(-1));} } //the first normal form procedure, if a user want not to presort the ideal, just make it not static static proc lpNormalForm1(poly p, ideal G, list L) "USAGE:lpNormalForm1(p,G); RETURN:poly PURPOSE:computation of the normalform of p w.r.t. G ASSUME: p is a Letterplace polynomial, G is a set of Letterplace polynomials NOTE: Taking the first possible reduction " { if (deg(p) <1) {return(p);} else { int i; int s; intvec V = makeDVec(delSupZero(leadexp(p))); for (i = 1; i <= size(L); i++) {s = dShiftDiv(V, L[i])[1]; if (s <> -1) {p = lpReduce(p,G[i],s); p = lpNormalForm1(p,G,L); break; } } p = p[1] + lpNormalForm1(p-p[1],G,L); return(p); } } // VL; called from lpNF static proc lpNormalForm2(poly pp, ideal G, list L) "USAGE:lpNormalForm2(p,G); RETURN:poly PURPOSE:computation of the normal form of p w.r.t. G ASSUME: p is a Letterplace polynomial, G is a set of Letterplace polynomials NOTE: Taking the first possible reduction " { poly one = 1; if ( (pp == 0) || (leadmonom(pp) == one) ) { return(pp); } poly p = pp; poly q; int i; int s; intvec V; while ( (p != 0) && (leadmonom(p) != one) ) { //"entered while with p="; p; V = makeDVec(delSupZero(leadexp(p))); i = 0; s = -1; //"look for divisor"; while ( (s == -1) && (i no reduction // otherwise: i<=size(L) and s!= -1 => reduction //"out of divisor search: s="; s; "i="; i; if (s != -1) { //"start reducing with G[i]:"; p = lpReduce(p,G[i],s); // lm-reduction //"reduced to p="; p; } else { // ie no lm-reduction possible; proceed with the tail reduction q = p-lead(p); p = lead(p); if (q!=0) { p = p + lpNormalForm2(q,G,L); } return(p); } } // out of while when p==0 or p == const return(p); } proc isOrderingShiftInvariant(int withHoles) "USAGE: isOrderingShiftInvariant(b); b an integer interpreted as a boolean RETURN: int NOTE: Tests whether the ordering of the current ring is shift invariant, which is the case, when LM(p) > LM(p') for all p and p' where p' is p shifted by any number of places. If withHoles != 0 even Letterplace polynomials with holes (eg. x(1)*y(4)) are considered. ASSUME: - basering is a Letterplace ring. " { int shiftInvariant = 1; int d = lpDegBound(basering); ideal monomials; if (withHoles) { monomials = delete(lpMonomialsWithHoles(d-1), 1); // ignore the first element (1) } else { monomials = maxideal(1); for (int i = 2; i <= d-1; i++) { monomials = monomials, maxideal(i); } kill i; } for (int i = 1; i <= size(monomials); i++) { poly monom = monomials[i]; int lastblock = lastBlock(monom); for (int s = 1; s <= d - lastblock; s++) { for (int s2 = 0; s2 < s; s2++) { // paranoid, check every pair poly first = shiftPoly(monom,s2); poly second = shiftPoly(monom,s); if (!(first > second)) { if (printlevel >= voice) { // otherwise string() is always evaluated dbprint(string(first) + " <= " + string(second)); } shiftInvariant = 0; } kill first; kill second; } kill s2; } kill s; kill monom; kill lastblock; } kill i; return(shiftInvariant); } example { "EXAMPLE:"; echo = 2; ring r = 0,(x,y,z),dp; def R = freeAlgebra(r, 5); setring R; isOrderingShiftInvariant(0);// should be 1 ring r2 = 0,(x,y,z),dp; def R2 = freeAlgebra(r2, 5); list RL = ringlist(R2); RL[3][1][1] = "wp"; intvec weights = 1,1,1,1,1,1,1,2,3,1,1,1,1,1,1; RL[3][1][2] = weights; attrib(RL,"isLetterplaceRing",3); attrib(RL,"maxExp",1); def Rw = setLetterplaceAttributes(ring(RL),5,3); setring Rw; /* printlevel = voice + 1; */ isOrderingShiftInvariant(0); isOrderingShiftInvariant(1); } static proc lpMonomialsWithHoles(int d) { if (d < 0) { ERROR("d must not be negative") } ideal monomials = 1; if (d == 0) { return (monomials); } int lV = lpVarBlockSize(basering); // variable count ideal prevMonomials = lpMonomialsWithHoles(d - 1); for (int i = 1; i <= size(prevMonomials); i++) { /* if (deg(prevMonomials[i]) >= d - 1) { */ for (int j = 1; j <= lV; j++) { poly m = prevMonomials[i]; m = m * var(j + (d-1)*lV); monomials = monomials, m; kill m; } kill j; /* } */ } kill i; if (d > 1) { // removes the 1 monomials[1] = 0; monomials = simplify(monomials,2); monomials = prevMonomials, monomials; } return (monomials); } static proc getlpCoeffs(poly q, poly p) {list R; intvec cq,t,lv,rv,bla; int n = lpVarBlockSize(basering); int d = lpDegBound(basering); int i; cq = leadexp(p)-leadexp(q); /* p/q */ for (i = 1; i<= d; i++) {bla = cq[((i-1)*n+1)..(i*n)]; if (bla == 0) {lv = cq[1..i*n]; cq = cq[(i*n+1)..(d*n)]; break;} } d = size(cq) div n; for (i = 1; i<= d; i++) {bla = cq[((i-1)*n+1)..(i*n)]; if (bla <> 0){rv = cq[((i-1)*n+1)..(d*n)]; break;} } return(list(monomial(lv),monomial(rv))); } static proc lpReduce(poly p, poly g, int s) "NOTE: shift can not exceed the degree bound, because s*g | p " {poly l,r,qt; int i; list K = getlpCoeffs(lead(shiftPoly(g,s)), lead(p)); l = K[1]; r = K[2]; kill K; for (i = 1; i <= size(g); i++) { qt = qt + l*g[i]*r; } return(p - leadcoef(p)*normalize(qt)); } static proc entryViolation(intmat M, int n) "PURPOSE:checks, if all entries in M are variable-related " {int i,j; for (i = 1; i <= nrows(M); i++) {for (j = 1; j <= ncols(M); j++) {if(!((1<=M[i,j])&&(M[i,j]<=n))) {return(1);}} } return(0); } static proc checkAssumptionsLPIV(int d, list L) "PURPOSE: Checks, if all the Assumptions are holding " {if (!isFreeAlgebra(basering)) {ERROR("Basering is not a Letterplace ring!");} if (d > lpDegBound(basering)) {ERROR("Specified degree bound exceeds ring parameter!");} int i; for (i = 1; i <= size(L); i++) {if (entryViolation(L[i], lpVarBlockSize(basering))) {ERROR("Not allowed monomial/intvec found!");} } return(); } static proc checkAssumptions(poly p, ideal G) " " {checkLPRing(); checkAssumptionPoly(p); checkAssumptionIdeal(G); return(); } static proc checkLPRing(); " " {if (!isFreeAlgebra(basering)) {ERROR("Basering is not a Letterplace ring!");} return(); } static proc checkAssumptionIdeal(ideal G) "PURPOSE:Check if all elements of ideal are elements of V' " {ideal L = lead(normalize(G)); int i; for (i = 1; i <= ncols(G); i++) {if (!isContainedInVp(G[i])) {ERROR("Ideal contains elements not contained in V'");}} return(); } static proc checkAssumptionPoly(poly p) "PURPOSE:Check if p is an element of V' " {poly l = lead(normalize(p)); if (!isContainedInVp(l)) {ERROR("Polynomial is not contained in V'");} return(); } static proc isContainedInVp(poly p) "PURPOSE: Check monomial for holes in the places " {int r = 0; intvec w; intvec l = leadexp(p); int n = lpVarBlockSize(basering); int d = lpDegBound(basering); int i,j,c,c1; while (1 <= d) { w = l[1..n]; if (w<>(0:n)) {break;} else { if (size(w)==size(l)) break; l = l[(n+1)..(n*d)]; d = d-1; } } while (1 <= d) {for (j = 1; j <= n; j++) {if (l[j]<>0) {if (c1<>0){return(0);} if (c<>0){return(0);} if (l[j]<>1){return(0);} c=1; } } if (c == 0){c1=1;if (1 < d){l = l[(n+1)..(n*d)]; d = d-1;} else {d = d -1;}} else {c = 0; if (1 < d){l = l[(n+1)..(n*d)]; d = d-1;} else {d = d -1;}} } return(1); } static proc extractLinearPart(module M) { /* returns vectors from a module whose max leadexp is 1 */ /* does not take nonlinearity into account yet */ /* use rather kernel function isinV to get really nonlinear things */ int i; int s = ncols(M); int answer = 1; vector v; module Ret; for(i=1; i<=s; i++) { if ( isLinearVector(M[i]) ) { Ret = Ret, M[i]; } } Ret = simplify(Ret,2); return(Ret); } static proc isLinearVector(vector v) { /* vector v consists of polynomials */ /* returns true iff max leadexp is 1 */ int i,j,k; intvec w; int s = size(v); poly p; int answer = 1; for(i=1; i<=s; i++) { p = v[i]; while (p != 0) { w = leadexp(p); j = Max(w); if (j >=2) { answer = 0; return(answer); } p = p-lead(p); } } return(answer); } // // the following is to determine a shift of a mono/poly from the // // interface // static proc whichshift(poly p, int numvars) // { // // numvars = number of vars of the orig free algebra // // assume: we are in the letterplace ring // // takes monomial on the input // poly q = lead(p); // intvec v = leadexp(v); // if (v==0) { return(int(0)); } // int sv = size(v); // int i=1; // while ( (v[i]==0) && (i lpDegBound(basering)) {ERROR("polynomial exceeds degreebound");} int j; poly p = 1; for (j = 1; j <= i; j++) {if (I[j] > 0) { p = p*var(I[j]);}} //ignore zeroes, because they correspond to 1 return(p); } example { "EXAMPLE:"; echo = 2; ring r = 0,(x,y,z),dp; def R = freeAlgebra(r, 5); // constructs a Letterplace ring setring R; //sets basering to Letterplace ring // u = x^2y, v = yxz, w = zx^2 in intvec representation intvec u = 1,1,2; iv2lp(u); // invokes the procedure and returns the corresponding poly intvec v = 2,1,3; iv2lp(v); intvec w = 3,1,1; iv2lp(w); } proc iv2lpList(list L) "USAGE: iv2lpList(L); L a list of intmats (deprecated, will be removed soon) RETURN: ideal PURPOSE:Converting a list of intmats into an ideal of corresponding monomials ASSUME: - The rows of each intmat in L must correspond to a Letterplace monomial @* - basering has to be a Letterplace ring EXAMPLE: example iv2lpList; shows examples " {checkAssumptionsLPIV(0,L); ideal G; int i; for (i = 1; i <= size(L); i++){G = G + iv2lpMat(L[i]);} return(G); } example { "EXAMPLE:"; echo = 2; ring r = 0,(x,y,z),dp; def R = freeAlgebra(r, 5); // constructs a Letterplace ring setring R; // sets basering to Letterplace ring intmat u[3][1] = 1,1,2; intmat v[1][3] = 2,1,3; intmat w[2][3] = 3,1,1,2,3,1; // defines intmats of different size containing intvec representations of // monomials as rows list L = u,v,w; print(u); print(v); print(w); // shows the intmats contained in L iv2lpList(L); // returns the corresponding monomials as an ideal } proc iv2lpMat(intmat M) "USAGE: iv2lpMat(M); M an intmat (deprecated, will be removed soon) RETURN: ideal PURPOSE:Converting an intmat into an ideal of the corresponding monomials ASSUME: - The rows of M must correspond to Letterplace monomials @* - basering has to be a Letterplace ring EXAMPLE: example iv2lpMat; shows examples " {list L = M; checkAssumptionsLPIV(0,L); kill L; ideal G; poly p; int i; intvec I; for (i = 1; i <= nrows(M); i++) { I = M[i,1..ncols(M)]; p = iv2lp(I); G[size(G)+1] = p; } return(G); } example { "EXAMPLE:"; echo = 2; ring r = 0,(x,y,z),dp; def R = freeAlgebra(r, 5); // constructs a Letterplace ring setring R; // sets basering to Letterplace ring intmat u[3][1] = 1,1,2; intmat v[1][3] = 2,1,3; intmat w[2][3] = 3,1,1,2,3,1; // defines intmats of different size containing intvec representations of // monomials as rows iv2lpMat(u); // returns the monomials contained in u iv2lpMat(v); // returns the monomials contained in v iv2lpMat(w); // returns the monomials contained in w } proc lpId2ivLi(ideal G) "USAGE: lpId2ivLi(G); G an ideal (deprecated, will be removed soon) RETURN: list PURPOSE:Transforming an ideal into the corresponding list of intvecs ASSUME: - basering has to be a Letterplace ring EXAMPLE: example lpId2ivLi; shows examples " { int i,j,k; list M; checkAssumptionsLPIV(0,M); for (i = 1; i <= size(G); i++) {M[i] = lp2iv(G[i]);} return(M); } example { "EXAMPLE:"; echo = 2; ring r = 0,(x,y),dp; def R = freeAlgebra(r, 5); // constructs a Letterplace ring setring R; // sets basering to Letterplace ring ideal L = x*x,y*y,x*y*x; lpId2ivLi(L); // returns the corresponding intvecs as a list } proc lp2iv(poly p) "USAGE: lp2iv(p); p a poly (deprecated, will be removed soon) RETURN: intvec PURPOSE: Transforming a monomial into the corresponding intvec ASSUME: - basering has to be a Letterplace ring NOTE: - Assumptions will not be checked! EXAMPLE: example lp2iv; shows examples " {p = normalize(lead(p)); intvec I; int i,j; if (deg(p) > lpDegBound(basering)) {ERROR("Monomial exceeds degreebound");} if (p == 1) {return(I);} if (p == 0) {ERROR("Monomial is not allowed to equal zero");} intvec lep = leadexp(p); for ( i = 1; i <= lpVarBlockSize(basering); i++) {if (lep[i] == 1) {I = i; break;}} for (i = (lpVarBlockSize(basering)+1); i <= size(lep); i++) {if (lep[i] == 1) { j = (i mod lpVarBlockSize(basering)); if (j == 0) {I = I,lpVarBlockSize(basering);} else {I = I,j;} } else { if (lep[i] > 1) {ERROR("monomial has a not allowed multidegree");}} } if (I[1] == 0) {ERROR("monomial has a not allowed multidegree");} return(I); } example { "EXAMPLE:"; echo = 2; ring r = 0,(x,y,z),dp; def R = freeAlgebra(r, 5); // constructs a Letterplace ring setring R; // sets basering to Letterplace ring poly p = x*x*z; lp2iv(p); // transforms p into the intvec representation lp2iv(y*y*x*x); lp2iv(z*y*x*z*z); } proc lp2ivId(ideal G) "USAGE: lp2ivId(G); G an ideal (deprecated, will be removed soon) RETURN: list PURPOSE:Converting an ideal into an list of intmats, @* the corresponding intvecs forming the rows ASSUME: - basering has to be a Letterplace ring EXAMPLE: example lp2ivId; shows examples " {G = normalize(lead(G)); intvec I; list L; checkAssumptionsLPIV(0,L); int i,md; for (i = 1; i <= size(G); i++) { if (md <= deg(G[i])) {md = deg(G[i]);}} while (size(G) > 0) {ideal Gt; for (i = 1; i <= ncols(G); i++) {if (md == deg(G[i])) {Gt = Gt + G[i]; G[i] = 0;}} if (size(Gt) > 0) {G = simplify(G,2); intmat M [size(Gt)][md]; for (i = 1; i <= size(Gt); i++) {M[i,1..md] = lp2iv(Gt[i]);} L = insert(L,M); kill M; kill Gt; md = md - 1; } else {kill Gt; md = md - 1;} } return(L); } example { "EXAMPLE:"; echo = 2; ring r = 0,(x,y,z),dp; def R = freeAlgebra(r, 5); // constructs a Letterplace ring setring R; // sets basering to Letterplace ring poly p = x*x*z; poly q = y*y*x*x; poly w = z*y*x*z; // p, q, w are some polynomials we want to transform into their // intvec representation ideal G = p,q,w; lp2ivId(G); // returns the list of intmats for this ideal } proc testLift(ideal M, matrix T) "USAGE: testLift(M,T); module M, matrix T RETURN: module PURPOSE: assembles the result of the lift procedure ASSUME: T is the lift matrix of a submodule of M NOTE: the inverse of the lift procedure EXAMPLE: example testLift; shows examples " { ideal R; if (ncols(M) != nrows(T)) { ERROR("cols(M) != rows(T)") } for (int i=1; i <= nrows(T); i++) { T = subst(T, ncgen(i), M[i]); } kill i; for (int i=1; i <= ncols(T); i++) { R[i] = sum(T[i]); } kill i; return(R); } example { "EXAMPLE:"; echo = 2; ring r = 0,(x,y),(c,Dp); ring R = freeAlgebra(r, 7, 2); ideal I = std(x*y*x + 1); print(matrix(I)); // finite two-sided Groebner basis ideal SI = x*I[1]*y + y*x*I[2], I[1]*y*x + I[2]*y; matrix T = lift(I, SI); // T is the lifting matrix of SI wrt I print(T); // print(matrix(SI)); // the original generators of SI as a matrix print(matrix(testLift(I,T))); // and the result of testLift } proc testSyz(ideal M, module S) "USAGE: testSyz(M,S); module M, S RETURN: module PURPOSE: tests the result of the syz procedure ASSUME: S is the syzygy bimodule of M EXAMPLE: example testSyz; shows examples " { ideal R; if (ncols(M) != nrows(S)) { ERROR("cols(M) != rows(T)") } for (int i=1; i <= nrows(S); i++) { S = subst(S, ncgen(i), M[i]); } kill i; for (int i=1; i <= ncols(S); i++) { R[i] = sum(S[i]); } kill i; return(R); } example { "EXAMPLE:"; echo = 2; ring r = 0,(x,y),(c,Dp); ring R = freeAlgebra(r, 7, 2); ideal I = twostd(x*y*x + 1); print(matrix(I)); module S = syz(I); print(S); testSyz(I,S); // returns zero } static proc mod_init() { LIB"freealgebra.so"; }