Changeset 1e72a5 in git
- Timestamp:
- Sep 27, 2010, 7:07:56 PM (13 years ago)
- Branches:
- (u'jengelh-datetime', 'ceac47cbc86fe4a15902392bdbb9bd2ae0ea02c6')(u'spielwiese', '0604212ebb110535022efecad887940825b97c3f')
- Children:
- 68d66bca0586735fea44d0bf99df874eca69ac14
- Parents:
- a34c0545f08c8bb2e8ed9451029ce9255e6e226f
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
Singular/LIB/dmodapp.lib
ra34c05 r1e72a5 4 4 info=" 5 5 LIBRARY: dmodapp.lib Applications of algebraic D-modules 6 AUTHORS: Viktor Levandovskyy, levandov@math.rwth-aachen.de 7 @* Daniel Andres, daniel.andres@math.rwth-aachen.de 8 9 GUIDE: Let K be a field of characteristic 0, R = K[x1,..xN] and 10 @* D be the Weyl algebra in variables x1,..xN,d1,..dN. 6 AUTHORS: Viktor Levandovskyy, levandov@math.rwth-aachen.de 7 @* Daniel Andres, daniel.andres@math.rwth-aachen.de 8 9 SUPPORT: DFG Graduiertenkolleg 1632 'Experimentelle und konstruktive Algebra' 10 11 GUIDE: Let K be a field of characteristic 0, R = K[x1,...,xN] and 12 @* D be the Weyl algebra in variables x1,...,xN,d1,...,dN. 11 13 @* In this library there are the following procedures for algebraic D-modules: 14 @* 12 15 @* - localization of a holonomic module D/I with respect to a mult. closed set 13 16 @* of all powers of a given polynomial F from R. Our aim is to compute an … … 20 23 @* procedures annPoly resp. annRat. 21 24 @* 22 @* - initial form and initial ideals in Weyl algebras with respect to a given 23 @* weight vector can be computed with inForm, initialMalgrange, initialIdealW. 25 @* - Groebner bases with respect to weights, initial forms and initial ideals 26 @* in Weyl algebras with respect to a given weight vector can be computed with 27 @* GBWeight, inForm, initialMalgrange and initialIdealW. 28 @* 29 @* - restriction and integration of a holonomic module D/I. Suppose I is 30 @* annihilating a function F(x1,...,xn). Our aim is to compute an ideal J 31 @* directly from I, which annihilates 32 @* - F(0,...,0,xm,...,xn) in case of restriction or 33 @* - the integral of F with respect to x1,...,xm in case of integration. 34 @* The corresponding procedures are restrictionModule, restrictionIdeal, 35 @* integralModule and integralIdeal. 36 @* 37 @* - characteristic varieties defined by ideals in Weyl algebras can be computed 38 @* with charVariety and charInfo. 24 39 @* 25 40 @* - appelF1, appelF2 and appelF4 return ideals in parametric Weyl algebras, 26 41 @* which annihilate corresponding Appel hypergeometric functions. 27 42 43 28 44 REFERENCES: 29 45 @* (SST) Saito, Sturmfels, Takayama 'Groebner Deformations of Hypergeometric 30 46 @* Differential Equations', Springer, 2000 31 @* (ONW) Oaku, Takayama, Walther 'A Localization Algorithm for D-modules', 2000 32 33 PROCEDURES: 47 @* (OTW) Oaku, Takayama, Walther 'A Localization Algorithm for D-modules', 2000 48 @* (OT) Oaku, Takayama 'Algorithms for D-modules', 1998 49 50 51 MAIN PROCEDURES: 34 52 35 53 annPoly(f); annihilator of a polynomial f in the corr. Weyl algebra 36 54 annRat(f,g); annihilator of a rational function f/g in the corr. Weyl algebra 37 DLoc(I,F); presentation of the localization of D/I w.r.t. f^s 38 SDLoc(I, F); a generic presentation of the localization of D/I w.r.t. f^s 39 DLoc0(I, F); presentation of the localization of D/I w.r.t. f^s, based on SDLoc 40 55 DLoc(I,F); presentation of the localization of D/I w.r.t. f^s 56 SDLoc(I,F); a generic presentation of the localization of D/I w.r.t. f^s 57 DLoc0(I,F); presentation of the localization of D/I w.r.t. f^s, based on SDLoc 58 59 GBWeight(I,u,v[,a,b]); Groebner basis of I w.r.t. the weight vector (u,v) 41 60 initialMalgrange(f[,s,t,v]); Groebner basis of the initial Malgrange ideal for f 42 initialIdealW(I,u,v[,s,t]); initial ideal of a given ideal w.r.t. given weights 43 inForm(f,w); initial form of a poly/ideal w.r.t. a given weight 44 isFsat(I, F); check whether the ideal I is F-saturated 61 initialIdealW(I,u,v[,s,t]); initial ideal of a given ideal w.r.t. given weights 62 inForm(f,w); initial form of a poly/ideal w.r.t. a given weight 63 64 restrictionIdeal(I,w,[,eng,m,G]); restriction ideal of I w.r.t. w 65 restrictionModule(I,w[,eng,m,G]); restriction module of I w.r.t. w 66 integralIdeal(I,w,[,eng,m,G]); integral ideal of I w.r.t. w 67 integralModule(I,w[,eng,m,G]); integral module of I w.r.t. w 68 deRhamCohom(f[,eng,m]); basis of n-th de Rham cohomology group 69 deRhamCohomIdeal(I[,w,eng,m,G]); basis of n-th de Rham cohomology group 70 71 charVariety(I); characteristic variety of the ideal I 72 charInfo(I); char. variety of ideal I, its singular locus and primary decomp. 73 isFsat(I,F); check whether the ideal I is F-saturated 74 75 76 AUXILIARY PROCEDURES: 77 78 appelF1(); create an ideal annihilating Appel F1 function 79 appelF2(); create an ideal annihilating Appel F2 function 80 appelF4(); create an ideal annihilating Appel F4 function 81 82 fourier(I[,v]); Fourier automorphism 83 inverseFourier(I[,v]); inverse Fourier automorphism 84 85 bFactor(F); computes the roots of irreducible factors of an univariate poly 86 intRoots(L); dismiss non-integer roots from list in bFactor format 87 poly2list(f); decompose a polynomial into a list of terms and exponents 88 fl2poly(L,s); reconstruct a monic univariate polynomial from its factorization 89 90 insertGenerator(id,p[,k]); insert an element into an ideal/module 91 deleteGenerator(id,k); delete the k-th element from an ideal/module 92 93 engine(I,i); computes a Groebner basis with the algorithm given by i 94 isInt(n); check whether object of type number is actually int 95 sortIntvec(v); sort intvec 96 45 97 46 98 SEE ALSO: bfun_lib, dmod_lib, dmodvar_lib, gmssing_lib 47 99 48 KEYWORDS: D-module; annihilator of polynomial; annihilator of rational function; D-localization; 49 localization of D-module; Appel function; Appel hypergeometric function 100 101 KEYWORDS: D-module; annihilator of polynomial; annihilator of rational function; 102 D-localization; localization of D-module; D-restriction; restriction of 103 D-module; D-integration; integration of D-module; characteristic variety; 104 Appel function; Appel hypergeometric function 105 50 106 "; 51 //AUXILIARY PROCEDURES: 52 // 53 //bFactor(F); computes the roots of irreducible factors of an univariate poly 54 //appelF1(); create an ideal annihilating Appel F1 function 55 //appelF2(); create an ideal annihilating Appel F2 function 56 //appelF4(); create an ideal annihilating Appel F4 function 57 //engine(I,i); computes a Groebner basis with the algorithm given by i 58 //poly2list(f); decompose a polynomial into a list of terms and exponents 59 //fl2poly(L,s); reconstruct a monic univariate polynomial from its factorization 60 //insertGenerator(id,p[,k]); insert an element into an ideal/module 61 //deleteGenerator(id,k); delete the k-th element from an ideal/module 62 63 107 108 109 /* 110 CHANGELOG 111 21.09.10 by DA: 112 - restructured library for better readability 113 - new / improved procs: 114 - toolbox: isInt, intRoots, sortIntvec 115 - GB wrt weights: GBWeight, initialIdealW rewritten using GBWeight 116 - restriction/integration: restrictionX, integralX where X in {Module, Ideal}, 117 fourier, inverseFourier, deRhamCohom, deRhamCohomIdeal 118 - characteristic variety: charVariety, charInfo 119 - added keywords for features 120 - reformated help strings and examples in existing procs 121 - added SUPPORT in header 122 - added reference (OT) 123 */ 124 125 126 LIB "bfun.lib"; // for pIntersect etc 127 LIB "dmod.lib"; // for SannfsBM etc 128 LIB "general.lib"; // for sort 129 LIB "gkdim.lib"; 130 LIB "nctools.lib"; // for isWeyl etc 64 131 LIB "poly.lib"; 65 LIB "sing.lib"; 66 LIB "primdec.lib"; 67 LIB "dmod.lib"; // loads e.g. nctools.lib 68 LIB "bfun.lib"; //formerly LIB "bfct.lib"; 69 LIB "nctools.lib"; // for isWeyl etc 70 LIB "gkdim.lib"; 71 72 // todo: complete and include into above list 73 // charVariety(I); compute the characteristic variety of the ideal I 74 // charInfo(); ??? 132 LIB "primdec.lib"; // for primdecGKZ 133 LIB "qhmoduli.lib"; // for Max 134 LIB "sing.lib"; // for slocus 75 135 76 136 … … 79 139 proc testdmodapp() 80 140 { 141 example annPoly; 142 example annRat; 143 example DLoc; 144 example SDLoc; 145 example DLoc0; 146 example GBWeight; 147 example initialMalgrange; 81 148 example initialIdealW; 82 example initialMalgrange;83 example DLoc;84 example DLoc0;85 example SDLoc;86 149 example inForm; 150 example restrictionIdeal; 151 example restrictionModule; 152 example integralIdeal; 153 example integralModule; 154 example deRhamCohom; 155 example deRhamCohomIdeal; 156 example charVariety; 157 example charInfo; 87 158 example isFsat; 88 example annRat;89 example annPoly;90 159 example appelF1; 91 160 example appelF2; 92 161 example appelF4; 162 example fourier; 163 example inverseFourier; 164 example bFactor; 165 example intRoots; 93 166 example poly2list; 94 167 example fl2poly; 95 168 example insertGenerator; 96 169 example deleteGenerator; 97 example bFactor; 98 } 99 100 proc inForm (ideal I, intvec w) 101 "USAGE: inForm(I,w); I ideal, w intvec 102 RETURN: the initial form of I w.r.t. the weight vector w 103 PURPOSE: computes the initial form of an ideal w.r.t. a given weight vector 104 NOTE: the size of the weight vector must be equal to the number of variables 105 @* of the basering. 106 EXAMPLE: example inForm; shows examples 170 example engine; 171 example isInt; 172 example sortIntvec; 173 } 174 175 176 // general assumptions //////////////////////////////////////////////////////// 177 178 proc dmodappassumeViolation() 179 { 180 // returns Boolean : yes/no [for assume violation] 181 // char K = 0 182 // no qring 183 if ( (size(ideal(basering)) >0) || (char(basering) >0) ) 184 { 185 // "ERROR: no qring is allowed"; 186 return(1); 187 } 188 return(0); 189 } 190 191 static proc dmodappMoreAssumeViolation() 192 { 193 // char K = 0, no qring 194 if ((size(ideal(basering))>0) || (char(basering)>0)) 195 { 196 ERROR("Basering is inappropriate: characteristic>0 or qring present"); 197 } 198 // no Weyl algebra 199 if (isWeyl() == 0) 200 { 201 ERROR("Basering is not a Weyl algebra"); 202 } 203 // wrong sequence of vars 204 int i,n; 205 n = nvars(basering)/2; 206 for (i=1; i<=n; i++) 207 { 208 if (bracket(var(i+n),var(i))<>1) 209 { 210 ERROR(string(var(i+n))+" is not a differential operator for " +string(var(i))); 211 } 212 } 213 return(); 214 } 215 216 static proc safeVarName (string s, string cv) 217 { 218 string S; 219 if (cv == "v") { S = "," + "," + varstr(basering) + ","; } 220 if (cv == "c") { S = "," + "," + charstr(basering) + ","; } 221 if (cv == "cv") { S = "," + charstr(basering) + "," + varstr(basering) + ","; } 222 s = "," + s + ","; 223 while (find(S,s) <> 0) 224 { 225 s[1] = "@"; 226 s = "," + s; 227 } 228 s = s[2..size(s)-1]; 229 return(s) 230 } 231 232 233 // toolbox //////////////////////////////////////////////////////////////////// 234 235 proc engine(def I, int i) 236 "USAGE: engine(I,i); I ideal/module/matrix, i an int 237 RETURN: the same type as I 238 PURPOSE: compute the Groebner basis of I with the algorithm, chosen via i 239 NOTE: By default and if i=0, slimgb is used; otherwise std does the job. 240 EXAMPLE: example engine; shows examples 107 241 " 108 242 { 109 if (size(w) != nvars(basering)) 110 { 111 ERROR("weight vector has wrong dimension"); 112 } 113 if (I == 0) 114 { 115 return(I); 116 } 117 int j,i,s,m; 118 list l; 119 poly g; 120 ideal J; 121 for (j=1; j<=ncols(I); j++) 122 { 123 l = poly2list(I[j]); 124 m = scalarProd(w,l[1][1]); 125 g = l[1][2]; 126 for (i=2; i<=size(l); i++) 127 { 128 s = scalarProd(w,l[i][1]); 129 if (s == m) 130 { 131 g = g + l[i][2]; 132 } 133 else 134 { 135 if (s > m) 136 { 137 m = s; 138 g = l[i][2]; 139 } 140 } 141 } 142 J[j] = g; 243 /* std - slimgb mix */ 244 def J; 245 // ideal J; 246 if (i==0) 247 { 248 J = slimgb(I); 249 } 250 else 251 { 252 // without options -> strange! (ringlist?) 253 intvec v = option(get); 254 option(redSB); 255 option(redTail); 256 J = std(I); 257 option(set, v); 143 258 } 144 259 return(J); … … 147 262 { 148 263 "EXAMPLE:"; echo = 2; 149 ring @D = 0,(x,y,Dx,Dy),dp;150 def D = Weyl();151 setring D;152 poly F = 3*x^2*Dy+2*y*Dx;153 poly G = 2*x*Dx+3*y*Dy+6;154 ideal I = F,G;155 intvec w1 = -1,-1,1,1;156 intvec w2 = -1,-2,1,2;157 intvec w3 = -2,-3,2,3;158 inForm(I,w1);159 inForm(I,w2);160 inForm(I,w3);161 }162 163 /*164 165 proc charVariety(ideal I)166 "USAGE: charVariety(I); I an ideal167 RETURN: ring168 PURPOSE: compute the characteristic variety of a D-module D/I169 STATUS: experimental, todo170 ASSUME: the ground ring is the Weyl algebra with x's before d's171 NOTE: activate the output ring with the @code{setring} command.172 @* In the output (in a commutative ring):173 @* - the ideal CV is the characteristic variety char(I)174 @* If @code{printlevel}=1, progress debug messages will be printed,175 @* if @code{printlevel}>=2, all the debug messages will be printed.176 EXAMPLE: example charVariety; shows examples177 "178 {179 // 1. introduce the weights 0, 1180 def save = basering;181 list LL = ringlist(save);182 list L;183 int i;184 for(i=1;i<=4;i++)185 {186 L[i] = LL[i];187 }188 list OLD = L[3];189 list NEW; list tmp;190 tmp[1] = "a"; // string191 intvec iv;192 int N = nvars(basering); N = N div 2;193 for(i=N+1; i<=2*N; i++)194 {195 iv[i] = 1;196 }197 tmp[2] = iv;198 NEW[1] = tmp;199 for (i=2; i<=size(OLD);i++)200 {201 NEW[i] = OLD[i-1];202 }203 L[3] = NEW;204 list ncr =ncRelations(save);205 matrix @C = ncr[1];206 matrix @D = ncr[2];207 def @U = ring(L);208 // 2. create the commutative ring209 setring save;210 list CL;211 for(i=1;i<=4;i++)212 {213 CL[i] = L[i];214 }215 CL[3] = OLD;216 def @CU = ring(CL);217 // comm ring is ready218 setring @U;219 // make @U noncommutative220 matrix @C = imap(save,@C);221 matrix @D = imap(save,@D);222 def @@U = nc_algebra(@C,@D);223 setring @@U; kill @U;224 // 2. compute Groebner basis225 ideal I = imap(save,I);226 // I = groebner(I);227 I = slimgb(I); // a bug?228 setring @CU;229 ideal CV = imap(@@U,I);230 // CV = groebner(CV); // cosmetics231 CV = slimgb(CV);232 export CV;233 return(@CU);234 }235 example236 {237 "EXAMPLE:"; echo = 2;238 264 ring r = 0,(x,y),Dp; 239 poly F = x3-y2; 240 printlevel = 0; 241 def A = annfs(F); 242 setring A; // Weyl algebra 243 LD; // the ideal 244 def CA = charVariety(LD); 245 setring CA; 246 CV; 247 dim(CV); 248 } 249 250 /* 251 252 // TODO 253 254 /* 255 proc charInfo(ideal I) 256 "USAGE: charInfo(I); I an ideal 257 RETURN: ring 258 STATUS: experimental, todo 259 PURPOSE: compute the characteristic information for I 260 ASSUME: the ground ring is the Weyl algebra with x's before d's 261 NOTE: activate the output ring with the @code{setring} command. 262 @* In the output (in a commutative ring): 263 @* - the ideal CV is the characteristic variety char(I) 264 @* - the ideal SL is the singular locus of char(I) 265 @* - the list PD is the primary decomposition of char(I) 266 @* If @code{printlevel}=1, progress debug messages will be printed, 267 @* if @code{printlevel}>=2, all the debug messages will be printed. 268 EXAMPLE: example annfs; shows examples 269 " 270 { 271 def save = basering; 272 def @A = charVariety(I); 273 setring @A; 274 // run slocus 275 // run primdec 276 } 277 */ 278 279 280 proc appelF1() 281 "USAGE: appelF1(); 282 RETURN: ring (and exports an ideal into it) 283 PURPOSE: define the ideal in a parametric Weyl algebra, 284 @* which annihilates Appel F1 hypergeometric function 285 NOTE: the ideal called IAppel1 is exported to the output ring 286 EXAMPLE: example appelF1; shows examples 287 " 288 { 289 // Appel F1, d = b', SST p.48 290 ring @r = (0,a,b,c,d),(x,y,Dx,Dy),(a(0,0,1,1),a(0,0,1,0),dp); 291 matrix @D[4][4]; 292 @D[1,3]=1; @D[2,4]=1; 293 def @S = nc_algebra(1,@D); 294 setring @S; 295 ideal IAppel1 = 296 (x*Dx)*(x*Dx+y*Dy+c-1) - x*(x*Dx+y*Dy+a)*(x*Dx+b), 297 (y*Dy)*(x*Dx+y*Dy+c-1) - y*(x*Dx+y*Dy+a)*(y*Dy+d), 298 (x-y)*Dx*Dy - d*Dx + b*Dy; 299 export IAppel1; 300 kill @r; 301 return(@S); 302 } 303 example 304 { 305 "EXAMPLE:"; echo = 2; 306 def A = appelF1(); 307 setring A; 308 IAppel1; 309 } 310 311 proc appelF2() 312 "USAGE: appelF2(); 313 RETURN: ring (and exports an ideal into it) 314 PURPOSE: define the ideal in a parametric Weyl algebra, 315 @* which annihilates Appel F2 hypergeometric function 316 NOTE: the ideal called IAppel2 is exported to the output ring 317 EXAMPLE: example appelF2; shows examples 318 " 319 { 320 // Appel F2, c = b', SST p.85 321 ring @r = (0,a,b,c),(x,y,Dx,Dy),(a(0,0,1,1),a(0,0,1,0),dp); 322 matrix @D[4][4]; 323 @D[1,3]=1; @D[2,4]=1; 324 def @S = nc_algebra(1,@D); 325 setring @S; 326 ideal IAppel2 = 327 (x*Dx)^2 - x*(x*Dx+y*Dy+a)*(x*Dx+b), 328 (y*Dy)^2 - y*(x*Dx+y*Dy+a)*(y*Dy+c); 329 export IAppel2; 330 kill @r; 331 return(@S); 332 } 333 example 334 { 335 "EXAMPLE:"; echo = 2; 336 def A = appelF2(); 337 setring A; 338 IAppel2; 339 } 340 341 proc appelF4() 342 "USAGE: appelF4(); 343 RETURN: ring (and exports an ideal into it) 344 PURPOSE: define the ideal in a parametric Weyl algebra, 345 @* which annihilates Appel F4 hypergeometric function 346 NOTE: the ideal called IAppel4 is exported to the output ring 347 EXAMPLE: example appelF4; shows examples 348 " 349 { 350 // Appel F4, d = c', SST, p. 39 351 ring @r = (0,a,b,c,d),(x,y,Dx,Dy),(a(0,0,1,1),a(0,0,1,0),dp); 352 matrix @D[4][4]; 353 @D[1,3]=1; @D[2,4]=1; 354 def @S = nc_algebra(1,@D); 355 setring @S; 356 ideal IAppel4 = 357 Dx*(x*Dx+c-1) - (x*Dx+y*Dy+a)*(x*Dx+y*Dy+b), 358 Dy*(y*Dy+d-1) - (x*Dx+y*Dy+a)*(x*Dx+y*Dy+b); 359 export IAppel4; 360 kill @r; 361 return(@S); 362 } 363 example 364 { 365 "EXAMPLE:"; echo = 2; 366 def A = appelF4(); 367 setring A; 368 IAppel4; 265 ideal I = y*(x3-y2),x*(x3-y2); 266 engine(I,0); // uses slimgb 267 engine(I,1); // uses std 369 268 } 370 269 … … 402 301 } 403 302 303 proc fl2poly(list L, string s) 304 "USAGE: fl2poly(L,s); L a list, s a string 305 RETURN: poly 306 PURPOSE: reconstruct a monic polynomial in one variable from its factorization 307 ASSUME: s is a string with the name of some variable and 308 @* L is supposed to consist of two entries: 309 @* - L[1] of the type ideal with the roots of a polynomial 310 @* - L[2] of the type intvec with the multiplicities of corr. roots 311 EXAMPLE: example fl2poly; shows examples 312 " 313 { 314 if (varNum(s)==0) 315 { 316 ERROR("no such variable found in the basering"); return(0); 317 } 318 poly x = var(varNum(s)); 319 poly P = 1; 320 int sl = size(L[1]); 321 ideal RR = L[1]; 322 intvec IV = L[2]; 323 for(int i=1; i<= sl; i++) 324 { 325 if (IV[i] > 0) 326 { 327 P = P*((x-RR[i])^IV[i]); 328 } 329 else 330 { 331 printf("Ignored the root with incorrect multiplicity %s",string(IV[i])); 332 } 333 } 334 return(P); 335 } 336 example 337 { 338 "EXAMPLE:"; echo = 2; 339 ring r = 0,(x,y,z,s),Dp; 340 ideal I = -1,-4/3,-5/3,-2; 341 intvec mI = 2,1,1,1; 342 list BS = I,mI; 343 poly p = fl2poly(BS,"s"); 344 p; 345 factorize(p,2); 346 } 347 348 proc insertGenerator (list #) 349 "USAGE: insertGenerator(id,p[,k]); 350 @* id an ideal/module, p a poly/vector, k an optional int 351 RETURN: same as id 352 PURPOSE: inserts p into the first argument at k-th index position and returns 353 @* the enlarged object 354 NOTE: If k is given, p is inserted at position k, otherwise (and by default), 355 @* p is inserted at the beginning. 356 SEE ALSO: deleteGenerator 357 EXAMPLE: example insertGenerator; shows examples 358 " 359 { 360 if (size(#) < 2) 361 { 362 ERROR("insertGenerator has to be called with at least 2 arguments (ideal/module,poly/vector)"); 363 } 364 string inp1 = typeof(#[1]); 365 if (inp1 == "ideal" || inp1 == "module") 366 { 367 if (inp1 == "ideal") { ideal id = #[1]; } 368 else { module id = #[1]; } 369 } 370 else { ERROR("first argument has to be of type ideal or module"); } 371 string inp2 = typeof(#[2]); 372 if (inp2 == "poly" || inp2 == "vector") 373 { 374 if (inp2 =="poly") { poly f = #[2]; } 375 else 376 { 377 if (inp1 == "ideal") 378 { 379 ERROR("second argument has to be a polynomial if first argument is an ideal"); 380 } 381 else { vector f = #[2]; } 382 } 383 } 384 else { ERROR("second argument has to be of type poly/vector"); } 385 int n = ncols(id); 386 int k = 1; // default 387 if (size(#)>=3) 388 { 389 if (typeof(#[3]) == "int") 390 { 391 k = #[3]; 392 if (k<=0) 393 { 394 ERROR("third argument has to be positive"); 395 } 396 } 397 else { ERROR("third argument has to be of type int"); } 398 } 399 execute(inp1 +" J;"); 400 if (k == 1) { J = f,id; } 401 else 402 { 403 if (k>n) 404 { 405 J = id; 406 J[k] = f; 407 } 408 else // 1<k<=n 409 { 410 J[1..k-1] = id[1..k-1]; 411 J[k] = f; 412 J[k+1..n+1] = id[k..n]; 413 } 414 } 415 return(J); 416 } 417 example 418 { 419 "EXAMPLE:"; echo = 2; 420 ring r = 0,(x,y,z),dp; 421 ideal I = x^2,z^4; 422 insertGenerator(I,y^3); 423 insertGenerator(I,y^3,2); 424 module M = I; 425 insertGenerator(M,[x^3,y^2,z],2); 426 } 427 428 proc deleteGenerator (list #) 429 "USAGE: deleteGenerator(id,k); id an ideal/module, k an int 430 RETURN: same as id 431 PURPOSE: deletes the k-th generator from the first argument and returns 432 @* the altered object 433 SEE ALSO: insertGenerator 434 EXAMPLE: example insertGenerator; shows examples 435 " 436 { 437 if (size(#) < 2) 438 { 439 ERROR("deleteGenerator has to be called with 2 arguments (ideal/module,int)"); 440 } 441 string inp1 = typeof(#[1]); 442 if (inp1 == "ideal" || inp1 == "module") 443 { 444 if (inp1 == "ideal") { ideal id = #[1]; } 445 else { module id = #[1]; } 446 } 447 else { ERROR("first argument has to be of type ideal or module"); } 448 string inp2 = typeof(#[2]); 449 if (inp2 == "int" || inp2 == "number") { int k = int(#[2]); } 450 else { ERROR("second argument has to be of type int"); } 451 int n = ncols(id); 452 if (n == 1) { ERROR(inp1+" must have more than one generator"); } 453 if (k<=0 || k>n) { ERROR("second argument has to be in the range 1,...,"+string(n)); } 454 execute(inp1 +" J;"); 455 if (k == 1) { J = id[2..n]; } 456 else 457 { 458 if (k == n) { J = id[1..n-1]; } 459 else 460 { 461 J[1..k-1] = id[1..k-1]; 462 J[k..n-1] = id[k+1..n]; 463 } 464 } 465 return(J); 466 } 467 example 468 { 469 "EXAMPLE:"; echo = 2; 470 ring r = 0,(x,y,z),dp; 471 ideal I = x^2,y^3,z^4; 472 deleteGenerator(I,2); 473 module M = [x,y,z],[x2,y2,z2],[x3,y3,z3];; 474 deleteGenerator(M,2); 475 } 476 477 proc bFactor (poly F) 478 "USAGE: bFactor(f); f poly 479 RETURN: list 480 PURPOSE: tries to compute the roots of a univariate poly f 481 NOTE: The output list consists of two or three entries: 482 @* roots of f as an ideal, their multiplicities as intvec, and, 483 @* if present, a third one being the product of all irreducible factors 484 @* of degree greater than one, given as string. 485 DISPLAY: If printlevel=1, progress debug messages will be printed, 486 @* if printlevel>=2, all the debug messages will be printed. 487 EXAMPLE: example bFactor; shows examples 488 " 489 { 490 int ppl = printlevel - voice +2; 491 def save = basering; 492 ideal LI = variables(F); 493 list L; 494 int i = size(LI); 495 if (i>1) { ERROR("poly has to be univariate")} 496 if (i == 0) 497 { 498 dbprint(ppl,"// poly is constant"); 499 L = list(ideal(0),intvec(0),string(F)); 500 return(L); 501 } 502 poly v = LI[1]; 503 L = ringlist(save); L = L[1..4]; 504 L[2] = list(string(v)); 505 L[3] = list(list("dp",intvec(1)),list("C",intvec(0))); 506 def @S = ring(L); 507 setring @S; 508 poly ir = 1; poly F = imap(save,F); 509 list L = factorize(F); 510 ideal I = L[1]; 511 intvec m = L[2]; 512 ideal II; intvec mm; 513 for (i=2; i<=ncols(I); i++) 514 { 515 if (deg(I[i]) > 1) 516 { 517 ir = ir * I[i]^m[i]; 518 } 519 else 520 { 521 II[size(II)+1] = I[i]; 522 mm[size(II)] = m[i]; 523 } 524 } 525 II = normalize(II); 526 II = subst(II,var(1),0); 527 II = -II; 528 if (size(II)>0) 529 { 530 dbprint(ppl,"// found roots"); 531 dbprint(ppl-1,string(II)); 532 } 533 else 534 { 535 dbprint(ppl,"// found no roots"); 536 } 537 L = list(II,mm); 538 if (ir <> 1) 539 { 540 dbprint(ppl,"// found irreducible factors"); 541 ir = cleardenom(ir); 542 dbprint(ppl-1,string(ir)); 543 L = L + list(string(ir)); 544 } 545 else 546 { 547 dbprint(ppl,"// no irreducible factors found"); 548 } 549 setring save; 550 L = imap(@S,L); 551 return(L); 552 } 553 example 554 { 555 "EXAMPLE:"; echo = 2; 556 ring r = 0,(x,y),dp; 557 bFactor((x^2-1)^2); 558 bFactor((x^2+1)^2); 559 bFactor((y^2+1/2)*(y+9)*(y-7)); 560 } 561 562 proc isInt (number n) 563 "USAGE: isInt(n); n a number 564 RETURN: int, 1 if n is an integer or 0 otherwise 565 PURPOSE: check whether given object of type number is actually an int 566 NOTE: Parameters are treated as integers. 567 EXAMPLE: example isInt; shows an example 568 " 569 { 570 number d = denominator(n); 571 if (d<>1) 572 { 573 return(0); 574 } 575 else 576 { 577 return(1); 578 } 579 } 580 example 581 { 582 "EXAMPLE:"; echo = 2; 583 ring r = 0,x,dp; 584 number n = 4/3; 585 isInt(n); 586 n = 11; 587 isInt(n); 588 } 589 590 proc intRoots (list l) 591 "USAGE: isInt(L); L a list 592 RETURN: list 593 PURPOSE: extracts integer roots from a list given in @code{bFactor} format 594 ASSUME: The input list must be given in the format of @code{bFactor}. 595 NOTE: Parameters are treated as integers. 596 SEE ALSO: bFactor 597 EXAMPLE: example intRoots; shows an example 598 " 599 { 600 int wronginput; 601 int sl = size(l); 602 if (sl>0) 603 { 604 if (typeof(l[1])<>"ideal"){wronginput = 1;} 605 if (sl>1) 606 { 607 if (typeof(l[2])<>"intvec"){wronginput = 1;} 608 if (sl>2) 609 { 610 if (typeof(l[3])<>"string"){wronginput = 1;} 611 if (sl>3){wronginput = 1;} 612 } 613 } 614 } 615 if (sl<2){wronginput = 1;} 616 if (wronginput) 617 { 618 ERROR("Given list has wrong format."); 619 } 620 int i,j; 621 int n = ncols(l[1]); 622 j = 1; 623 ideal I; 624 intvec v; 625 for (i=1; i<=n; i++) 626 { 627 if (size(l[1][j])>1) // poly not number 628 { 629 ERROR("Ideal in list has wrong format."); 630 } 631 if (isInt(leadcoef(l[1][i]))) 632 { 633 I[j] = l[1][i]; 634 v[j] = l[2][i]; 635 j++; 636 } 637 } 638 return(list(I,v)); 639 } 640 example 641 { 642 "EXAMPLE:"; echo = 2; 643 ring r = 0,x,dp; 644 list L = bFactor((x-4/3)*(x+3)^2*(x-5)^4); L; 645 intRoots(L); 646 } 647 648 proc sortIntvec (intvec v) 649 "USAGE: sortIntvec(v); v an intvec 650 RETURN: list of two intvecs 651 PURPOSE: sorts an intvec 652 NOTE: In the output list L, the first entry consists of the entries of v 653 @* satisfying L[1][i] >= L[1][i+1]. The second entry is a permutation 654 @* such that v[L[2]] = L[1]. 655 @* Unlike in the procedure @code{sort}, zeros are not dismissed. 656 SEE ALSO: sort 657 EXAMPLE: example sortintvec; shows examples 658 " 659 { 660 int i; 661 intvec vpos,vzero,vneg,vv,sortv,permv; 662 for (i=1; i<=nrows(v); i++) 663 { 664 if (v[i]>0) 665 { 666 vpos = vpos,i; 667 } 668 else 669 { 670 if (v[i]==0) 671 { 672 vzero = vzero,i; 673 } 674 else // v[i]<0 675 { 676 vneg = vneg,i; 677 } 678 } 679 } 680 if (size(vpos)>1) 681 { 682 vpos = vpos[2..size(vpos)]; 683 vv = v[vpos]; 684 list l = sort(vv); 685 vv = l[1]; 686 vpos = vpos[l[2]]; 687 sortv = vv[size(vv)..1]; 688 permv = vpos[size(vv)..1]; 689 } 690 if (size(vzero)>1) 691 { 692 vzero = vzero[2..size(vzero)]; 693 permv = permv,vzero; 694 sortv = sortv,0:size(vzero); 695 } 696 if (size(vneg)>1) 697 { 698 vneg = vneg[2..size(vneg)]; 699 vv = -v[vneg]; 700 l = sort(vv); 701 vv = -l[1]; 702 vneg = vneg[l[2]]; 703 sortv = sortv,vv; 704 permv = permv,vneg; 705 } 706 if (permv[1]==0) 707 { 708 sortv = sortv[2..size(sortv)]; 709 permv = permv[2..size(permv)]; 710 } 711 return(list(sortv,permv)); 712 } 713 example 714 { 715 "EXAMPLE:"; echo = 2; 716 ring r = 0,x,dp; 717 intvec v = -1,0,1,-2,0,2; 718 list L = sortIntvec(v); L; 719 v[L[2]]; 720 } 721 722 723 // F-saturation /////////////////////////////////////////////////////////////// 724 404 725 proc isFsat(ideal I, poly F) 405 726 "USAGE: isFsat(I, F); I an ideal, F a poly 406 RETURN: int727 RETURN: int 407 728 PURPOSE: check whether the ideal I is F-saturated 408 729 NOTE: 1 is returned if I is F-saturated, otherwise 0 is returned. 409 @* we check indeed that Ker(D --F--> D/I) is (0)730 @* we check indeed that Ker(D --F--> D/I) is (0) 410 731 EXAMPLE: example isFsat; shows examples 411 732 " … … 439 760 } 440 761 762 763 // annihilators /////////////////////////////////////////////////////////////// 764 765 proc annRat(poly g, poly f) 766 "USAGE: annRat(g,f); f, g polynomials 767 RETURN: ring 768 PURPOSE: compute the annihilator of a rational function g/f in the Weyl algebra 769 NOTE: Activate the output ring with the @code{setring} command. 770 @* In the output ring, the ideal LD (in Groebner basis) is the 771 @* annihilator. 772 @* The algorithm uses the computation of ann f^{-1} via D-modules. 773 DISPLAY: If printlevel =1, progress debug messages will be printed, 774 @* if printlevel>=2, all the debug messages will be printed. 775 SEE ALSO: annPoly 776 EXAMPLE: example annRat; shows examples 777 " 778 { 779 780 if (dmodappassumeViolation()) 781 { 782 ERROR("Basering is inappropriate: characteristic>0 or qring present"); 783 } 784 785 // assumptions: f is not a constant 786 if (f==0) { ERROR("Denominator cannot be zero"); } 787 if (leadexp(f) == 0) 788 { 789 // f = const, so use annPoly 790 g = g/f; 791 def @R = annPoly(g); 792 return(@R); 793 } 794 // computes the annihilator of g/f 795 def save = basering; 796 int ppl = printlevel-voice+2; 797 dbprint(ppl,"// -1-[annRat] computing the ann f^s"); 798 def @R1 = SannfsBM(f); 799 setring @R1; 800 poly f = imap(save,f); 801 int i,mir; 802 int isr = 0; // checkRoot1(LD,f,1); // roots are negative, have to enter positive int 803 if (!isr) 804 { 805 // -1 is not the root 806 // find the m.i.r iteratively 807 mir = 0; 808 for(i=nvars(save)+1; i>=1; i--) 809 { 810 isr = checkRoot1(LD,f,i); 811 if (isr) { mir =-i; break; } 812 } 813 if (mir ==0) 814 { 815 "No integer root found! Aborting computations, inform the authors!"; 816 return(0); 817 } 818 // now mir == i is m.i.r. 819 } 820 else 821 { 822 // -1 is the m.i.r 823 mir = -1; 824 } 825 dbprint(ppl,"// -2-[annRat] the minimal integer root is "); 826 dbprint(ppl-1, mir); 827 // use annfspecial 828 dbprint(ppl,"// -3-[annRat] running annfspecial "); 829 ideal AF = annfspecial(LD,f,mir,-1); // ann f^{-1} 830 // LD = subst(LD,s,j); 831 // LD = engine(LD,0); 832 // modify the ring: throw s away 833 // output ring comes from SannfsBM 834 list U = ringlist(@R1); 835 list tmp; // variables 836 for(i=1; i<=size(U[2])-1; i++) 837 { 838 tmp[i] = U[2][i]; 839 } 840 U[2] = tmp; 841 tmp = 0; 842 tmp[1] = U[3][1]; // x,Dx block 843 tmp[2] = U[3][3]; // module block 844 U[3] = tmp; 845 tmp = 0; 846 tmp = U[1],U[2],U[3],U[4]; 847 def @R2 = ring(tmp); 848 setring @R2; 849 // now supply with Weyl algebra relations 850 int N = nvars(@R2)/2; 851 matrix @D[2*N][2*N]; 852 for(i=1; i<=N; i++) 853 { 854 @D[i,N+i]=1; 855 } 856 def @R3 = nc_algebra(1,@D); 857 setring @R3; 858 dbprint(ppl,"// - -[annRat] ring without s is ready:"); 859 dbprint(ppl-1,@R3); 860 poly g = imap(save,g); 861 matrix G[1][1] = g; 862 matrix LL = matrix(imap(@R1,AF)); 863 kill @R1; kill @R2; 864 dbprint(ppl,"// -4-[annRat] running modulo"); 865 ideal LD = modulo(G,LL); 866 dbprint(ppl,"// -4-[annRat] running GB on the final result"); 867 LD = engine(LD,0); 868 export LD; 869 return(@R3); 870 } 871 example 872 { 873 "EXAMPLE:"; echo = 2; 874 ring r = 0,(x,y),dp; 875 poly g = 2*x*y; poly f = x^2 - y^3; 876 def B = annRat(g,f); 877 setring B; 878 LD; 879 // Now, compare with the output of Macaulay2: 880 ideal tst = 3*x*Dx + 2*y*Dy + 1, y^3*Dy^2 - x^2*Dy^2 + 6*y^2*Dy + 6*y, 881 9*y^2*Dx^2*Dy-4*y*Dy^3+27*y*Dx^2+2*Dy^2, 9*y^3*Dx^2-4*y^2*Dy^2+10*y*Dy -10; 882 option(redSB); option(redTail); 883 LD = groebner(LD); 884 tst = groebner(tst); 885 print(matrix(NF(LD,tst))); print(matrix(NF(tst,LD))); 886 // So, these two answers are the same 887 } 888 889 proc annPoly(poly f) 890 "USAGE: annPoly(f); f a poly 891 RETURN: ring 892 PURPOSE: compute the complete annihilator ideal of f in the Weyl algebra D 893 NOTE: activate the output ring with the @code{setring} command. 894 @* In the output ring, the ideal LD (in Groebner basis) is the 895 @* annihilator. 896 DISPLAY: If printlevel =1, progress debug messages will be printed, 897 @* if printlevel>=2, all the debug messages will be printed. 898 SEE ALSO: annRat 899 EXAMPLE: example annPoly; shows examples 900 " 901 { 902 // computes a system of linear PDEs with polynomial coeffs for f 903 def save = basering; 904 list L = ringlist(save); 905 list Name = L[2]; 906 int N = nvars(save); 907 int i; 908 for (i=1; i<=N; i++) 909 { 910 Name[N+i] = "D"+Name[i]; // concat 911 } 912 L[2] = Name; 913 def @R = ring(L); 914 setring @R; 915 def @@R = Weyl(); 916 setring @@R; 917 kill @R; 918 matrix M[1][N]; 919 for (i=1; i<=N; i++) 920 { 921 M[1,i] = var(N+i); 922 } 923 matrix F[1][1] = imap(save,f); 924 ideal I = modulo(F,M); 925 ideal LD = groebner(I); 926 export LD; 927 return(@@R); 928 } 929 example 930 { 931 "EXAMPLE:"; echo = 2; 932 ring r = 0,(x,y,z),dp; 933 poly f = x^2*z - y^3; 934 def A = annPoly(f); 935 setring A; // A is the 3rd Weyl algebra in 6 variables 936 LD; // the Groebner basis of annihilator 937 gkdim(LD); // must be 3 = 6/2, since A/LD is holonomic module 938 NF(Dy^4, LD); // must be 0 since Dy^4 clearly annihilates f 939 } 940 941 942 943 // localizations ////////////////////////////////////////////////////////////// 944 441 945 proc DLoc(ideal I, poly F) 442 946 "USAGE: DLoc(I, F); I an ideal, F a poly 443 RETURN: nothing (exports objects instead)444 ASSUME: the basering is a Weyl algebra947 RETURN: nothing (exports objects instead) 948 ASSUME: the basering is a Weyl algebra 445 949 PURPOSE: compute the presentation of the localization of D/I w.r.t. f^s 446 950 NOTE: In the basering, the following objects are exported: 447 @* the ideal LD0 (in Groebner basis) is the presentation of the localization 448 @* the list BS contains roots with multiplicities of Bernstein polynomial of (D/I)_f. 449 DISPLAY: If printlevel=1, progress debug messages will be printed, 951 @* - the ideal LD0 (in Groebner basis) is the presentation of the 952 @* localization, 953 @* - the list BS contains roots with multiplicities of Bernstein 954 @* polynomial of (D/I)_f. 955 DISPLAY: If printlevel =1, progress debug messages will be printed, 450 956 @* if printlevel>=2, all the debug messages will be printed. 451 957 EXAMPLE: example DLoc; shows examples … … 496 1002 DLoc(I, x2-y3); // exports LD0 and BS 497 1003 LD0; // localized module (R/I)_f is isomorphic to R/LD0 498 BS; // description of b-function for localization1004 BS; // description of b-function for localization 499 1005 } 500 1006 … … 503 1009 RETURN: ring 504 1010 PURPOSE: compute the presentation of the localization of D/I w.r.t. f^s, 505 @* 506 ASSUME: the basering is similar to the output ring of SDLoc procedure1011 @* where D is a Weyl Algebra, based on the output of procedure SDLoc 1012 ASSUME: the basering is similar to the output ring of SDLoc procedure 507 1013 NOTE: activate this ring with the @code{setring} command. In this ring, 508 @* the ideal LD0 (in Groebner basis) is the presentation of the localization 509 @* the list BS contains roots and multiplicities of Bernstein polynomial of (D/I)_f. 510 DISPLAY: If printlevel=1, progress debug messages will be printed, 1014 @* - the ideal LD0 (in Groebner basis) is the presentation of the 1015 localization, 1016 @* - the list BS contains roots and multiplicities of Bernstein 1017 polynomial of (D/I)_f. 1018 DISPLAY: If printlevel =1, progress debug messages will be printed, 511 1019 @* if printlevel>=2, all the debug messages will be printed. 512 1020 EXAMPLE: example DLoc0; shows examples … … 741 1249 } 742 1250 743 744 1251 proc SDLoc(ideal I, poly F) 745 1252 "USAGE: SDLoc(I, F); I an ideal, F a poly 746 1253 RETURN: ring 747 1254 PURPOSE: compute a generic presentation of the localization of D/I w.r.t. f^s 748 ASSUME: the basering D is a Weyl algebra1255 ASSUME: the basering D is a Weyl algebra 749 1256 NOTE: activate this ring with the @code{setring} command. In this ring, 750 @* the ideal LD (in Groebner basis) is the presentation of the localization 751 DISPLAY: If printlevel=1, progress debug messages will be printed, 1257 @* the ideal LD (in Groebner basis) is the presentation of the 1258 @* localization 1259 DISPLAY: If printlevel =1, progress debug messages will be printed, 752 1260 @* if printlevel>=2, all the debug messages will be printed. 753 1261 EXAMPLE: example SDLoc; shows examples … … 953 1461 ideal I = Dx*F, Dy*F; 954 1462 // note, that I is not holonomic, since it's dimension is not 2 955 gkdim(I); // 3, while dim R = 41463 gkdim(I); // 3, while dim R = 4 956 1464 def W = SDLoc(I,F); 957 1465 setring W; // = R[s], where s is a new variable 958 LD; // Groebner basis of s-parametric presentation 959 } 960 961 proc annRat(poly g, poly f) 962 "USAGE: annRat(g,f); f, g polynomials 963 RETURN: ring 964 PURPOSE: compute the annihilator of the rational function g/f in the Weyl algebra D 965 NOTE: activate the output ring with the @code{setring} command. 966 @* In the output ring, the ideal LD (in Groebner basis) is the annihilator. 967 @* The algorithm uses the computation of ann f^{-1} via D-modules. 1466 LD; // Groebner basis of s-parametric presentation 1467 } 1468 1469 1470 // Groebner basis wrt weights and initial ideal business ////////////////////// 1471 1472 proc GBWeight (ideal I, intvec u, intvec v, list #) 1473 "USAGE: GBWeight(I,u,v [,s,t,w]); 1474 @* I ideal, u,v intvecs, s,t optional ints, w an optional intvec 1475 RETURN: ideal, Groebner basis of I w.r.t. the weights u and v 1476 ASSUME: The basering is the n-th Weyl algebra in characteristic 0 and for all 1477 @* 1<=i<=n the identity var(i+n)*var(i)=var(i)*var(i+1)+1 holds, i.e. the 1478 @* sequence of variables is given by x(1),...,x(n),D(1),...,D(n), 1479 @* where D(i) is the differential operator belonging to x(i). 1480 PURPOSE: computes a Groebner basis with respect to given weights 1481 NOTE: u and v are understood as weight vectors for x(i) and D(i), 1482 @* respectively. 1483 @* If s<>0, @code{std} is used for Groebner basis computations, 1484 @* otherwise, and by default, @code{slimgb} is used. 1485 @* If t<>0, a matrix ordering is used for Groebner basis computations, 1486 @* otherwise, and by default, a block ordering is used. 1487 @* If w is given and consists of exactly 2*n strictly positive entries, 1488 @* w is used as homogenization weight. 1489 @* Otherwise, and by default, the homogenization weight (1,...,1) is used. 968 1490 DISPLAY: If printlevel=1, progress debug messages will be printed, 969 1491 @* if printlevel>=2, all the debug messages will be printed. 970 SEE ALSO: annPoly 971 EXAMPLE: example annRat; shows examples 1492 EXAMPLE: example GBWeight; shows examples 972 1493 " 973 1494 { 974 975 if (dmodappassumeViolation()) 976 { 977 ERROR("Basering is inappropriate: characteristic>0 or qring present"); 978 } 979 980 // assumptions: f is not a constant 981 if (f==0) { ERROR("Denominator cannot be zero"); } 982 if (leadexp(f) == 0) 983 { 984 // f = const, so use annPoly 985 g = g/f; 986 def @R = annPoly(g); 987 return(@R); 988 } 989 // computes the annihilator of g/f 1495 dmodappMoreAssumeViolation(); 1496 int ppl = printlevel - voice +2; 990 1497 def save = basering; 991 int ppl = printlevel-voice+2; 992 dbprint(ppl,"// -1-[annRat] computing the ann f^s"); 993 def @R1 = SannfsBM(f); 994 setring @R1; 995 poly f = imap(save,f); 996 int i,mir; 997 int isr = 0; // checkRoot1(LD,f,1); // roots are negative, have to enter positive int 998 if (!isr) 999 { 1000 // -1 is not the root 1001 // find the m.i.r iteratively 1002 mir = 0; 1003 for(i=nvars(save)+1; i>=1; i--) 1004 { 1005 isr = checkRoot1(LD,f,i); 1006 if (isr) { mir =-i; break; } 1007 } 1008 if (mir ==0) 1009 { 1010 "No integer root found! Aborting computations, inform the authors!"; 1011 return(0); 1012 } 1013 // now mir == i is m.i.r. 1014 } 1015 else 1016 { 1017 // -1 is the m.i.r 1018 mir = -1; 1019 } 1020 dbprint(ppl,"// -2-[annRat] the minimal integer root is "); 1021 dbprint(ppl-1, mir); 1022 // use annfspecial 1023 dbprint(ppl,"// -3-[annRat] running annfspecial "); 1024 ideal AF = annfspecial(LD,f,mir,-1); // ann f^{-1} 1025 // LD = subst(LD,s,j); 1026 // LD = engine(LD,0); 1027 // modify the ring: throw s away 1028 // output ring comes from SannfsBM 1029 list U = ringlist(@R1); 1030 list tmp; // variables 1031 for(i=1; i<=size(U[2])-1; i++) 1032 { 1033 tmp[i] = U[2][i]; 1034 } 1035 U[2] = tmp; 1036 tmp = 0; 1037 tmp[1] = U[3][1]; // x,Dx block 1038 tmp[2] = U[3][3]; // module block 1039 U[3] = tmp; 1040 tmp = 0; 1041 tmp = U[1],U[2],U[3],U[4]; 1042 def @R2 = ring(tmp); 1043 setring @R2; 1044 // now supply with Weyl algebra relations 1045 int N = nvars(@R2)/2; 1046 matrix @D[2*N][2*N]; 1047 for(i=1; i<=N; i++) 1048 { 1049 @D[i,N+i]=1; 1050 } 1051 def @R3 = nc_algebra(1,@D); 1052 setring @R3; 1053 dbprint(ppl,"// - -[annRat] ring without s is ready:"); 1054 dbprint(ppl-1,@R3); 1055 poly g = imap(save,g); 1056 matrix G[1][1] = g; 1057 matrix LL = matrix(imap(@R1,AF)); 1058 kill @R1; kill @R2; 1059 dbprint(ppl,"// -4-[annRat] running modulo"); 1060 ideal LD = modulo(G,LL); 1061 dbprint(ppl,"// -4-[annRat] running GB on the final result"); 1062 LD = engine(LD,0); 1063 export LD; 1064 return(@R3); 1498 int n = nvars(save)/2; 1499 int whichengine = 0; // default 1500 int methodord = 0; // default 1501 intvec homogweights = 1:(2*n); // default 1502 if (size(#)>0) 1503 { 1504 if (typeof(#[1])=="int" || typeof(#[1])=="number") 1505 { 1506 whichengine = int(#[1]); 1507 } 1508 if (size(#)>1) 1509 { 1510 if (typeof(#[2])=="int" || typeof(#[2])=="number") 1511 { 1512 methodord = int(#[2]); 1513 } 1514 if (size(#)>2) 1515 { 1516 if (typeof(#[3])=="intvec") 1517 { 1518 if (size(#[3])==2*n && allPositive(#[3])==1) 1519 { 1520 homogweights = #[3]; 1521 } 1522 else 1523 { 1524 print("// Homogenization weight vector must consist of positive entries and be"); 1525 print("// of size " + string(n) + ". Using weight (1,...,1)."); 1526 } 1527 } 1528 } 1529 } 1530 } 1531 // 1. create homogenized Weyl algebra 1532 // 1.1 create ordering 1533 int i; 1534 list RL = ringlist(save); 1535 int N = 2*n+1; 1536 intvec uv = u,v,0; 1537 homogweights = homogweights,1; 1538 list Lord = list(list("a",homogweights)); 1539 list C0 = list("C",intvec(0)); 1540 if (methodord == 0) // default: blockordering 1541 { 1542 Lord[2] = list("a",uv); 1543 Lord[3] = list("dp",intvec(1:(N-1))); 1544 Lord[4] = list("lp",intvec(1)); 1545 Lord[5] = C0; 1546 } 1547 else // M() ordering 1548 { 1549 intmat @Ord[N][N]; 1550 @Ord[1,1..N] = uv; @Ord[2,1..N] = 1:(N-1); 1551 for (i=1; i<=N-2; i++) 1552 { 1553 @Ord[2+i,N - i] = -1; 1554 } 1555 dbprint(ppl-1,"// the ordering matrix:",@Ord); 1556 Lord[2] = list("M",intvec(@Ord)); 1557 Lord[3] = C0; 1558 } 1559 // 1.2 the homog var 1560 list Lvar = RL[2]; Lvar[N] = safeVarName("h","cv"); 1561 // 1.3 create commutative ring 1562 list L@@Dh = RL; L@@Dh = L@@Dh[1..4]; 1563 L@@Dh[2] = Lvar; L@@Dh[3] = Lord; 1564 def @Dh = ring(L@@Dh); kill L@@Dh; 1565 setring @Dh; 1566 // 1.4 create non-commutative relations 1567 matrix @relD[N][N]; 1568 for (i=1; i<=n; i++) 1569 { 1570 @relD[i,n+i] = var(N)^(homogweights[i]+homogweights[n+i]); 1571 } 1572 def Dh = nc_algebra(1,@relD); 1573 setring Dh; kill @Dh; 1574 dbprint(ppl-1,"// computing in ring",Dh); 1575 // 2. Compute the initial ideal 1576 ideal I = imap(save,I); 1577 I = homog(I,h); 1578 // 2.1 the hard part: Groebner basis computation 1579 dbprint(ppl, "// starting Groebner basis computation with engine: "+string(whichengine)); 1580 I = engine(I, whichengine); 1581 dbprint(ppl, "// finished Groebner basis computation"); 1582 dbprint(ppl-1, "// ideal before dehomogenization is " +string(I)); 1583 I = subst(I,var(N),1); // dehomogenization 1584 setring save; 1585 I = imap(Dh,I); kill Dh; 1586 return(I); 1065 1587 } 1066 1588 example 1067 1589 { 1068 1590 "EXAMPLE:"; echo = 2; 1069 ring r = 0,(x,y),dp; 1070 poly g = 2*x*y; poly f = x^2 - y^3; 1071 def B = annRat(g,f); 1072 setring B; 1073 LD; 1074 // Now, compare with the output of Macaulay2: 1075 ideal tst = 3*x*Dx + 2*y*Dy + 1, y^3*Dy^2 - x^2*Dy^2 + 6*y^2*Dy + 6*y, 1076 9*y^2*Dx^2*Dy-4*y*Dy^3+27*y*Dx^2+2*Dy^2, 9*y^3*Dx^2-4*y^2*Dy^2+10*y*Dy -10; 1077 option(redSB); option(redTail); 1078 LD = groebner(LD); 1079 tst = groebner(tst); 1080 print(matrix(NF(LD,tst))); print(matrix(NF(tst,LD))); 1081 // So, these two answers are the same 1082 } 1083 1084 /* 1085 //static proc ex_annRat() 1086 { 1087 // more complicated example for annRat 1088 ring r = 0,(x,y,z),dp; 1089 poly f = x3+y3+z3; // mir = -2 1090 poly g = x*y*z; 1091 def A = annRat(g,f); 1092 setring A; 1093 } 1094 */ 1095 1096 proc annPoly(poly f) 1097 "USAGE: annPoly(f); f a poly 1098 RETURN: ring 1099 PURPOSE: compute the complete annihilator ideal of f in the Weyl algebra D 1100 NOTE: activate the output ring with the @code{setring} command. 1101 @* In the output ring, the ideal LD (in Groebner basis) is the annihilator. 1591 ring r = 0,(x,y,Dx,Dy),dp; 1592 def D2 = Weyl(); 1593 setring D2; 1594 ideal I = 3*x^2*Dy+2*y*Dx,2*x*Dx+3*y*Dy+6; I = std(I); 1595 intvec u = -2,-3; 1596 intvec v = -u; 1597 GBWeight(I,u,v); 1598 u = 0,1; 1599 GBWeight(I,u,v); 1600 } 1601 1602 proc inForm (ideal I, intvec w) 1603 "USAGE: inForm(I,w); I ideal, w intvec 1604 RETURN: ideal, the initial form of I w.r.t. the weight vector w 1605 PURPOSE: computes the initial form of an ideal w.r.t. a given weight vector 1606 NOTE: the size of the weight vector must be equal to the number of variables 1607 @* of the basering. 1608 EXAMPLE: example inForm; shows examples 1609 " 1610 { 1611 if (size(w) != nvars(basering)) 1612 { 1613 ERROR("weight vector has wrong dimension"); 1614 } 1615 if (I == 0) 1616 { 1617 return(I); 1618 } 1619 int j,i,s,m; 1620 list l; 1621 poly g; 1622 ideal J; 1623 for (j=1; j<=ncols(I); j++) 1624 { 1625 l = poly2list(I[j]); 1626 m = scalarProd(w,l[1][1]); 1627 g = l[1][2]; 1628 for (i=2; i<=size(l); i++) 1629 { 1630 s = scalarProd(w,l[i][1]); 1631 if (s == m) 1632 { 1633 g = g + l[i][2]; 1634 } 1635 else 1636 { 1637 if (s > m) 1638 { 1639 m = s; 1640 g = l[i][2]; 1641 } 1642 } 1643 } 1644 J[j] = g; 1645 } 1646 return(J); 1647 } 1648 example 1649 { 1650 "EXAMPLE:"; echo = 2; 1651 ring @D = 0,(x,y,Dx,Dy),dp; 1652 def D = Weyl(); 1653 setring D; 1654 poly F = 3*x^2*Dy+2*y*Dx; 1655 poly G = 2*x*Dx+3*y*Dy+6; 1656 ideal I = F,G; 1657 intvec w1 = -1,-1,1,1; 1658 intvec w2 = -1,-2,1,2; 1659 intvec w3 = -2,-3,2,3; 1660 inForm(I,w1); 1661 inForm(I,w2); 1662 inForm(I,w3); 1663 } 1664 1665 proc initialIdealW(ideal I, intvec u, intvec v, list #) 1666 "USAGE: initialIdealW(I,u,v [,s,t,w]); 1667 @* I ideal, u,v intvecs, s,t optional ints, w an optional intvec 1668 RETURN: ideal, GB of initial ideal of the input ideal wrt the weights u and v 1669 ASSUME: The basering is the n-th Weyl algebra in characteristic 0 and for all 1670 @* 1<=i<=n the identity var(i+n)*var(i)=var(i)*var(i+1)+1 holds, i.e. the 1671 @* sequence of variables is given by x(1),...,x(n),D(1),...,D(n), 1672 @* where D(i) is the differential operator belonging to x(i). 1673 PURPOSE: computes the initial ideal with respect to given weights. 1674 NOTE: u and v are understood as weight vectors for x(1..n) and D(1..n) 1675 @* respectively. 1676 @* If s<>0, @code{std} is used for Groebner basis computations, 1677 @* otherwise, and by default, @code{slimgb} is used. 1678 @* If t<>0, a matrix ordering is used for Groebner basis computations, 1679 @* otherwise, and by default, a block ordering is used. 1680 @* If w is given and consists of exactly 2*n strictly positive entries, 1681 @* w is used as homogenization weight. 1682 @* Otherwise, and by default, the homogenization weight (1,...,1) is used. 1102 1683 DISPLAY: If printlevel=1, progress debug messages will be printed, 1103 1684 @* if printlevel>=2, all the debug messages will be printed. 1104 SEE ALSO: annRat 1105 EXAMPLE: example annPoly; shows examples 1685 EXAMPLE: example initialIdealW; shows examples 1106 1686 " 1107 1687 { 1108 // computes a system of linear PDEs with polynomial coeffs for f 1688 // assumption check in GBWeight 1689 int ppl = printlevel - voice + 2; 1690 printlevel = printlevel + 1; 1691 I = GBWeight(I,u,v,#); 1692 printlevel = printlevel - 1; 1693 intvec uv = u,v; 1694 I = inForm(I,uv); 1695 int eng; 1696 if (size(#)>0) 1697 { 1698 if(typeof(#[1])=="int" || typeof(#[1])=="number") 1699 { 1700 eng = int(#[1]); 1701 } 1702 } 1703 dbprint(ppl,"// starting cosmetic Groebner basis computation"); 1704 I = engine(I,eng); 1705 dbprint(ppl,"// finished cosmetic Groebner basis computation"); 1706 return(I); 1707 } 1708 example 1709 { 1710 "EXAMPLE:"; echo = 2; 1711 ring r = 0,(x,y,Dx,Dy),dp; 1712 def D2 = Weyl(); 1713 setring D2; 1714 ideal I = 3*x^2*Dy+2*y*Dx,2*x*Dx+3*y*Dy+6; I = std(I); 1715 intvec u = -2,-3; 1716 intvec v = -u; 1717 initialIdealW(I,u,v); 1718 u = 0,1; 1719 initialIdealW(I,u,v); 1720 } 1721 1722 proc initialMalgrange (poly f,list #) 1723 "USAGE: initialMalgrange(f,[,a,b,v]); f poly, a,b optional ints, v opt. intvec 1724 RETURN: ring, Weyl algebra induced by basering, extended by two new vars t,Dt 1725 PURPOSE: computes the initial Malgrange ideal of a given polynomial w.r.t. the weight 1726 @* vector (-1,0...,0,1,0,...,0) such that the weight of t is -1 and the 1727 @* weight of Dt is 1. 1728 ASSUME: The basering is commutative and of characteristic 0. 1729 NOTE: Activate the output ring with the @code{setring} command. 1730 @* The returned ring contains the ideal \"inF\", being the initial ideal 1731 @* of the Malgrange ideal of f. 1732 @* Varnames of the basering should not include t and Dt. 1733 @* If a<>0, @code{std} is used for Groebner basis computations, 1734 @* otherwise, and by default, @code{slimgb} is used. 1735 @* If b<>0, a matrix ordering is used for Groebner basis computations, 1736 @* otherwise, and by default, a block ordering is used. 1737 @* If a positive weight vector v is given, the weight 1738 @* (d,v[1],...,v[n],1,d+1-v[1],...,d+1-v[n]) is used for homogenization 1739 @* computations, where d denotes the weighted degree of f. 1740 @* Otherwise and by default, v is set to (1,...,1). See Noro, 2002. 1741 DISPLAY: If printlevel=1, progress debug messages will be printed, 1742 @* if printlevel>=2, all the debug messages will be printed. 1743 EXAMPLE: example initialMalgrange; shows examples 1744 " 1745 { 1746 if (dmodappassumeViolation()) 1747 { 1748 ERROR("Basering is inappropriate: characteristic>0 or qring present"); 1749 } 1750 if (!isCommutative()) 1751 { 1752 ERROR("Basering must be commutative."); 1753 } 1754 int ppl = printlevel - voice + 2; 1109 1755 def save = basering; 1110 list L = ringlist(save); 1111 list Name = L[2]; 1112 int N = nvars(save); 1756 int n = nvars(save); 1113 1757 int i; 1114 for (i=1; i<=N; i++) 1115 { 1116 Name[N+i] = "D"+Name[i]; // concat 1117 } 1118 L[2] = Name; 1119 def @R = ring(L); 1120 setring @R; 1121 def @@R = Weyl(); 1122 setring @@R; 1123 kill @R; 1124 matrix M[1][N]; 1125 for (i=1; i<=N; i++) 1126 { 1127 M[1,i] = var(N+i); 1128 } 1129 matrix F[1][1] = imap(save,f); 1130 ideal I = modulo(F,M); 1131 ideal LD = groebner(I); 1132 export LD; 1133 return(@@R); 1758 int whichengine = 0; // default 1759 int methodord = 0; // default 1760 intvec u0 = 1:n; // default 1761 if (size(#)>0) 1762 { 1763 if (typeof(#[1])=="int" || typeof(#[1])=="number") 1764 { 1765 whichengine = int(#[1]); 1766 } 1767 if (size(#)>1) 1768 { 1769 if (typeof(#[2])=="int" || typeof(#[2])=="number") 1770 { 1771 methodord = int(#[2]); 1772 } 1773 if (size(#)>2) 1774 { 1775 if (typeof(#[3])=="intvec" && size(#[3])==n && allPositive(#[3])==1) 1776 { 1777 u0 = #[3]; 1778 } 1779 } 1780 } 1781 } 1782 // creating the homogenized extended Weyl algebra 1783 list RL = ringlist(save); 1784 RL = RL[1..4]; // if basering is commutative nc_algebra 1785 list C0 = list("C",intvec(0)); 1786 // 1. create homogenization weights 1787 // 1.1. get the weighted degree of f 1788 list Lord = list(list("wp",u0),C0); 1789 list L@r = RL; 1790 L@r[3] = Lord; 1791 def r = ring(L@r); kill L@r,Lord; 1792 setring r; 1793 poly f = imap(save,f); 1794 int d = deg(f); 1795 setring save; kill r; 1796 // 1.2 the homogenization weights 1797 intvec homogweights = d; 1798 homogweights[n+2] = 1; 1799 for (i=1; i<=n; i++) 1800 { 1801 homogweights[i+1] = u0[i]; 1802 homogweights[n+2+i] = d+1-u0[i]; 1803 } 1804 // 2. create extended Weyl algebra 1805 int N = 2*n+2; 1806 // 2.1 create names for vars 1807 string vart = safeVarName("t","cv"); 1808 string varDt = safeVarName("D"+vart,"cv"); 1809 while (varDt <> "D"+vart) 1810 { 1811 vart = safeVarName("@"+vart,"cv"); 1812 varDt = safeVarName("D"+vart,"cv"); 1813 } 1814 list Lvar; 1815 Lvar[1] = vart; Lvar[n+2] = varDt; 1816 for (i=1; i<=n; i++) 1817 { 1818 Lvar[i+1] = string(var(i)); 1819 Lvar[i+n+2] = safeVarName("D" + string(var(i)),"cv"); 1820 } 1821 // 2.2 create ordering 1822 list Lord = list(list("dp",intvec(1:N)),C0); 1823 // 2.3 create the (n+1)-th Weyl algebra 1824 list L@D = RL; L@D[2] = Lvar; L@D[3] = Lord; 1825 def @D = ring(L@D); kill L@D; 1826 setring @D; 1827 def D = Weyl(); 1828 setring D; kill @D; 1829 dbprint(ppl,"// the (n+1)-th Weyl algebra :" ,D); 1830 // 3. compute the initial ideal 1831 // 3.1 create the Malgrange ideal 1832 poly f = imap(save,f); 1833 ideal I = var(1)-f; 1834 for (i=1; i<=n; i++) 1835 { 1836 I = I, var(n+2+i)+diff(f,var(i+1))*var(n+2); 1837 } 1838 // I = engine(I,whichengine); // todo is it efficient to compute a GB first wrt dp first? 1839 // 3.2 computie the initial ideal 1840 intvec w = 1,0:n; 1841 printlevel = printlevel + 1; 1842 I = initialIdealW(I,-w,w,whichengine,methodord,homogweights); 1843 printlevel = printlevel - 1; 1844 ideal inF = I; attrib(inF,"isSB",1); 1845 export(inF); 1846 setring save; 1847 return(D); 1134 1848 } 1135 1849 example 1136 1850 { 1137 1851 "EXAMPLE:"; echo = 2; 1852 ring r = 0,(x,y),dp; 1853 poly f = x^2+y^3+x*y^2; 1854 def D = initialMalgrange(f); 1855 setring D; 1856 inF; 1857 setring r; 1858 intvec v = 3,2; 1859 def D2 = initialMalgrange(f,1,1,v); 1860 setring D2; 1861 inF; 1862 } 1863 1864 1865 // restriction and integration //////////////////////////////////////////////// 1866 1867 static proc restrictionModuleEngine (ideal I, intvec w, list #) 1868 // returns list L with 2 entries of type ideal 1869 // L[1]=basis of free module, L[2]=generating system of submodule 1870 // #=eng,m,G; eng=engine; m=min int root of bfctIdeal(I,w); G=GB of I wrt (-w,w) 1871 { 1872 dmodappMoreAssumeViolation(); 1873 if (!isHolonomic(I)) 1874 { 1875 ERROR("Given ideal is not holonomic"); 1876 } 1877 int l0,l0set,Gset; 1878 ideal G; 1879 int whichengine = 0; // default 1880 if (size(#)>0) 1881 { 1882 if (typeof(#[1])=="int" || typeof(#[1])=="number") 1883 { 1884 whichengine = int(#[1]); 1885 } 1886 if (size(#)>1) 1887 { 1888 if (typeof(#[2])=="int" || typeof(#[2])=="number") 1889 { 1890 l0 = int(#[2]); 1891 l0set = 1; 1892 } 1893 if (size(#)>2) 1894 { 1895 if (typeof(#[3])=="ideal") 1896 { 1897 G = #[3]; 1898 Gset = 1; 1899 } 1900 } 1901 } 1902 } 1903 int ppl = printlevel; 1904 int i,j,k; 1905 int n = nvars(basering)/2; 1906 if (w == intvec(0)) 1907 { 1908 ERROR("weight vector must not be zero"); 1909 } 1910 if (size(w)<>n) 1911 { 1912 ERROR("weight vector must have exactly " + string(n) + " entries"); 1913 } 1914 for (i=1; i<=n; i++) 1915 { 1916 if (w[i]<0) 1917 { 1918 ERROR("weight vector must not have negative entries"); 1919 } 1920 } 1921 intvec ww = -w,w; 1922 if (!Gset) 1923 { 1924 G = GBWeight(I,-w,w,whichengine); 1925 dbprint(ppl,"// found GB wrt weight " +string(w)); 1926 dbprint(ppl-1,"// " + string(G)); 1927 } 1928 if (!l0set) 1929 { 1930 ideal inG = inForm(G,ww); 1931 inG = engine(inG,whichengine); 1932 poly s = 0; 1933 for (i=1; i<=n; i++) 1934 { 1935 s = s + w[i]*var(i)*var(i+n); 1936 } 1937 vector v = pIntersect(s,inG); 1938 list L = bFactor(vec2poly(v)); 1939 dbprint(ppl,"// found b-function of given ideal wrt given weight"); 1940 dbprint(ppl-1,"// roots: "+string(L[1])); 1941 dbprint(ppl-1,"// multiplicities: "+string(L[2])); 1942 kill inG,v,s; 1943 L = intRoots(L); // integral roots of b-function 1944 if (L[2]==intvec(0)) // no integral roots 1945 { 1946 return(list(ideal(0),ideal(0))); 1947 } 1948 intvec v; 1949 for (i=1; i<=ncols(L[1]); i++) 1950 { 1951 v[i] = int(L[1][i]); 1952 } 1953 l0 = Max(v); 1954 dbprint(ppl,"// maximal integral root is " +string(l0)); 1955 kill L,v; 1956 } 1957 if (l0 < 0) // maximal integral root is < 0 1958 { 1959 return(list(ideal(0),ideal(0))); 1960 } 1961 intvec m; 1962 for (i=1; i<=size(G); i++) 1963 { 1964 m[i] = deg(G[i],ww); 1965 } 1966 dbprint(ppl,"// weighted degree of generators of GB is " +string(m)); 1967 def save = basering; 1968 list RL = ringlist(save); 1969 RL = RL[1..4]; 1970 list Lvar; 1971 j = 1; 1972 intvec neww; 1973 for (i=1; i<=n; i++) 1974 { 1975 if (w[i]>0) 1976 { 1977 Lvar[j] = string(var(i+n)); 1978 neww[j] = w[i]; 1979 j++; 1980 } 1981 } 1982 list Lord; 1983 Lord[1] = list("dp",intvec(1:n)); 1984 Lord[2] = list("C", intvec(0)); 1985 RL[2] = Lvar; 1986 RL[3] = Lord; 1987 def r = ring(RL); 1988 kill Lvar, Lord, RL; 1989 setring r; 1990 ideal B; 1991 list Blist; 1992 intvec mm = l0,-m+l0; 1993 for (i=0; i<=Max(mm); i++) 1994 { 1995 B = weightKB(std(0),i,neww); 1996 Blist[i+1] = B; 1997 } 1998 setring save; 1999 list Blist = imap(r,Blist); 2000 ideal ff = maxideal(1); 2001 for (i=1; i<=n; i++) 2002 { 2003 if (w[i]<>0) 2004 { 2005 ff[i] = 0; 2006 } 2007 } 2008 map f = save,ff; 2009 ideal B,M; 2010 poly p; 2011 for (i=1; i<=size(G); i++) 2012 { 2013 for (j=1; j<=l0-m[i]+1; j++) 2014 { 2015 B = Blist[j]; 2016 for (k=1; k<=ncols(B); k++) 2017 { 2018 p = B[k]*G[i]; 2019 p = f(p); 2020 M[size(M)+1] = p; 2021 } 2022 } 2023 } 2024 ideal Bl0; 2025 for (i=0; i<=l0; i++) 2026 { 2027 Bl0 = Bl0,Blist[i+1]; 2028 } 2029 Bl0 = deleteGenerator(Bl0,1); 2030 dbprint(ppl,"// found basis of free module"); 2031 dbprint(ppl-1,"// " + string(Blist)); 2032 dbprint(ppl,"// found generators of submodule"); 2033 dbprint(ppl-1,"// " + string(M)); 2034 return(list(Bl0,M)); 2035 } 2036 2037 static proc restrictionModuleOutput (ideal B, ideal N, intvec w, int eng, string str) 2038 // returns ring, which contains module "str" 2039 { 2040 int n = nvars(basering)/2; 2041 int i,j; 2042 def save = basering; 2043 // 1: create new ring 2044 list RL = ringlist(save); 2045 RL = RL[1..4]; 2046 list V = RL[2]; 2047 poly prodvar = 1; 2048 int zeropresent; 2049 j = 0; 2050 for (i=1; i<=n; i++) 2051 { 2052 if (w[i]<>0) 2053 { 2054 V = delete(V,i-j); 2055 V = delete(V,i-2*j-1+n); 2056 j = j+1; 2057 prodvar = prodvar*var(i)*var(i+n); 2058 } 2059 else 2060 { 2061 zeropresent = 1; 2062 } 2063 } 2064 if (!zeropresent) // restrict/integrate all vars, return input ring 2065 { 2066 def newR = save; 2067 } 2068 else 2069 { 2070 RL[2] = V; 2071 V = list(); 2072 V[1] = list("C", intvec(0)); 2073 V[2] = list("dp",intvec(1:(2*size(ideal(w))))); 2074 RL[3] = V; 2075 def @D = ring(RL); 2076 setring @D; 2077 def newR = Weyl(); 2078 setring save; 2079 kill @D; 2080 } 2081 // 2. get coker representation of module 2082 module M = coeffs(N,B,prodvar); 2083 if (zeropresent) 2084 { 2085 setring newR; 2086 module M = imap(save,M); 2087 } 2088 M = engine(M,eng); 2089 M = prune(M); 2090 M = engine(M,eng); 2091 execute("module " + str + " = M;"); 2092 execute("export(" + str + ");"); 2093 setring save; 2094 return(newR); 2095 } 2096 2097 proc restrictionModule (ideal I, intvec w, list #) 2098 "USAGE: restrictionModule(I,w,[,eng,m,G]); 2099 @* I ideal, w intvec, eng and m optional ints, G optional ideal 2100 RETURN: ring 2101 ASSUME: The basering is the n-th Weyl algebra in characteristic 0 and for all 2102 @* 1<=i<=n the identity var(i+n)*var(i)=var(i)*var(i+1)+1 holds, i.e. the 2103 @* sequence of variables is given by x(1),...,x(n),D(1),...,D(n), 2104 @* where D(i) is the differential operator belonging to x(i). 2105 @* Further, assume that I is holonomic and that w is n-dimensional with 2106 @* non-negative entries. 2107 PURPOSE: computes the restriction module of a holonomic ideal to the subspace 2108 @* defined by the variables belonging to the non-zero entries of the 2109 @* given intvec. 2110 NOTE: The output ring is the Weyl algebra defined by the zero entries of the 2111 @* given intvec. It contains an object @code{resMod} of type @code{module 2112 @* being the restriction module of the given ideal wrt the given intvec. 2113 @* If there are no zero entries, the input ring is returned. 2114 @* If eng<>0, @code{std} is used for Groebner basis computations, 2115 @* otherwise, and by default, @code{slimgb} is used. 2116 @* The minimal integer root of the b-function of I wrt the weight (-w,w) 2117 @* can be specified via the optional argument m. 2118 @* The optional argument G is used for specifying a Groebner Basis of I 2119 @* wrt the weight (-w,w), that is, the initial form of G generates the 2120 @* initial ideal of I wrt the weight (-w,w). 2121 @* Further note, that the assumptions on m and G (if given) are not 2122 @* checked. 2123 0DISPLAY: If printlevel=1, progress debug messages will be printed, 2124 @* if printlevel>=2, all the debug messages will be printed. 2125 EXAMPLE: example restrictionModule; shows examples 2126 " 2127 { 2128 list L = restrictionModuleEngine(I,w,#); 2129 int eng; 2130 if (size(#)>0) 2131 { 2132 if (typeof(#[1])=="int" || typeof(#[1])=="number") 2133 { 2134 eng = int(#[1]); 2135 } 2136 } 2137 def newR = restrictionModuleOutput(L[1],L[2],w,eng,"resMod"); 2138 return(newR); 2139 } 2140 example 2141 { 2142 "EXAMPLE:"; echo = 2; 2143 ring r = 0,(a,x,b,Da,Dx,Db),dp; 2144 def D3 = Weyl(); 2145 setring D3; 2146 ideal I = a*Db-Dx+2*Da, x*Db-Da, x*Da+a*Da+b*Db+1, 2147 x*Dx-2*x*Da-a*Da, b*Db^2+Dx*Da-Da^2+Db, 2148 a*Dx*Da+2*x*Da^2+a*Da^2+b*Dx*Db+Dx+2*Da; 2149 intvec w = 1,0,0; 2150 def rm = restrictionModule(I,w); 2151 setring rm; rm; 2152 print(resMod); 2153 } 2154 2155 static proc restrictionIdealEngine (ideal I, intvec w, string cf, list #) 2156 { 2157 int eng; 2158 if (size(#)>0) 2159 { 2160 if(typeof(#[1])=="int" || typeof(#[1])=="number") 2161 { 2162 eng = #[1]; 2163 } 2164 } 2165 def save = basering; 2166 if (cf == "restriction") 2167 { 2168 def newR = restrictionModule(I,w,#); 2169 setring newR; 2170 matrix M = resMod; 2171 kill resMod; 2172 } 2173 if (cf == "integral") 2174 { 2175 def newR = integralModule(I,w,#); 2176 setring newR; 2177 matrix M = intMod; 2178 kill intMod; 2179 } 2180 int i,r,c; 2181 r = nrows(M); 2182 c = ncols(M); 2183 ideal J; 2184 if (r == 1) // nothing to do 2185 { 2186 J = M; 2187 } 2188 else 2189 { 2190 matrix zm[r-1][1]; // zero matrix 2191 matrix v[r-1][1]; 2192 for (i=1; i<=c; i++) 2193 { 2194 if (M[1,i]<>0) 2195 { 2196 v = M[2..r,i]; 2197 if (v == zm) 2198 { 2199 J[size(J+1)] = M[1,i]; 2200 } 2201 } 2202 } 2203 } 2204 J = engine(J,eng); 2205 if (cf == "restriction") 2206 { 2207 ideal resIdeal = J; 2208 export(resIdeal); 2209 } 2210 if (cf == "integral") 2211 { 2212 ideal intIdeal = J; 2213 export(intIdeal); 2214 } 2215 setring save; 2216 return(newR); 2217 } 2218 2219 proc restrictionIdeal (ideal I, intvec w, list #) 2220 "USAGE: restrictionIdeal(I,w,[,eng,m,G]); 2221 @* I ideal, w intvec, eng and m optional ints, G optional ideal 2222 RETURN: ring 2223 ASSUME: The basering is the n-th Weyl algebra in characteristic 0 and for all 2224 @* 1<=i<=n the identity var(i+n)*var(i)=var(i)*var(i+1)+1 holds, i.e. the 2225 @* sequence of variables is given by x(1),...,x(n),D(1),...,D(n), 2226 @* where D(i) is the differential operator belonging to x(i). 2227 @* Further, assume that I is holonomic and that w is n-dimensional with 2228 @* non-negative entries. 2229 PURPOSE: computes the restriction ideal of a holonomic ideal to the subspace 2230 @* defined by the variables belonging to the non-zero entries of the 2231 @* given intvec. 2232 NOTE: The output ring is the Weyl algebra defined by the zero entries of the 2233 @* given intvec. It contains an object @code{resIdeal} of type @code{ideal} 2234 @* being the restriction ideal of the given ideal wrt the given intvec. 2235 @* If there are no zero entries, the input ring is returned. 2236 @* If eng<>0, @code{std} is used for Groebner basis computations, 2237 @* otherwise, and by default, @code{slimgb} is used. 2238 @* The minimal integer root of the b-function of I wrt the weight (-w,w) 2239 @* can be specified via the optional argument m. 2240 @* The optional argument G is used for specifying a Groebner basis of I 2241 @* wrt the weight (-w,w), that is, the initial form of G generates the 2242 @* initial ideal of I wrt the weight (-w,w). 2243 @* Further note, that the assumptions on m and G (if given) are not 2244 @* checked. 2245 DISPLAY: If printlevel=1, progress debug messages will be printed, 2246 @* if printlevel>=2, all the debug messages will be printed. 2247 EXAMPLE: example restrictionIdeal; shows examples 2248 " 2249 { 2250 def save = basering; 2251 def rm = restrictionIdealEngine(I,w,"restriction",#); 2252 setring rm; 2253 // export(resIdeal); 2254 setring save; 2255 return(rm); 2256 } 2257 example 2258 { 2259 "EXAMPLE:"; echo = 2; 2260 ring r = 0,(a,x,b,Da,Dx,Db),dp; 2261 def D3 = Weyl(); 2262 setring D3; 2263 ideal I = a*Db-Dx+2*Da, 2264 x*Db-Da, 2265 x*Da+a*Da+b*Db+1, 2266 x*Dx-2*x*Da-a*Da, 2267 b*Db^2+Dx*Da-Da^2+Db, 2268 a*Dx*Da+2*x*Da^2+a*Da^2+b*Dx*Db+Dx+2*Da; 2269 intvec w = 1,0,0; 2270 def D2 = restrictionIdeal(I,w); 2271 setring D2; D2; 2272 resIdeal; 2273 } 2274 2275 proc fourier (ideal I, list #) 2276 "USAGE: fourier(I[,v]); I an ideal, v an optional intvec 2277 RETURN: ideal 2278 PURPOSE: computes the Fourier transform of an ideal in the Weyl algebra 2279 ASSUME: The basering is the n-th Weyl algebra in characteristic 0 and for all 2280 @* 1<=i<=n the identity var(i+n)*var(i)=var(i)*var(i+1)+1 holds, i.e. the 2281 @* sequence of variables is given by x(1),...,x(n),D(1),...,D(n), 2282 @* where D(i) is the differential operator belonging to x(i). 2283 NOTE: If v is an intvec with entries ranging from 1 to n, the Fourier 2284 @* transform of I restricted to the variables given by v is computed. 2285 EXAMPLE: example fourier; shows examples 2286 " 2287 { 2288 dmodappMoreAssumeViolation(); 2289 intvec v; 2290 if (size(#)>0) 2291 { 2292 if(typeof(#[1])=="intvec") 2293 { 2294 v = #[1]; 2295 } 2296 } 2297 int n = nvars(basering)/2; 2298 int i; 2299 if(v <> intvec(0)) 2300 { 2301 v = sortIntvec(v)[1]; 2302 for (i=1; i<size(v); i++) 2303 { 2304 if (v[i] == v[i+1]) 2305 { 2306 ERROR("No double entries allowed in intvec"); 2307 } 2308 } 2309 } 2310 else 2311 { 2312 for (i=1; i<=n; i++) 2313 { 2314 v[i] = i; 2315 } 2316 } 2317 ideal m = maxideal(1); 2318 for (i=1; i<=size(v); i++) 2319 { 2320 if (v[i]<0 || v[i]>n) 2321 { 2322 ERROR("Entries of intvec must range from 1 to "+string(n)); 2323 } 2324 m[v[i]] = -var(v[i]+n); 2325 m[v[i]+n] = var(v[i]); 2326 } 2327 map F = basering,m; 2328 ideal FI = F(I); 2329 return(FI); 2330 } 2331 example 2332 { 2333 "EXAMPLE:"; echo = 2; 2334 ring r = 0,(x,y,Dx,Dy),dp; 2335 def D2 = Weyl(); 2336 setring D2; 2337 ideal I = x*Dx+2*y*Dy+2, x^2*Dx+y*Dx+2*x; 2338 intvec v = 2; 2339 fourier(I,v); 2340 fourier(I); 2341 } 2342 2343 proc inverseFourier (ideal I, list #) 2344 "USAGE: inverseFourier(I[,v]); I an ideal, v an optional intvec 2345 RETURN: ideal 2346 PURPOSE: computes the inverse of the Fourier transform of an ideal in the Weyl 2347 @* algebra 2348 ASSUME: The basering is the n-th Weyl algebra in characteristic 0 and for all 2349 @* 1<=i<=n the identity var(i+n)*var(i)=var(i)*var(i+1)+1 holds, i.e. the 2350 @* sequence of variables is given by x(1),...,x(n),D(1),...,D(n), 2351 @* where D(i) is the differential operator belonging to x(i). 2352 NOTE: If v is an intvec with entries ranging from 1 to n, the inverse Fourier 2353 @* transform of I restricted to the variables given by v is computed. 2354 EXAMPLE: example inverseFourier; shows examples 2355 " 2356 { 2357 dmodappMoreAssumeViolation(); 2358 intvec v; 2359 if (size(#)>0) 2360 { 2361 if(typeof(#[1])=="intvec") 2362 { 2363 v = #[1]; 2364 } 2365 } 2366 int n = nvars(basering)/2; 2367 int i; 2368 if(v <> intvec(0)) 2369 { 2370 v = sortIntvec(v)[1]; 2371 for (i=1; i<size(v); i++) 2372 { 2373 if (v[i] == v[i+1]) 2374 { 2375 ERROR("No double entries allowed in intvec"); 2376 } 2377 } 2378 } 2379 else 2380 { 2381 for (i=1; i<=n; i++) 2382 { 2383 v[i] = i; 2384 } 2385 } 2386 ideal m = maxideal(1); 2387 for (i=1; i<=size(v); i++) 2388 { 2389 if (v[i]<0 || v[i]>n) 2390 { 2391 ERROR("Entries of intvec must range between 1 and "+string(n)); 2392 } 2393 m[v[i]] = var(v[i]+n); 2394 m[v[i]+n] = -var(v[i]); 2395 } 2396 map F = basering,m; 2397 ideal FI = F(I); 2398 return(FI); 2399 } 2400 example 2401 { 2402 "EXAMPLE:"; echo = 2; 2403 ring r = 0,(x,y,Dx,Dy),dp; 2404 def D2 = Weyl(); 2405 setring D2; 2406 ideal I = x*Dx+2*y*Dy+2, x^2*Dx+y*Dx+2*x; 2407 intvec v = 2; 2408 ideal FI = fourier(I); 2409 inverseFourier(FI); 2410 } 2411 2412 proc integralModule (ideal I, intvec w, list #) 2413 "USAGE: integralModule(I,w,[,eng,m,G]); 2414 @* I ideal, w intvec, eng and m optional ints, G optional ideal 2415 RETURN: ring 2416 ASSUME: The basering is the n-th Weyl algebra in characteristic 0 and for all 2417 @* 1<=i<=n the identity var(i+n)*var(i)=var(i)*var(i+1)+1 holds, i.e. the 2418 @* sequence of variables is given by x(1),...,x(n),D(1),...,D(n), 2419 @* where D(i) is the differential operator belonging to x(i). 2420 @* Further, assume that I is holonomic and that w is n-dimensional with 2421 @* non-negative entries. 2422 PURPOSE: computes the integral module of a holonomic ideal to the subspace 2423 @* defined by the variables belonging to the non-zero entries of the 2424 @* given intvec. 2425 NOTE: The output ring is the Weyl algebra defined by the zero entries of the 2426 @* given intvec. It contains an object @code{intMod} of type @code{module} 2427 @* being the integral module of the given ideal wrt the given intvec. 2428 @* If there are no zero entries, the input ring is returned. 2429 @* If eng<>0, @code{std} is used for Groebner basis computations, 2430 @* otherwise, and by default, @code{slimgb} is used. 2431 @* Let F denote the Fourier transform of I wrt w. 2432 @* The minimal integer root of the b-function of F(I) wrt the weight 2433 @* (-w,w) can be specified via the optional argument m. 2434 @* The optional argument G is used for specifying a Groebner Basis of F(I) 2435 @* wrt the weight (-w,w), that is, the initial form of G generates the 2436 @* initial ideal of F(I) wrt the weight (-w,w). 2437 @* Further note, that the assumptions on m and G (if given) are not 2438 @* checked. 2439 DISPLAY: If printlevel=1, progress debug messages will be printed, 2440 @* if printlevel>=2, all the debug messages will be printed. 2441 EXAMPLE: example integralModule; shows examples 2442 " 2443 { 2444 int l0,l0set,Gset; 2445 ideal G; 2446 int whichengine = 0; // default 2447 if (size(#)>0) 2448 { 2449 if (typeof(#[1])=="int" || typeof(#[1])=="number") 2450 { 2451 whichengine = int(#[1]); 2452 } 2453 if (size(#)>1) 2454 { 2455 if (typeof(#[2])=="int" || typeof(#[2])=="number") 2456 { 2457 l0 = int(#[2]); 2458 l0set = 1; 2459 } 2460 if (size(#)>2) 2461 { 2462 if (typeof(#[3])=="ideal") 2463 { 2464 G = #[3]; 2465 Gset = 1; 2466 } 2467 } 2468 } 2469 } 2470 int ppl = printlevel; 2471 int i; 2472 int n = nvars(basering)/2; 2473 intvec v; 2474 for (i=1; i<=n; i++) 2475 { 2476 if (w[i]>0) 2477 { 2478 if (v == intvec(0)) 2479 { 2480 v[1] = i; 2481 } 2482 else 2483 { 2484 v[size(v)+1] = i; 2485 } 2486 } 2487 } 2488 ideal FI = fourier(I,v); 2489 dbprint(ppl,"// computed Fourier transform of given ideal"); 2490 dbprint(ppl-1,"// " + string(FI)); 2491 list L; 2492 if (l0set) 2493 { 2494 if (Gset) // l0 and G given 2495 { 2496 L = restrictionModuleEngine(FI,w,whichengine,l0,G); 2497 } 2498 else // l0 given, G not 2499 { 2500 L = restrictionModuleEngine(FI,w,whichengine,l0); 2501 } 2502 } 2503 else // nothing given 2504 { 2505 L = restrictionModuleEngine(FI,w,whichengine); 2506 } 2507 ideal B,N; 2508 B = inverseFourier(L[1],v); 2509 N = inverseFourier(L[2],v); 2510 def newR = restrictionModuleOutput(B,N,w,whichengine,"intMod"); 2511 return(newR); 2512 } 2513 example 2514 { 2515 "EXAMPLE:"; echo = 2; 2516 ring r = 0,(x,b,Dx,Db),dp; 2517 def D2 = Weyl(); 2518 setring D2; 2519 ideal I = x*Dx+2*b*Db+2, x^2*Dx+b*Dx+2*x; 2520 intvec w = 1,0; 2521 def im = integralModule(I,w); 2522 setring im; im; 2523 print(intMod); 2524 } 2525 2526 proc integralIdeal (ideal I, intvec w, list #) 2527 "USAGE: integralIdeal(I,w,[,eng,m,G]); 2528 @* I ideal, w intvec, eng and m optional ints, G optional ideal 2529 RETURN: ring 2530 ASSUME: The basering is the n-th Weyl algebra in characteristic 0 and for all 2531 @* 1<=i<=n the identity var(i+n)*var(i)=var(i)*var(i+1)+1 holds, i.e. the 2532 @* sequence of variables is given by x(1),...,x(n),D(1),...,D(n), 2533 @* where D(i) is the differential operator belonging to x(i). 2534 @* Further, assume that I is holonomic and that w is n-dimensional with 2535 @* non-negative entries. 2536 PURPOSE: computes the integral ideal of a holonomic ideal to the subspace 2537 @* defined by the variables belonging to the non-zero entries of the 2538 @* given intvec. 2539 NOTE: The output ring is the Weyl algebra defined by the zero entries of the 2540 @* given intvec. It contains an object @code{intIdeal} of type @code{ideal} 2541 @* being the integral ideal of the given ideal wrt the given intvec. 2542 @* If there are no zero entries, the input ring is returned. 2543 @* If eng<>0, @code{std} is used for Groebner basis computations, 2544 @* otherwise, and by default, @code{slimgb} is used. 2545 @* The minimal integer root of the b-function of I wrt the weight (-w,w) 2546 @* can be specified via the optional argument m. 2547 @* The optional argument G is used for specifying a Groebner basis of I 2548 @* wrt the weight (-w,w), that is, the initial form of G generates the 2549 @* initial ideal of I wrt the weight (-w,w). 2550 @* Further note, that the assumptions on m and G (if given) are not 2551 @* checked. 2552 DISPLAY: If printlevel=1, progress debug messages will be printed, 2553 @* if printlevel>=2, all the debug messages will be printed. 2554 EXAMPLE: example integralIdeal; shows examples 2555 " 2556 { 2557 def save = basering; 2558 def im = restrictionIdealEngine(I,w,"integral",#); 2559 setring im; 2560 //export(intIdeal); 2561 setring save; 2562 return(im); 2563 } 2564 example 2565 { 2566 "EXAMPLE:"; echo = 2; 2567 ring r = 0,(x,b,Dx,Db),dp; 2568 def D2 = Weyl(); 2569 setring D2; 2570 ideal I = x*Dx+2*b*Db+2, x^2*Dx+b*Dx+2*x; 2571 intvec w = 1,0; 2572 def D1 = integralIdeal(I,w); 2573 setring D1; D1; 2574 intIdeal; 2575 } 2576 2577 proc deRhamCohomIdeal (ideal I, list #) 2578 "USAGE: deRhamCohomIdeal (I[,w,eng,k,G]); 2579 @* I ideal, w optional intvec, eng and k optional ints, G optional ideal 2580 RETURN: ideal 2581 ASSUME: The basering is the n-th Weyl algebra in characteristic 0 and for all 2582 @* 1<=i<=n the identity var(i+n)*var(i)=var(i)*var(i+1)+1 holds, i.e. the 2583 @* sequence of variables is given by x(1),...,x(n),D(1),...,D(n), 2584 @* where D(i) is the differential operator belonging to x(i). 2585 @* Further, assume that I is a cyclic representation of the holonomic 2586 @* module K[x,1/f]f^m, where f in K[x] and m is smaller than or equal to 2587 @* the minimal integer root of the Bernstein-Sato polynomial of f. 2588 PURPOSE: computes a basis of the n-th de Rham cohomology group of the complement 2589 @* of the hypersurface defined by f 2590 NOTE: If I does not satisfy the conditions described above, the result might 2591 @* have no meaning. 2592 @* If w is an intvec with exactly n strictly positive entries, w is used 2593 @* in the computation. Otherwise, and by default, w is set to (1,...,1). 2594 @* If eng<>0, @code{std} is used for Groebner basis computations, 2595 @* otherwise, and by default, @code{slimgb} is used. 2596 @* Let F denote the Fourier transform of I wrt w. 2597 @* An integer smaller than or equal to the minimal integer root of the 2598 @* b-function of F(I) wrt the weight (-w,w) can be specified via the 2599 @* optional argument k. 2600 @* The optional argument G is used for specifying a Groebner Basis of F(I) 2601 @* wrt the weight (-w,w), that is, the initial form of G generates the 2602 @* initial ideal of F(I) wrt the weight (-w,w). 2603 @* Further note, that the assumptions on I, k and G (if given) are not 2604 @* checked. 2605 DISPLAY: If printlevel=1, progress debug messages will be printed, 2606 @* if printlevel>=2, all the debug messages will be printed. 2607 EXAMPLE: example deRhamCohomIdeal; shows examples 2608 " 2609 { 2610 intvec w = 1:(nvars(basering)/2); 2611 int l0,l0set,Gset; 2612 ideal G; 2613 int whichengine = 0; // default 2614 if (size(#)>0) 2615 { 2616 if (typeof(#[1])=="intvec") 2617 { 2618 if (allPositive(#[1])==1) 2619 { 2620 w = #[1]; 2621 } 2622 else 2623 { 2624 print("// Entries of intvec must be strictly positive"); 2625 print("// Using weight " + string(w)); 2626 } 2627 if (size(#)>1) 2628 { 2629 if (typeof(#[2])=="int" || typeof(#[2])=="number") 2630 { 2631 whichengine = int(#[2]); 2632 } 2633 if (size(#)>2) 2634 { 2635 if (typeof(#[3])=="int" || typeof(#[3])=="number") 2636 { 2637 l0 = int(#[3]); 2638 l0set = 1; 2639 } 2640 if (size(#)>3) 2641 { 2642 if (typeof(#[4])=="ideal") 2643 { 2644 G = #[4]; 2645 Gset = 1; 2646 } 2647 } 2648 } 2649 } 2650 } 2651 } 2652 int ppl = printlevel; 2653 int i,j; 2654 int n = nvars(basering)/2; 2655 intvec v; 2656 for (i=1; i<=n; i++) 2657 { 2658 if (w[i]>0) 2659 { 2660 if (v == intvec(0)) 2661 { 2662 v[1] = i; 2663 } 2664 else 2665 { 2666 v[size(v)+1] = i; 2667 } 2668 } 2669 } 2670 ideal FI = fourier(I,v); 2671 dbprint(ppl,"// computed Fourier transform of given ideal"); 2672 dbprint(ppl-1,"// " + string(FI)); 2673 list L; 2674 if (l0set) 2675 { 2676 if (Gset) // l0 and G given 2677 { 2678 L = restrictionModuleEngine(FI,w,whichengine,l0,G); 2679 } 2680 else // l0 given, G not 2681 { 2682 L = restrictionModuleEngine(FI,w,whichengine,l0); 2683 } 2684 } 2685 else // nothing given 2686 { 2687 L = restrictionModuleEngine(FI,w,whichengine); 2688 } 2689 ideal B,N; 2690 B = inverseFourier(L[1],v); 2691 N = inverseFourier(L[2],v); 2692 dbprint(ppl,"// computed integral module of given ideal"); 2693 dbprint(ppl-1,"// " + string(B)); 2694 dbprint(ppl-1,"// " + string(N)); 2695 ideal DR; 2696 poly p; 2697 poly Dt = 1; 2698 for (i=1; i<=n; i++) 2699 { 2700 Dt = Dt*var(i+n); 2701 } 2702 N = simplify(N,2+8); 2703 printlevel = printlevel-1; 2704 N = linReduceIdeal(N); 2705 N = simplify(N,2+8); 2706 for (i=1; i<=size(B); i++) 2707 { 2708 p = linReduce(B[i],N); 2709 if (p<>0) 2710 { 2711 DR[size(DR)+1] = B[i]*Dt; 2712 j=1; 2713 while (p<N[j]) 2714 { 2715 j++; 2716 } 2717 N = insertGenerator(N,p,j+1); 2718 } 2719 } 2720 printlevel = printlevel + 1; 2721 return(DR); 2722 } 2723 example 2724 { 2725 "EXAMPLE:"; echo = 2; 1138 2726 ring r = 0,(x,y,z),dp; 1139 poly f = x^2*z - y^3; 1140 def A = annPoly(f); 1141 setring A; // A is the 3rd Weyl algebra in 6 variables 1142 LD; // the Groebner basis of annihilator 1143 gkdim(LD); // must be 3 = 6/2, since A/LD is holonomic module 1144 NF(Dy^4, LD); // must be 0 since Dy^4 clearly annihilates f 1145 } 1146 1147 /* DIFFERENT EXAMPLES 1148 1149 //static proc exCusp() 2727 poly F = x^3+y^3+z^3; 2728 bfctAnn(F); // Bernstein-Sato poly of F has minimal integer root -2 2729 def W = annRat(1,F^2); // so we compute the annihilator of 1/F^2 2730 setring W; W; // Weyl algebra, contains LD = Ann(1/F^2) 2731 LD; // K[x,y,z,1/f]f^(-2) is isomorphic to W/LD as W-module 2732 deRhamCohomIdeal(LD); // we see that the K-dim is 2 2733 } 2734 2735 proc deRhamCohom (poly f, list #) 2736 "USAGE: deRhamCohom(f[,eng,m]); f poly, eng and m optional ints 2737 RETURN: ring 2738 ASSUME: Basering is a commutative ring in n variables over a field of char 0. 2739 PURPOSE: computes a basis of the n-th de Rham cohomology group of f^m 2740 NOTE: The output ring is the n-th Weyl algebra. It contains an object 2741 @* @code{DR} of type @code{ideal}, being a basis of the n-th de Rham 2742 @* cohomology group of the complement of the hypersurface defined by f. 2743 @* If eng<>0, @code{std} is used for Groebner basis computations, 2744 @* otherwise, and by default, @code{slimgb} is used. 2745 @* If m is given, it is assumed to be less than or equal to the minimal 2746 @* integer root of the Bernstein-Sato polynomial of f. This assumption is 2747 @* not checked. If not specified, m is set to the minimal integer root of 2748 @* the Bernstein-Sato polynomial of f. 2749 DISPLAY: If printlevel=1, progress debug messages will be printed, 2750 @* if printlevel>=2, all the debug messages will be printed. 2751 EXAMPLE: example deRhamCohom; shows example 2752 " 2753 { 2754 int ppl = printlevel - voice + 2; 2755 int eng,l0,l0given; 2756 if (size(#)>0) 2757 { 2758 if(typeof(#[1])=="int" || typeof(#[1])=="number") 2759 { 2760 eng = int(#[1]); 2761 } 2762 if (size(#)>1) 2763 { 2764 if(typeof(#[2])=="int" || typeof(#[2])=="number") 2765 { 2766 l0 = int(#[2]); 2767 l0given = 1; 2768 } 2769 } 2770 } 2771 if (!isCommutative()) 2772 { 2773 ERROR("Basering must be commutative."); 2774 } 2775 int i; 2776 def save = basering; 2777 int n = nvars(save); 2778 dbprint(ppl,"// Computing Ann(f^s)..."); 2779 def A = Sannfs(f); 2780 setring A; 2781 dbprint(ppl,"// ...done"); 2782 dbprint(ppl-1,"// Got: " + string(LD)); 2783 poly f = imap(save,f); 2784 if (!l0given) 2785 { 2786 dbprint(ppl,"// Computing b-function of given poly..."); 2787 ideal LDf = LD,f; 2788 LDf = engine(LDf,eng); 2789 vector v = pIntersect(s,LDf); // BS poly of f 2790 list BS = bFactor(vec2poly(v)); 2791 dbprint(ppl,"// ...done"); 2792 dbprint(ppl-1,"// roots: " + string(BS[1])); 2793 dbprint(ppl-1,"// multiplicities: " + string(BS[2])); 2794 BS = intRoots(BS); 2795 intvec iv; 2796 for (i=1; i<=ncols(BS[1]); i++) 2797 { 2798 iv[i] = int(BS[1][i]); 2799 } 2800 l0 = Min(iv); 2801 kill v,iv,BS,LDf; 2802 } 2803 dbprint(ppl,"// Computing Ann(f^" + string(l0) + ")..."); 2804 LD = annfspecial(LD,f,l0,l0); // Ann(f^l0) 2805 // create new ring without s 2806 list RL = ringlist(A); 2807 RL = RL[1..4]; 2808 list Lt = RL[2]; 2809 Lt = delete(Lt,2*n+1); 2810 RL[2] = Lt; 2811 Lt = RL[3]; 2812 Lt = delete(Lt,2); 2813 RL[3] = Lt; 2814 def @B = ring(RL); 2815 setring @B; 2816 def B = Weyl(); 2817 setring B; 2818 kill @B; 2819 ideal LD = imap(A,LD); 2820 LD = engine(LD,eng); 2821 dbprint(ppl,"// ...done"); 2822 dbprint(ppl-1,"// Got: " + string(LD)); 2823 kill A; 2824 intvec w = 1:n; 2825 ideal DR = deRhamCohomIdeal(LD,w,eng); 2826 export(DR); 2827 setring save; 2828 return(B); 2829 } 2830 example 2831 { 2832 "EXAMPLE:"; echo = 2; 2833 ring r = 0,(x,y,z),dp; 2834 poly f = x^3+y^3+z^3; 2835 def A = deRhamCohom(f); // we see that the K-dim is 2 2836 setring A; 2837 DR; 2838 } 2839 2840 // Appel hypergeometric functions ///////////////////////////////////////////// 2841 2842 proc appelF1() 2843 "USAGE: appelF1(); 2844 RETURN: ring (and exports an ideal into it) 2845 PURPOSE: define the ideal in a parametric Weyl algebra, 2846 @* which annihilates Appel F1 hypergeometric function 2847 NOTE: the ideal called IAppel1 is exported to the output ring 2848 EXAMPLE: example appelF1; shows examples 2849 " 2850 { 2851 // Appel F1, d = b', SST p.48 2852 ring @r = (0,a,b,c,d),(x,y,Dx,Dy),(a(0,0,1,1),a(0,0,1,0),dp); 2853 matrix @D[4][4]; 2854 @D[1,3]=1; @D[2,4]=1; 2855 def @S = nc_algebra(1,@D); 2856 setring @S; 2857 ideal IAppel1 = 2858 (x*Dx)*(x*Dx+y*Dy+c-1) - x*(x*Dx+y*Dy+a)*(x*Dx+b), 2859 (y*Dy)*(x*Dx+y*Dy+c-1) - y*(x*Dx+y*Dy+a)*(y*Dy+d), 2860 (x-y)*Dx*Dy - d*Dx + b*Dy; 2861 export IAppel1; 2862 kill @r; 2863 return(@S); 2864 } 2865 example 2866 { 2867 "EXAMPLE:"; echo = 2; 2868 def A = appelF1(); 2869 setring A; 2870 IAppel1; 2871 } 2872 2873 proc appelF2() 2874 "USAGE: appelF2(); 2875 RETURN: ring (and exports an ideal into it) 2876 PURPOSE: define the ideal in a parametric Weyl algebra, 2877 @* which annihilates Appel F2 hypergeometric function 2878 NOTE: the ideal called IAppel2 is exported to the output ring 2879 EXAMPLE: example appelF2; shows examples 2880 " 2881 { 2882 // Appel F2, c = b', SST p.85 2883 ring @r = (0,a,b,c),(x,y,Dx,Dy),(a(0,0,1,1),a(0,0,1,0),dp); 2884 matrix @D[4][4]; 2885 @D[1,3]=1; @D[2,4]=1; 2886 def @S = nc_algebra(1,@D); 2887 setring @S; 2888 ideal IAppel2 = 2889 (x*Dx)^2 - x*(x*Dx+y*Dy+a)*(x*Dx+b), 2890 (y*Dy)^2 - y*(x*Dx+y*Dy+a)*(y*Dy+c); 2891 export IAppel2; 2892 kill @r; 2893 return(@S); 2894 } 2895 example 2896 { 2897 "EXAMPLE:"; echo = 2; 2898 def A = appelF2(); 2899 setring A; 2900 IAppel2; 2901 } 2902 2903 proc appelF4() 2904 "USAGE: appelF4(); 2905 RETURN: ring (and exports an ideal into it) 2906 PURPOSE: define the ideal in a parametric Weyl algebra, 2907 @* which annihilates Appel F4 hypergeometric function 2908 NOTE: the ideal called IAppel4 is exported to the output ring 2909 EXAMPLE: example appelF4; shows examples 2910 " 2911 { 2912 // Appel F4, d = c', SST, p. 39 2913 ring @r = (0,a,b,c,d),(x,y,Dx,Dy),(a(0,0,1,1),a(0,0,1,0),dp); 2914 matrix @D[4][4]; 2915 @D[1,3]=1; @D[2,4]=1; 2916 def @S = nc_algebra(1,@D); 2917 setring @S; 2918 ideal IAppel4 = 2919 Dx*(x*Dx+c-1) - (x*Dx+y*Dy+a)*(x*Dx+y*Dy+b), 2920 Dy*(y*Dy+d-1) - (x*Dx+y*Dy+a)*(x*Dx+y*Dy+b); 2921 export IAppel4; 2922 kill @r; 2923 return(@S); 2924 } 2925 example 2926 { 2927 "EXAMPLE:"; echo = 2; 2928 def A = appelF4(); 2929 setring A; 2930 IAppel4; 2931 } 2932 2933 2934 // characteric variety //////////////////////////////////////////////////////// 2935 2936 proc charVariety(ideal I, list #) 2937 "USAGE: charVariety(I [,eng]); I an ideal, eng an optional int 2938 RETURN: ring 2939 PURPOSE: compute the characteristic variety of the D-module D/I 2940 ASSUME: The basering is the n-th Weyl algebra in characteristic 0 and for all 2941 @* 1<=i<=n the identity var(i+n)*var(i)=var(i)*var(i+1)+1 holds, i.e. the 2942 @* sequence of variables is given by x(1),...,x(n),D(1),...,D(n), 2943 @* where D(i) is the differential operator belonging to x(i). 2944 NOTE: The output ring is commutative. It contains an object @code{charVar} of 2945 @* type @code{ideal}, whose zero set is the characteristic variety of I in 2946 @* the sense of D-module theory. 2947 @* In this procedure, the initial ideal of I wrt weight 0 for x(i) and 2948 @* weight 1 for D(i) is computed. 2949 @* If eng<>0, @code{std} is used for Groebner basis computations, 2950 @* otherwise, and by default, @code{slimgb} is used. 2951 @* If @code{printlevel}=1, progress debug messages will be printed, 2952 @* if @code{printlevel}>=2, all the debug messages will be printed. 2953 EXAMPLE: example charVariety; shows examples 2954 " 2955 { 2956 // assumption check is done in GBWeight 2957 int eng; 2958 if (size(#)>0) 2959 { 2960 if (typeof(#[1])=="int" || typeof(#[1])=="number") 2961 { 2962 eng = int(#[1]); 2963 } 2964 } 2965 int ppl = printlevel - voice + 2; 2966 def save = basering; 2967 int n = nvars(save)/2; 2968 intvec u = 0:n; 2969 intvec v = 1:n; 2970 dbprint(ppl,"// Computing Groebner basis wrt weights..."); 2971 I = GBWeight(I,u,v,eng); 2972 dbprint(ppl,"// ...finished"); 2973 dbprint(ppl-1,"// Got: " + string(I)); 2974 list RL = ringlist(save); 2975 RL = RL[1..4]; 2976 def newR = ring(RL); 2977 setring newR; 2978 ideal charVar = imap(save,I); 2979 intvec uv = u,v; 2980 charVar = inForm(charVar,uv); 2981 charVar = engine(charVar,eng); 2982 export(charVar); 2983 setring save; 2984 return(newR); 2985 } 2986 example 2987 { 2988 "EXAMPLE:"; echo = 2; 2989 ring r = 0,(x,y),Dp; 2990 poly F = x3-y2; 2991 printlevel = 0; 2992 def A = annfs(F); 2993 setring A; // Weyl algebra 2994 LD; // the annihilator of F 2995 def CA = charVariety(LD); 2996 setring CA; CA; // commutative ring 2997 charVar; 2998 dim(charVar); 2999 } 3000 3001 proc charInfo(ideal I) 3002 "USAGE: charInfo(I); I an ideal 3003 RETURN: ring 3004 PURPOSE: compute the characteristic information for I 3005 ASSUME: The basering is the n-th Weyl algebra in characteristic 0 and for all 3006 @* 1<=i<=n the identity var(i+n)*var(i)=var(i)*var(i+1)+1 holds, i.e. the 3007 @* sequence of variables is given by x(1),...,x(n),D(1),...,D(n), 3008 @* where D(i) is the differential operator belonging to x(i). 3009 NOTE: Activate the output ring with the @code{setring} command. 3010 @* In the output (in a commutative ring): 3011 @* - the ideal charVar is the characteristic variety char(I), 3012 @* - the ideal SingLoc is the singular locus of char(I), 3013 @* - the list primDec is the primary decomposition of char(I). 3014 @* If @code{printlevel}=1, progress debug messages will be printed, 3015 @* if @code{printlevel}>=2, all the debug messages will be printed. 3016 EXAMPLE: example charInfo; shows examples 3017 " 3018 { 3019 int ppl = printlevel - voice + 2; 3020 def save = basering; 3021 dbprint(ppl,"// computing characteristic variety..."); 3022 def A = charVariety(I); 3023 setring A; 3024 dbprint(ppl,"// ...done"); 3025 dbprint(ppl-1,"// Got: " + string(charVar)); 3026 dbprint(ppl,"// computing singular locus..."); 3027 ideal singLoc = slocus(charVar); 3028 singLoc = std(singLoc); 3029 dbprint(ppl,"// ...done"); 3030 dbprint(ppl-1,"// Got: " + string(singLoc)); 3031 dbprint(ppl,"// computing primary decomposition..."); 3032 list primDec = primdecGTZ(charVar); 3033 dbprint(ppl,"// ...done"); 3034 //export(charVar,singLoc,primDec); 3035 export(singLoc,primDec); 3036 setring save; 3037 return(A); 3038 } 3039 example 3040 { 3041 "EXAMPLE:"; echo = 2; 3042 ring r = 0,(x,y),Dp; 3043 poly F = x3-y2; 3044 printlevel = 0; 3045 def A = annfs(F); 3046 setring A; // Weyl algebra 3047 LD; // the annihilator of F 3048 def CA = charInfo(LD); 3049 setring CA; CA; // commutative ring 3050 charVar; // characteristic variety 3051 singLoc; // singular locus 3052 primDec; // primary decomposition 3053 } 3054 3055 3056 // examples /////////////////////////////////////////////////////////////////// 3057 3058 /* 3059 static proc exCusp() 1150 3060 { 1151 3061 "EXAMPLE:"; echo = 2; … … 1166 3076 } 1167 3077 1168 //static proc exWalther1()3078 static proc exWalther1() 1169 3079 { 1170 3080 // p.18 Rem 3.10 … … 1186 3096 } 1187 3097 1188 //static proc exWalther2()3098 static proc exWalther2() 1189 3099 { 1190 3100 // p.19 Rem 3.10 cont'd … … 1210 3120 } 1211 3121 1212 //static proc exWalther3()3122 static proc exWalther3() 1213 3123 { 1214 3124 // can check with annFs too :-) … … 1242 3152 } 1243 3153 3154 static proc ex_annRat() 3155 { 3156 // more complicated example for annRat 3157 ring r = 0,(x,y,z),dp; 3158 poly f = x3+y3+z3; // mir = -2 3159 poly g = x*y*z; 3160 def A = annRat(g,f); 3161 setring A; 3162 } 1244 3163 */ 1245 3164 1246 proc engine(def I, int i) 1247 "USAGE: engine(I,i); I ideal/module/matrix, i an int 1248 RETURN: the same type as I 1249 PURPOSE: compute the Groebner basis of I with the algorithm, chosen via i 1250 NOTE: By default and if i=0, slimgb is used; otherwise std does the job. 1251 EXAMPLE: example engine; shows examples 1252 " 1253 { 1254 /* std - slimgb mix */ 1255 def J; 1256 // ideal J; 1257 if (i==0) 1258 { 1259 J = slimgb(I); 1260 } 1261 else 1262 { 1263 // without options -> strange! (ringlist?) 1264 intvec v = option(get); 1265 option(redSB); 1266 option(redTail); 1267 J = std(I); 1268 option(set, v); 1269 } 1270 return(J); 1271 } 1272 example 1273 { 1274 "EXAMPLE:"; echo = 2; 1275 ring r = 0,(x,y),Dp; 1276 ideal I = y*(x3-y2),x*(x3-y2); 1277 engine(I,0); // uses slimgb 1278 engine(I,1); // uses std 1279 } 1280 1281 proc insertGenerator (list #) 1282 "USAGE: insertGenerator(id,p[,k]); id an ideal/module, p a poly/vector, k an optional int 1283 RETURN: same as id 1284 PURPOSE: inserts p into the first argument at k-th index position and returns the enlarged object 1285 NOTE: If k is given, p is inserted at position k, otherwise (and by default), 1286 @* p is inserted at the beginning. 1287 EXAMPLE: example insertGenerator; shows examples 1288 " 1289 { 1290 if (size(#) < 2) 1291 { 1292 ERROR("insertGenerator has to be called with at least 2 arguments (ideal/module,poly/vector)"); 1293 } 1294 string inp1 = typeof(#[1]); 1295 if (inp1 == "ideal" || inp1 == "module") 1296 { 1297 if (inp1 == "ideal") { ideal id = #[1]; } 1298 else { module id = #[1]; } 1299 } 1300 else { ERROR("first argument has to be of type ideal or module"); } 1301 string inp2 = typeof(#[2]); 1302 if (inp2 == "poly" || inp2 == "vector") 1303 { 1304 if (inp2 =="poly") { poly f = #[2]; } 1305 else 1306 { 1307 if (inp1 == "ideal") 1308 { 1309 ERROR("second argument has to be a polynomial if first argument is an ideal"); 1310 } 1311 else { vector f = #[2]; } 1312 } 1313 } 1314 else { ERROR("second argument has to be of type poly/vector"); } 1315 int n = ncols(id); 1316 int k = 1; // default 1317 if (size(#)>=3) 1318 { 1319 if (typeof(#[3]) == "int") 1320 { 1321 k = #[3]; 1322 if (k<=0) 1323 { 1324 ERROR("third argument has to be positive"); 1325 } 1326 } 1327 else { ERROR("third argument has to be of type int"); } 1328 } 1329 execute(inp1 +" J;"); 1330 if (k == 1) { J = f,id; } 1331 else 1332 { 1333 if (k>n) 1334 { 1335 J = id; 1336 J[k] = f; 1337 } 1338 else // 1<k<=n 1339 { 1340 J[1..k-1] = id[1..k-1]; 1341 J[k] = f; 1342 J[k+1..n+1] = id[k..n]; 1343 } 1344 } 1345 return(J); 1346 } 1347 example 1348 { 1349 "EXAMPLE:"; echo = 2; 1350 ring r = 0,(x,y,z),dp; 1351 ideal I = x^2,z^4; 1352 insertGenerator(I,y^3); 1353 insertGenerator(I,y^3,2); 1354 module M = I; 1355 insertGenerator(M,[x^3,y^2,z],2); 1356 } 1357 1358 proc deleteGenerator (list #) 1359 "USAGE: deleteGenerator(id,k); id an ideal/module, k an int 1360 RETURN: same as id 1361 PURPOSE: deletes the k-th generator from the first argument and returns the altered object 1362 EXAMPLE: example insertGenerator; shows examples 1363 " 1364 { 1365 if (size(#) < 2) 1366 { 1367 ERROR("deleteGenerator has to be called with 2 arguments (ideal/module,int)"); 1368 } 1369 string inp1 = typeof(#[1]); 1370 if (inp1 == "ideal" || inp1 == "module") 1371 { 1372 if (inp1 == "ideal") { ideal id = #[1]; } 1373 else { module id = #[1]; } 1374 } 1375 else { ERROR("first argument has to be of type ideal or module"); } 1376 string inp2 = typeof(#[2]); 1377 if (inp2 == "int" || inp2 == "number") { int k = int(#[2]); } 1378 else { ERROR("second argument has to be of type int"); } 1379 int n = ncols(id); 1380 if (n == 1) { ERROR(inp1+" must have more than one generator"); } 1381 if (k<=0 || k>n) { ERROR("second argument has to be in the range 1,...,"+string(n)); } 1382 execute(inp1 +" J;"); 1383 if (k == 1) { J = id[2..n]; } 1384 else 1385 { 1386 if (k == n) { J = id[1..n-1]; } 1387 else 1388 { 1389 J[1..k-1] = id[1..k-1]; 1390 J[k..n-1] = id[k+1..n]; 1391 } 1392 } 1393 return(J); 1394 } 1395 example 1396 { 1397 "EXAMPLE:"; echo = 2; 1398 ring r = 0,(x,y,z),dp; 1399 ideal I = x^2,y^3,z^4; 1400 deleteGenerator(I,2); 1401 module M = [x,y,z],[x2,y2,z2],[x3,y3,z3];; 1402 deleteGenerator(M,2); 1403 } 1404 1405 proc fl2poly(list L, string s) 1406 "USAGE: fl2poly(L,s); L a list, s a string 1407 RETURN: poly 1408 PURPOSE: reconstruct a monic polynomial in one variable from its factorization 1409 ASSUME: s is a string with the name of some variable and 1410 @* L is supposed to consist of two entries: 1411 @* L[1] of the type ideal with the roots of a polynomial 1412 @* L[2] of the type intvec with the multiplicities of corr. roots 1413 EXAMPLE: example fl2poly; shows examples 1414 " 1415 { 1416 if (varNum(s)==0) 1417 { 1418 ERROR("no such variable found in the basering"); return(0); 1419 } 1420 poly x = var(varNum(s)); 1421 poly P = 1; 1422 int sl = size(L[1]); 1423 ideal RR = L[1]; 1424 intvec IV = L[2]; 1425 for(int i=1; i<= sl; i++) 1426 { 1427 if (IV[i] > 0) 1428 { 1429 P = P*((x-RR[i])^IV[i]); 1430 } 1431 else 1432 { 1433 printf("Ignored the root with incorrect multiplicity %s",string(IV[i])); 1434 } 1435 } 1436 return(P); 1437 } 1438 example 1439 { 1440 "EXAMPLE:"; echo = 2; 1441 ring r = 0,(x,y,z,s),Dp; 1442 ideal I = -1,-4/3,-5/3,-2; 1443 intvec mI = 2,1,1,1; 1444 list BS = I,mI; 1445 poly p = fl2poly(BS,"s"); 1446 p; 1447 factorize(p,2); 1448 } 1449 1450 static proc safeVarName (string s, string cv) 1451 { 1452 string S; 1453 if (cv == "v") { S = "," + "," + varstr(basering) + ","; } 1454 if (cv == "c") { S = "," + "," + charstr(basering) + ","; } 1455 if (cv == "cv") { S = "," + charstr(basering) + "," + varstr(basering) + ","; } 1456 s = "," + s + ","; 1457 while (find(S,s) <> 0) 1458 { 1459 s[1] = "@"; 1460 s = "," + s; 1461 } 1462 s = s[2..size(s)-1]; 1463 return(s) 1464 } 1465 1466 proc initialIdealW (ideal I, intvec u, intvec v, list #) 1467 "USAGE: initialIdealW(I,u,v [,s,t,w]); I ideal, u,v intvecs, s,t optional ints, 1468 @* w an optional intvec 1469 RETURN: ideal, GB of initial ideal of the input ideal w.r.t. the weights u and v 1470 ASSUME: The basering is the n-th Weyl algebra in characteristic 0 and for all 1471 @* 1<=i<=n the identity var(i+n)*var(i)=var(i)*var(i+1)+1 holds, i.e. the 1472 @* sequence of variables is given by x(1),...,x(n),D(1),...,D(n), 1473 @* where D(i) is the differential operator belonging to x(i). 1474 PURPOSE: computes the initial ideal with respect to given weights. 1475 NOTE: u and v are understood as weight vectors for x(1..n) and D(1..n) 1476 @* respectively. 1477 @* If s<>0, @code{std} is used for Groebner basis computations, 1478 @* otherwise, and by default, @code{slimgb} is used. 1479 @* If t<>0, a matrix ordering is used for Groebner basis computations, 1480 @* otherwise, and by default, a block ordering is used. 1481 @* If w consist of 2n strictly positive entries, w is used for weighted 1482 @* homogenization, otherwise, and by default, no weights are used. 1483 DISPLAY: If printlevel=1, progress debug messages will be printed, 1484 @* if printlevel>=2, all the debug messages will be printed. 1485 EXAMPLE: example initialIdealW; shows examples 1486 " 1487 { 1488 if (dmodappassumeViolation()) 1489 { 1490 ERROR("Basering is inappropriate: characteristic>0 or qring present"); 1491 } 1492 if (!isWeyl()) 1493 { 1494 ERROR("Basering is not a Weyl algebra."); 1495 } 1496 int ppl = printlevel - voice +2; 1497 def save = basering; 1498 int n = nvars(save)/2; 1499 int N = 2*n+1; 1500 list RL = ringlist(save); 1501 int i; 1502 int whichengine = 0; // default 1503 int methodord = 0; // default 1504 intvec homogweights = 1:(2*n); // default 1505 if (size(#)>0) 1506 { 1507 if (typeof(#[1])=="int" || typeof(#[1])=="number") 1508 { 1509 whichengine = int(#[1]); 1510 } 1511 if (size(#)>1) 1512 { 1513 if (typeof(#[2])=="int" || typeof(#[2])=="number") 1514 { 1515 methodord = int(#[2]); 1516 } 1517 if (size(#)>2) 1518 { 1519 if (typeof(#[3])=="intvec") 1520 { 1521 if (size(#[3])==2*n && allPositive(#[3])==1) 1522 { 1523 homogweights = #[3]; 1524 } 1525 else 1526 { 1527 print("// Homogenization weight vector must consist of positive entries and be"); 1528 print("// of size " + string(n) + ". Using no weights."); 1529 } 1530 } 1531 } 1532 } 1533 } 1534 for (i=1; i<=n; i++) 1535 { 1536 if (bracket(var(i+n),var(i))<>1) 1537 { 1538 ERROR(string(var(i+n)) + " is not a differential operator for " + string(var(i))); 1539 } 1540 } 1541 // 1. create homogenized Weyl algebra 1542 // 1.1 create ordering 1543 intvec uv = u,v,0; 1544 homogweights = homogweights,1; 1545 list Lord = list(list("a",homogweights)); 1546 list C0 = list("C",intvec(0)); 1547 if (methodord == 0) // default: blockordering 1548 { 1549 Lord[2] = list("a",uv); 1550 Lord[3] = list("dp",intvec(1:(N-1))); 1551 Lord[4] = list("lp",intvec(1)); 1552 Lord[5] = C0; 1553 } 1554 else // M() ordering 1555 { 1556 intmat @Ord[N][N]; 1557 @Ord[1,1..N] = uv; @Ord[2,1..N] = 1:(N-1); 1558 for (i=1; i<=N-2; i++) { @Ord[2+i,N - i] = -1; } 1559 dbprint(ppl-1,"// the ordering matrix:",@Ord); 1560 Lord[2] = list("M",intvec(@Ord)); 1561 Lord[3] = C0; 1562 } 1563 // 1.2 the new var 1564 list Lvar = RL[2]; Lvar[N] = safeVarName("h","cv"); 1565 // 1.3 create commutative ring 1566 list L@@Dh = RL; L@@Dh = L@@Dh[1..4]; 1567 L@@Dh[2] = Lvar; L@@Dh[3] = Lord; 1568 def @Dh = ring(L@@Dh); kill L@@Dh; 1569 setring @Dh; 1570 dbprint(ppl-1,"// the ring @Dh:",@Dh); 1571 // 1.4 create non-commutative relations 1572 matrix @relD[N][N]; 1573 for (i=1; i<=n; i++) { @relD[i,n+i] = var(N)^(homogweights[i]+homogweights[n+i]); } 1574 def Dh = nc_algebra(1,@relD); 1575 setring Dh; kill @Dh; 1576 dbprint(ppl-1,"// computing in ring",Dh); 1577 // 2. Compute the initial ideal 1578 ideal I = imap(save,I); 1579 I = homog(I,h); 1580 // 2.1 the hard part: Groebner basis computation 1581 dbprint(ppl, "// starting Groebner basis computation with engine: "+string(whichengine)); 1582 I = engine(I, whichengine); 1583 dbprint(ppl, "// finished Groebner basis computation"); 1584 dbprint(ppl-1, "// I before dehomogenization is " +string(I)); 1585 I = subst(I,var(N),1); // dehomogenization 1586 dbprint(ppl-1, "I after dehomogenization is " +string(I)); 1587 // 2.2 the initial form 1588 I = inForm(I,uv); 1589 setring save; 1590 I = imap(Dh,I); kill Dh; 1591 // 2.3 the final GB 1592 dbprint(ppl, "// starting cosmetic Groebner basis computation with engine: "+string(whichengine)); 1593 I = engine(I, whichengine); 1594 dbprint(ppl,"// finished cosmetic Groebner basis computation"); 1595 return(I); 1596 } 1597 example 1598 { 1599 "EXAMPLE:"; echo = 2; 1600 ring @D = 0,(x,Dx),dp; 1601 def D = Weyl(); 1602 setring D; 1603 intvec u = -1; intvec v = 2; 1604 ideal I = x^2*Dx^2,x*Dx^4; 1605 ideal J = initialIdealW(I,u,v); J; 1606 } 1607 1608 proc initialMalgrange (poly f,list #) 1609 "USAGE: initialMalgrange(f,[,a,b,v]); f poly, a,b optional ints, v opt. intvec 1610 RETURN: ring, Weyl algebra induced by basering, extended by two new vars t,Dt 1611 PURPOSE: computes the initial Malgrange ideal of a given polynomial w.r.t. the weight 1612 @* vector (-1,0...,0,1,0,...,0) such that the weight of t is -1 and the 1613 @* weight of Dt is 1. 1614 ASSUME: The basering is commutative and of characteristic 0. 1615 NOTE: Activate the output ring with the @code{setring} command. 1616 @* The returned ring contains the ideal \"inF\", being the initial ideal 1617 @* of the Malgrange ideal of f. 1618 @* Varnames of the basering should not include t and Dt. 1619 @* If a<>0, @code{std} is used for Groebner basis computations, 1620 @* otherwise, and by default, @code{slimgb} is used. 1621 @* If b<>0, a matrix ordering is used for Groebner basis computations, 1622 @* otherwise, and by default, a block ordering is used. 1623 @* If a positive weight vector v is given, the weight 1624 @* (d,v[1],...,v[n],1,d+1-v[1],...,d+1-v[n]) is used for homogenization 1625 @* computations, where d denotes the weighted degree of f. 1626 @* Otherwise and by default, v is set to (1,...,1). See Noro, 2002. 1627 DISPLAY: If printlevel=1, progress debug messages will be printed, 1628 @* if printlevel>=2, all the debug messages will be printed. 1629 EXAMPLE: example initialMalgrange; shows examples 1630 " 1631 { 1632 if (dmodappassumeViolation()) 1633 { 1634 ERROR("Basering is inappropriate: characteristic>0 or qring present"); 1635 } 1636 if (!isCommutative()) 1637 { 1638 ERROR("Basering must be commutative."); 1639 } 1640 int ppl = printlevel - voice +2; 1641 def save = basering; 1642 int n = nvars(save); 1643 int i; 1644 int whichengine = 0; // default 1645 int methodord = 0; // default 1646 intvec u0 = 1:n; // default 1647 if (size(#)>0) 1648 { 1649 if (typeof(#[1])=="int" || typeof(#[1])=="number") 1650 { 1651 whichengine = int(#[1]); 1652 } 1653 if (size(#)>1) 1654 { 1655 if (typeof(#[2])=="int" || typeof(#[2])=="number") 1656 { 1657 methodord = int(#[2]); 1658 } 1659 if (size(#)>2) 1660 { 1661 if (typeof(#[3])=="intvec" && size(#[3])==n && allPositive(#[3])==1) 1662 { 1663 u0 = #[3]; 1664 } 1665 } 1666 } 1667 } 1668 // creating the homogenized extended Weyl algebra 1669 list RL = ringlist(save); 1670 RL = RL[1..4]; // if basering is commutative nc_algebra 1671 list C0 = list("C",intvec(0)); 1672 // 1. create homogenization weights 1673 // 1.1. get the weighted degree of f 1674 list Lord = list(list("wp",u0),C0); 1675 list L@r = RL; 1676 L@r[3] = Lord; 1677 def r = ring(L@r); kill L@r,Lord; 1678 setring r; 1679 poly f = imap(save,f); 1680 int d = deg(f); 1681 setring save; kill r; 1682 // 1.2 the homogenization weights 1683 intvec homogweights = d; 1684 homogweights[n+2] = 1; 1685 for (i=1; i<=n; i++) 1686 { 1687 homogweights[i+1] = u0[i]; 1688 homogweights[n+2+i] = d+1-u0[i]; 1689 } 1690 // 2. create extended Weyl algebra 1691 int N = 2*n+2; 1692 // 2.1 create names for vars 1693 string vart = safeVarName("t","cv"); 1694 string varDt = safeVarName("D"+vart,"cv"); 1695 while (varDt <> "D"+vart) 1696 { 1697 vart = safeVarName("@"+vart,"cv"); 1698 varDt = safeVarName("D"+vart,"cv"); 1699 } 1700 list Lvar; 1701 Lvar[1] = vart; Lvar[n+2] = varDt; 1702 for (i=1; i<=n; i++) 1703 { 1704 Lvar[i+1] = string(var(i)); 1705 Lvar[i+n+2] = safeVarName("D" + string(var(i)),"cv"); 1706 } 1707 // 2.2 create ordering 1708 list Lord = list(list("dp",intvec(1:N)),C0); 1709 // 2.3 create the (n+1)-th Weyl algebra 1710 list L@D = RL; L@D[2] = Lvar; L@D[3] = Lord; 1711 def @D = ring(L@D); kill L@D; 1712 setring @D; 1713 def D = Weyl(); 1714 setring D; kill @D; 1715 dbprint(ppl,"// the (n+1)-th Weyl algebra :" ,D); 1716 // 3. compute the initial ideal 1717 // 3.1 create the Malgrange ideal 1718 poly f = imap(save,f); 1719 ideal I = var(1)-f; 1720 for (i=1; i<=n; i++) 1721 { 1722 I = I, var(n+2+i)+diff(f,var(i+1))*var(n+2); 1723 } 1724 // I = engine(I,whichengine); // todo is it efficient to compute a GB first wrt dp first? 1725 // 3.2 computie the initial ideal 1726 intvec w = 1,0:n; 1727 I = initialIdealW(I,-w,w,whichengine,methodord,homogweights); 1728 ideal inF = I; attrib(inF,"isSB",1); 1729 export(inF); 1730 setring save; 1731 return(D); 1732 } 1733 example 1734 { 1735 "EXAMPLE:"; echo = 2; 1736 ring r = 0,(x,y),dp; 1737 poly f = x^2+y^3+x*y^2; 1738 def D = initialMalgrange(f); 1739 setring D; 1740 inF; 1741 setring r; 1742 intvec v = 3,2; 1743 def D2 = initialMalgrange(f,1,1,v); 1744 setring D2; 1745 inF; 1746 } 1747 1748 proc dmodappassumeViolation() 1749 { 1750 // returns Boolean : yes/no [for assume violation] 1751 // char K = 0 1752 // no qring 1753 if ( (size(ideal(basering)) >0) || (char(basering) >0) ) 1754 { 1755 // "ERROR: no qring is allowed"; 1756 return(1); 1757 } 1758 return(0); 1759 } 1760 1761 proc bFactor (poly F) 1762 "USAGE: bFactor(f); f poly 1763 RETURN: list 1764 PURPOSE: tries to compute the roots of a univariate poly f 1765 NOTE: The output list consists of two or three entries: 1766 @* roots of f as an ideal, their multiplicities as intvec, and, 1767 @* if present, a third one being the product of all irreducible factors 1768 @* of degree greater than one, given as string. 1769 DISPLAY: If printlevel=1, progress debug messages will be printed, 1770 @* if printlevel>=2, all the debug messages will be printed. 1771 EXAMPLE: example bFactor; shows examples 1772 " 1773 { 1774 int ppl = printlevel - voice +2; 1775 def save = basering; 1776 ideal LI = variables(F); 1777 list L; 1778 int i = size(LI); 1779 if (i>1) { ERROR("poly has to be univariate")} 1780 if (i == 0) 1781 { 1782 dbprint(ppl,"// poly is constant"); 1783 L = list(ideal(0),intvec(0),string(F)); 1784 return(L); 1785 } 1786 poly v = LI[1]; 1787 L = ringlist(save); L = L[1..4]; 1788 L[2] = list(string(v)); 1789 L[3] = list(list("dp",intvec(1)),list("C",intvec(0))); 1790 def @S = ring(L); 1791 setring @S; 1792 poly ir = 1; poly F = imap(save,F); 1793 list L = factorize(F); 1794 ideal I = L[1]; 1795 intvec m = L[2]; 1796 ideal II; intvec mm; 1797 for (i=2; i<=ncols(I); i++) 1798 { 1799 if (deg(I[i]) > 1) 1800 { 1801 ir = ir * I[i]^m[i]; 1802 } 1803 else 1804 { 1805 II[size(II)+1] = I[i]; 1806 mm[size(II)] = m[i]; 1807 } 1808 } 1809 II = normalize(II); 1810 II = subst(II,var(1),0); 1811 II = -II; 1812 if (size(II)>0) 1813 { 1814 dbprint(ppl,"// found roots"); 1815 dbprint(ppl-1,string(II)); 1816 } 1817 else 1818 { 1819 dbprint(ppl,"// found no roots"); 1820 } 1821 L = list(II,mm); 1822 if (ir <> 1) 1823 { 1824 dbprint(ppl,"// found irreducible factors"); 1825 ir = cleardenom(ir); 1826 dbprint(ppl-1,string(ir)); 1827 L = L + list(string(ir)); 1828 } 1829 else 1830 { 1831 dbprint(ppl,"// no irreducible factors found"); 1832 } 1833 setring save; 1834 L = imap(@S,L); 1835 return(L); 1836 } 1837 example 1838 { 1839 "EXAMPLE:"; echo = 2; 1840 ring r = 0,(x,y),dp; 1841 bFactor((x^2-1)^2); 1842 bFactor((x^2+1)^2); 1843 bFactor((y^2+1/2)*(y+9)*(y-7)); 1844 } 3165 3166 // TODO deRhamCohom: m <= min int root of b_f or b_{I,w}??
Note: See TracChangeset
for help on using the changeset viewer.