Changeset 0ab7da in git
 Timestamp:
 Jan 17, 2008, 10:05:31 PM (15 years ago)
 Branches:
 (u'spielwiese', '0d6b7fcd9813a1ca1ed4220cfa2b104b97a0a003')
 Children:
 b111284f8050a2558ab0f81f34dcb5133e4d1947
 Parents:
 4baf7449a920902da9ace69c7d671dea0b8685da
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

Singular/LIB/dmod.lib
r4baf744 r0ab7da 1 1 ////////////////////////////////////////////////////////////////////////////// 2 version="$Id: dmod.lib,v 1.2 3 20071127 14:40:11 levandov Exp $";2 version="$Id: dmod.lib,v 1.24 20080117 21:05:31 levandov Exp $"; 3 3 category="Noncommutative"; 4 4 info=" … … 1228 1228 def A = annfsBM(F); 1229 1229 setring A; 1230 LD; 1231 BS; 1232 } 1233 1234 1235 // try to replace s with s1 => data is shorter 1236 // analogue of annfs0 1237 proc annfs2(ideal I, poly F, list #) 1238 "USAGE: annfs2(I, F [,eng]); I an ideal, F a poly, eng an optional int 1239 RETURN: ring 1240 PURPOSE: compute the annihilator ideal of f^s in the Weyl Algebra, based on the 1241 output of procedures SannfsBM, SannfsOT or SannfsLOT 1242 NOTE: activate this ring with the @code{setring} command. In this ring, 1243 @*  the ideal LD (which is a Groebner basis) is the annihilator of f^s, 1244 @*  the list BS contains the roots with multiplicities of a Bernstein polynomial of f. 1245 @* If eng <>0, @code{std} is used for Groebner basis computations, 1246 @* otherwise and by default @code{slimgb} is used. 1247 @* Uses the shorter form of expressions in the variable s (the idea of Noro). 1248 @* If printlevel=1, progress debug messages will be printed, 1249 @* if printlevel>=2, all the debug messages will be printed. 1250 EXAMPLE: example annfs2; shows examples 1251 " 1252 { 1253 int eng = 0; 1254 if ( size(#)>0 ) 1255 { 1256 if ( typeof(#[1]) == "int" ) 1257 { 1258 eng = int(#[1]); 1259 } 1260 } 1261 def @R2 = basering; 1262 // we're in D_n[s], where the elim ord for s is set 1263 ideal J = NF(I,std(F)); 1264 // make leadcoeffs positive 1265 int i; 1266 J = subst(J,s,s1); 1267 for (i=1; i<= ncols(J); i++) 1268 { 1269 if (leadcoef(J[i]) <0 ) 1270 { 1271 J[i] = J[i]; 1272 } 1273 } 1274 J = J,F; 1275 ideal M = engine(J,eng); 1276 int Nnew = nvars(@R2); 1277 ideal K2 = nselect(M,1,Nnew1); 1278 int ppl = printlevelvoice+2; 1279 dbprint(ppl,"// 11 _x,_Dx are eliminated in basering"); 1280 dbprint(ppl1, K2); 1281 // the ring @R3 and the search for minimal negative int s 1282 ring @R3 = 0,s,dp; 1283 dbprint(ppl,"// 21 the ring @R3 i.e. K[s] is ready"); 1284 ideal K3 = imap(@R2,K2); 1285 poly p = K3[1]; 1286 dbprint(ppl,"// 22 factorization"); 1287 // ideal P = factorize(p,1); //without constants and multiplicities 1288 // " bfunction factorizes into "; P; 1289 // convert factors to the list of their roots with mults 1290 // assume all factors are linear 1291 // ideal BS = normalize(P); 1292 // BS = subst(BS,s,0); 1293 // BS = BS; 1294 list P = factorize(p); //with constants and multiplicities 1295 ideal bs; intvec m; //the Bernstein polynomial is monic, so we are not interested in constants 1296 for (i=2; i<= size(P[1]); i++) //we delete P[1][1] and P[2][1] 1297 { 1298 bs[i1] = P[1][i]; bs[i1] = subst(bs[i1],s,s1); 1299 m[i1] = P[2][i]; 1300 } 1301 int sP = minIntRoot(bs,1); 1302 bs = normalize(bs); 1303 bs = subst(bs,s,0); 1304 dbprint(ppl,"// 23 minimal integer root found"); 1305 dbprint(ppl1, sP); 1306 //TODO: sort BS! 1307 //  substitute s found in the ideal  1308 //  going back to @R and substitute  1309 setring @R2; 1310 K2 = subst(I,s,sP); 1311 // create the ordinary Weyl algebra and put the result into it, 1312 // thus creating the ring @R5 1313 // keep: N, i,j,s, tmp, RL 1314 Nnew = Nnew  1; // former 2*N; 1315 // list RL = ringlist(save); // is defined earlier 1316 // kill Lord, tmp, iv; 1317 list L = 0; 1318 list Lord, tmp; 1319 intvec iv; 1320 list RL = ringlist(basering); 1321 L[1] = RL[1]; 1322 L[4] = RL[4]; //char, minpoly 1323 // check whether vars have admissible names > done earlier 1324 // list Name = RL[2]M 1325 // DName is defined earlier 1326 list NName; // = RL[2]; // skip the last var 's' 1327 for (i=1; i<=Nnew; i++) 1328 { 1329 NName[i] = RL[2][i]; 1330 } 1331 L[2] = NName; 1332 // dp ordering; 1333 string s = "iv="; 1334 for (i=1; i<=Nnew; i++) 1335 { 1336 s = s+"1,"; 1337 } 1338 s[size(s)] = ";"; 1339 execute(s); 1340 tmp = 0; 1341 tmp[1] = "dp"; // string 1342 tmp[2] = iv; // intvec 1343 Lord[1] = tmp; 1344 kill s; 1345 tmp[1] = "C"; 1346 iv = 0; 1347 tmp[2] = iv; 1348 Lord[2] = tmp; 1349 tmp = 0; 1350 L[3] = Lord; 1351 // we are done with the list 1352 // Add: Plural part 1353 def @R4@ = ring(L); 1354 setring @R4@; 1355 int N = Nnew/2; 1356 matrix @D[Nnew][Nnew]; 1357 for (i=1; i<=N; i++) 1358 { 1359 @D[i,N+i]=1; 1360 } 1361 def @R4 = nc_algebra(1,@D); 1362 setring @R4; 1363 kill @R4@; 1364 dbprint(ppl,"// 31 the ring @R4 is ready"); 1365 dbprint(ppl1, @R4); 1366 ideal K4 = imap(@R2,K2); 1367 option(redSB); 1368 dbprint(ppl,"// 32 the final cosmetic std"); 1369 K4 = engine(K4,eng); // std does the job too 1370 // total cleanup 1371 ideal bs = imap(@R3,bs); 1372 kill @R3; 1373 list BS = bs,m; 1374 export BS; 1375 ideal LD = K4; 1376 export LD; 1377 return(@R4); 1378 } 1379 example 1380 { "EXAMPLE:"; echo = 2; 1381 ring r = 0,(x,y,z),Dp; 1382 poly F = x^3+y^3+z^3; 1383 printlevel = 0; 1384 def A = SannfsBM(F); 1385 setring A; 1386 LD; 1387 poly F = imap(r,F); 1388 def B = annfs2(LD,F); 1389 setring B; 1230 1390 LD; 1231 1391 BS;
Note: See TracChangeset
for help on using the changeset viewer.