Changeset de5dbc in git for Singular/LIB/freegb.lib
 Timestamp:
 Aug 31, 2018, 2:57:22 PM (6 years ago)
 Branches:
 (u'spielwiese', 'd1d239e9808fca76a9497a01fa91ad4e8db6fba5')
 Children:
 a83d208fed33c8c5dd5ae7c36fca503e8b225ee7
 Parents:
 cfce45f606f08b61ca799377f748c37069f669bf
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

Singular/LIB/freegb.lib
rcfce45f rde5dbc 22 22 freeGBasis(L, n); computes twosided Groebner basis of an ideal, encoded via list L, up to degree n 23 23 24 lpMult(f,g); letterplace multiplication of letterplace polynomials25 24 shiftPoly(p,i); compute the ith shift of letterplace polynomial p 26 lpPower(f,n); natural power of a letterplace polynomial27 25 lieBracket(a,b[, N]); compute Lie bracket abba of two letterplace polynomials 28 26 … … 63 61 example setLetterplaceAttributes; 64 62 /* secondary */ 65 example lpMult;66 63 example shiftPoly; 67 example lpPower;68 64 example lieBracket; 69 65 example lp2lstr; … … 637 633 L[3] = LR[3]; 638 634 def @R = ring(L); 635 @R = setLetterplaceAttributes(@R, D+1, nvars(save)); 639 636 setring @R; 640 637 ideal I; … … 686 683 setring @R; 687 684 dbprint(ppl,"computing GB"); 688 ideal J = system("freegb",I ,d,nvars(save));685 ideal J = system("freegb",I); 689 686 // ideal J = slimgb(I); 690 687 dbprint(ppl,J); 691 688 // 4. skip shifted elts 689 attrib(@R, "isLetterplaceRing", 0); // select1 doesn't want to work with letterplace enabled 692 690 ideal K = select1(J,1..s); // s = size(OrigNames) 693 691 dbprint(ppl,K); … … 2463 2461 // alias ppLiebr; 2464 2462 //if int N is given compute [a,[...[a,b]]]] left normed bracket 2465 poly q;2466 2463 int N=1; 2467 2464 if (size(#)>0) … … 2473 2470 } 2474 2471 if (N<=0) { return(q); } 2475 while (b!=0) 2476 { 2477 q = q + pmLiebr(a,lead(b)); 2478 b = b  lead(b); 2479 } 2480 int i; 2472 poly q = a*b  b*a; 2481 2473 if (N >1) 2482 2474 { 2483 for(i =1; i<=N1; i++)2475 for(int i=1; i<=N1; i++) 2484 2476 { 2485 2477 q = lieBracket(a,q); … … 2497 2489 lieBracket(a,b); 2498 2490 lieBracket(x(1),y(1),2); 2499 }2500 2501 static proc pmLiebr(poly a, poly b)2502 {2503 // a poly, b mono2504 poly s;2505 while (a!=0)2506 {2507 s = s + mmLiebr(lead(a),lead(b));2508 a = a  lead(a);2509 }2510 return(s);2511 2491 } 2512 2492 … … 2564 2544 poly f = x(1)*z(2)*y(3)  2*z(1)*y(2) + 3*x(1); 2565 2545 lastBlock(f); // should be 3 2566 }2567 2568 static proc mmLiebr(poly a, poly b)2569 {2570 // a,b, monomials2571 a = lead(a);2572 b = lead(b);2573 int sa = deg(a);2574 int sb = deg(b);2575 poly v = a*shiftPoly(b,sa)  b*shiftPoly(a,sb);2576 return(v);2577 2546 } 2578 2547 … … 3133 3102 */ 3134 3103 3135 static proc lpMultX(poly f, poly g)3136 {3137 /* multiplies two polys in a very general setting correctly */3138 /* alternative to lpMult, possibly better at nonpositive orderings */3139 3140 if (lpAssumeViolation())3141 {3142 ERROR("Incomplete Letterplace structure on the basering!");3143 }3144 // decompose f,g into graded pieces with inForm: need dmodapp.lib3145 int b = attrib(basering,"isLetterplaceRing"); // the length of the block3146 intvec w; // inherit the graded on the oridinal ring3147 int i;3148 for(i=1; i<=b; i++)3149 {3150 w[i] = deg(var(i));3151 }3152 intvec v = w;3153 for(i=1; i< attrib(basering,"uptodeg"); i++)3154 {3155 v = v,w;3156 }3157 w = v;3158 poly p,q,s, result;3159 s = g;3160 while (f!=0)3161 {3162 p = inForm(f,w)[1];3163 f = f  p;3164 s = g;3165 while (s!=0)3166 {3167 q = inForm(s,w)[1];3168 s = s  q;3169 result = result + lpMult(p,q);3170 }3171 }3172 // shrinking3173 // result;3174 return( system("shrinktest",result,attrib(basering, "isLetterplaceRing")) );3175 }3176 example3177 {3178 "EXAMPLE:"; echo = 2;3179 // define a ring in letterplace form as follows:3180 ring r = 0,(x(1),y(1),x(2),y(2),x(3),y(3),x(4),y(4)),dp;3181 def R = setLetterplaceAttributes(r,4,2); // supply R with letterplace structure3182 setring R;3183 poly a = x(1)*y(2)+x(1)+y(1); poly b = y(1)+3;3184 lpMultX(b,a);3185 lpMultX(a,b);3186 }3187 3188 // multiply two letterplace polynomials, lpMult: done3189 // reduction/ Normalform? needs kernel stuff3190 3191 3192 proc lpMult(poly f, poly g)3193 "USAGE: lpMult(f,g); f,g letterplace polynomials3194 RETURN: poly3195 ASSUME: basering has a letterplace ring structure3196 PURPOSE: compute the letterplace form of f*g3197 EXAMPLE: example lpMult; shows examples3198 "3199 {3200 3201 // changelog:3202 // VL oct 2010: deg > deg(_,w) for the length3203 // shrink the result => don't need to decompose polys3204 // since the shift is big enough3205 3206 // indeed it's better to have that3207 // ASSUME: both f and g are quasihomogeneous3208 3209 if (lpAssumeViolation())3210 {3211 ERROR("Incomplete Letterplace structure on the basering!");3212 }3213 intvec w = 1:nvars(basering);3214 int sf = deg(f,w); // VL Oct 2010: we need rather length than degree3215 int sg = deg(g,w); // esp. in the case of weighted ordering3216 int uptodeg = attrib(basering, "uptodeg");3217 if (sf+sg > uptodeg)3218 {3219 ERROR("degree bound violated by the product!");3220 }3221 // if (sf>1) { sf = sf 1; }3222 poly v = f*shiftPoly(g,sf);3223 // bug, reported by Simon King: in nonhomog case [solved]3224 // we need to shrink3225 return( system("shrinktest",v,attrib(basering, "isLetterplaceRing")) );3226 }3227 example3228 {3229 "EXAMPLE:"; echo = 2;3230 // define a ring in letterplace form as follows:3231 ring r = 0,(x(1),y(1),x(2),y(2),x(3),y(3),x(4),y(4)),dp;3232 def R = setLetterplaceAttributes(r,4,2); // supply R with letterplace structure3233 setring R;3234 poly a = x(1)*y(2)+x(1)+y(1); poly b = y(1)+3;3235 lpMult(b,a);3236 lpMult(a,b);3237 }3238 3239 proc lpPower(poly f, int n)3240 "USAGE: lpPower(f,n); f letterplace polynomial, int n3241 RETURN: poly3242 ASSUME: basering has a letterplace ring structure3243 PURPOSE: compute the letterplace form of f^n3244 EXAMPLE: example lpPower; shows examples3245 "3246 {3247 if (n<0) { ERROR("the power must be a natural number!"); }3248 if (n==0) { return(poly(1)); }3249 if (n==1) { return(f); }3250 int i;3251 poly p = 1;3252 for(i=1; i<= n; i++)3253 {3254 p = lpMult(p,f);3255 }3256 return(p);3257 }3258 example3259 {3260 "EXAMPLE:"; echo = 2;3261 // define a ring in letterplace form as follows:3262 ring r = 0,(x(1),y(1),x(2),y(2),x(3),y(3),x(4),y(4)),dp;3263 def R = setLetterplaceAttributes(r,4,2); // supply R with letterplace structure3264 setring R;3265 poly a = x(1)*y(2) + y(1); poly b = y(1)  1;3266 lpPower(a,2);3267 lpPower(b,4);3268 }3104 // static proc lpMultX(poly f, poly g) 3105 // { 3106 // /* multiplies two polys in a very general setting correctly */ 3107 // /* alternative to lpMult, possibly better at nonpositive orderings */ 3108 // 3109 // if (lpAssumeViolation()) 3110 // { 3111 // ERROR("Incomplete Letterplace structure on the basering!"); 3112 // } 3113 // // decompose f,g into graded pieces with inForm: need dmodapp.lib 3114 // int b = attrib(basering,"isLetterplaceRing"); // the length of the block 3115 // intvec w; // inherit the graded on the oridinal ring 3116 // int i; 3117 // for(i=1; i<=b; i++) 3118 // { 3119 // w[i] = deg(var(i)); 3120 // } 3121 // intvec v = w; 3122 // for(i=1; i< attrib(basering,"uptodeg"); i++) 3123 // { 3124 // v = v,w; 3125 // } 3126 // w = v; 3127 // poly p,q,s, result; 3128 // s = g; 3129 // while (f!=0) 3130 // { 3131 // p = inForm(f,w)[1]; 3132 // f = f  p; 3133 // s = g; 3134 // while (s!=0) 3135 // { 3136 // q = inForm(s,w)[1]; 3137 // s = s  q; 3138 // result = result + lpMult(p,q); 3139 // } 3140 // } 3141 // // shrinking 3142 // // result; 3143 // return( system("shrinktest",result,attrib(basering, "isLetterplaceRing")) ); 3144 // } 3145 // example 3146 // { 3147 // "EXAMPLE:"; echo = 2; 3148 // // define a ring in letterplace form as follows: 3149 // ring r = 0,(x(1),y(1),x(2),y(2),x(3),y(3),x(4),y(4)),dp; 3150 // def R = setLetterplaceAttributes(r,4,2); // supply R with letterplace structure 3151 // setring R; 3152 // poly a = x(1)*y(2)+x(1)+y(1); poly b = y(1)+3; 3153 // lpMultX(b,a); 3154 // lpMultX(a,b); 3155 // } 3156 // 3157 // // multiply two letterplace polynomials, lpMult: done 3158 // // reduction/ Normalform? needs kernel stuff 3159 // 3160 // 3161 // proc lpMult(poly f, poly g) 3162 // "USAGE: lpMult(f,g); f,g letterplace polynomials 3163 // RETURN: poly 3164 // ASSUME: basering has a letterplace ring structure 3165 // PURPOSE: compute the letterplace form of f*g 3166 // EXAMPLE: example lpMult; shows examples 3167 // " 3168 // { 3169 // 3170 // // changelog: 3171 // // VL oct 2010: deg > deg(_,w) for the length 3172 // // shrink the result => don't need to decompose polys 3173 // // since the shift is big enough 3174 // 3175 // // indeed it's better to have that 3176 // // ASSUME: both f and g are quasihomogeneous 3177 // 3178 // if (lpAssumeViolation()) 3179 // { 3180 // ERROR("Incomplete Letterplace structure on the basering!"); 3181 // } 3182 // intvec w = 1:nvars(basering); 3183 // int sf = deg(f,w); // VL Oct 2010: we need rather length than degree 3184 // int sg = deg(g,w); // esp. in the case of weighted ordering 3185 // int uptodeg = attrib(basering, "uptodeg"); 3186 // if (sf+sg > uptodeg) 3187 // { 3188 // ERROR("degree bound violated by the product!"); 3189 // } 3190 // // if (sf>1) { sf = sf 1; } 3191 // poly v = f*shiftPoly(g,sf); 3192 // // bug, reported by Simon King: in nonhomog case [solved] 3193 // // we need to shrink 3194 // return( system("shrinktest",v,attrib(basering, "isLetterplaceRing")) ); 3195 // } 3196 // example 3197 // { 3198 // "EXAMPLE:"; echo = 2; 3199 // // define a ring in letterplace form as follows: 3200 // ring r = 0,(x(1),y(1),x(2),y(2),x(3),y(3),x(4),y(4)),dp; 3201 // def R = setLetterplaceAttributes(r,4,2); // supply R with letterplace structure 3202 // setring R; 3203 // poly a = x(1)*y(2)+x(1)+y(1); poly b = y(1)+3; 3204 // lpMult(b,a); 3205 // lpMult(a,b); 3206 // } 3207 // 3208 // proc lpPower(poly f, int n) 3209 // "USAGE: lpPower(f,n); f letterplace polynomial, int n 3210 // RETURN: poly 3211 // ASSUME: basering has a letterplace ring structure 3212 // PURPOSE: compute the letterplace form of f^n 3213 // EXAMPLE: example lpPower; shows examples 3214 // " 3215 // { 3216 // if (n<0) { ERROR("the power must be a natural number!"); } 3217 // if (n==0) { return(poly(1)); } 3218 // if (n==1) { return(f); } 3219 // int i; 3220 // poly p = 1; 3221 // for(i=1; i<= n; i++) 3222 // { 3223 // p = lpMult(p,f); 3224 // } 3225 // return(p); 3226 // } 3227 // example 3228 // { 3229 // "EXAMPLE:"; echo = 2; 3230 // // define a ring in letterplace form as follows: 3231 // ring r = 0,(x(1),y(1),x(2),y(2),x(3),y(3),x(4),y(4)),dp; 3232 // def R = setLetterplaceAttributes(r,4,2); // supply R with letterplace structure 3233 // setring R; 3234 // poly a = x(1)*y(2) + y(1); poly b = y(1)  1; 3235 // lpPower(a,2); 3236 // lpPower(b,4); 3237 // } 3269 3238 3270 3239 // new: lp normal from by using shiftinvariant data by Grischa Studzinski … … 3387 3356 poly p; 3388 3357 for (int i = 1; i <= size(L[2]); i++) { 3389 p = p + lpMult(lpMult(L[2][i][2], I[L[2][i][1]]), L[2][i][3]);3358 p = p + L[2][i][2] * I[L[2][i][1]] * L[2][i][3]; 3390 3359 } 3391 3360 p = p + L[1]; … … 3716 3685 for (i = 1; i <= size(g); i++) 3717 3686 { 3718 qt = qt + l pMult(lpMult(l,g[i]),r);3687 qt = qt + l*g[i]*r; 3719 3688 } 3720 3689 return(p  leadcoef(p)*normalize(qt)); 3721 }3722 3723 3724 static proc lpShrink(poly p)3725 "3726 "3727 {int n;3728 if (attrib(basering,"isLetterplaceRing")>0)3729 {n = attrib(basering,"isLetterplaceRing");3730 return(system("shrinktest",p,n));3731 }3732 else {ERROR("Basering is not a Letterplace ring!");}3733 3690 } 3734 3691 … … 3900 3857 } 3901 3858 3902 static proc bugSKing()3903 {3904 LIB "freegb.lib";3905 ring r=0,(a,b),dp;3906 def R = makeLetterplaceRing(5);3907 setring R;3908 poly p = a(1);3909 poly q = b(1);3910 poly p2 = lpPower(p,2);3911 lpMult(p2+q,q)lpMult(p2,q)lpMult(q,q); // now its 03912 }3913 3914 static proc bugRucker()3915 {3916 // needs unstatic lpMultX3917 LIB "freegb.lib";3918 ring r=0,(a,b,c,d,p,q,r,s,t,u,v,w),(a(7,1,1,7),dp);3919 def R=makeLetterplaceRing(20,1);3920 setring R;3921 option(redSB); option(redTail);3922 ideal I=a(1)*b(2)*c(3)p(1)*q(2)*r(3)*s(4)*t(5)*u(6),b(1)*c(2)*d(3)v(1)*w(2);3923 poly ttt = a(1)*v(2)*w(3)p(1)*q(2)*r(3)*s(4)*t(5)*u(6)*d(7);3924 // with lpMult3925 lpMult(I[1],d(1))  lpMult(a(1),I[2]); // spoly; has been incorrect before3926 _  ttt;3927 // with lpMultX3928 lpMultX(I[1],d(1))  lpMultX(a(1),I[2]); // spoly; has been incorrect before3929 _  ttt;3930 }3931 3932 static proc checkWeightedExampleLP()3933 {3934 ring r = 0,(x(1),y(1),x(2),y(2),x(3),y(3),x(4),y(4)),wp(2,1,2,1,2,1,2,1);3935 def R = setLetterplaceAttributes(r,4,2); // supply R with letterplace structure3936 setring R;3937 poly a = x(1)*y(2)+x(1)+y(1); poly b = y(1)+3;3938 lpMultX(b,a);3939 lpMultX(a,b); // seems to work properly3940 }3859 // static proc bugSKing() 3860 // { 3861 // LIB "freegb.lib"; 3862 // ring r=0,(a,b),dp; 3863 // def R = makeLetterplaceRing(5); 3864 // setring R; 3865 // poly p = a(1); 3866 // poly q = b(1); 3867 // poly p2 = lpPower(p,2); 3868 // lpMult(p2+q,q)lpMult(p2,q)lpMult(q,q); // now its 0 3869 // } 3870 // 3871 // static proc bugRucker() 3872 // { 3873 // // needs unstatic lpMultX 3874 // LIB "freegb.lib"; 3875 // ring r=0,(a,b,c,d,p,q,r,s,t,u,v,w),(a(7,1,1,7),dp); 3876 // def R=makeLetterplaceRing(20,1); 3877 // setring R; 3878 // option(redSB); option(redTail); 3879 // ideal I=a(1)*b(2)*c(3)p(1)*q(2)*r(3)*s(4)*t(5)*u(6),b(1)*c(2)*d(3)v(1)*w(2); 3880 // poly ttt = a(1)*v(2)*w(3)p(1)*q(2)*r(3)*s(4)*t(5)*u(6)*d(7); 3881 // // with lpMult 3882 // lpMult(I[1],d(1))  lpMult(a(1),I[2]); // spoly; has been incorrect before 3883 // _  ttt; 3884 // // with lpMultX 3885 // lpMultX(I[1],d(1))  lpMultX(a(1),I[2]); // spoly; has been incorrect before 3886 // _  ttt; 3887 // } 3888 // 3889 // static proc checkWeightedExampleLP() 3890 // { 3891 // ring r = 0,(x(1),y(1),x(2),y(2),x(3),y(3),x(4),y(4)),wp(2,1,2,1,2,1,2,1); 3892 // def R = setLetterplaceAttributes(r,4,2); // supply R with letterplace structure 3893 // setring R; 3894 // poly a = x(1)*y(2)+x(1)+y(1); poly b = y(1)+3; 3895 // lpMultX(b,a); 3896 // lpMultX(a,b); // seems to work properly 3897 // } 3941 3898 3942 3899 proc lpPrint(ideal I, def @r)
Note: See TracChangeset
for help on using the changeset viewer.