Changeset e64e417 in git
 Timestamp:
 Mar 2, 2010, 10:08:05 PM (13 years ago)
 Branches:
 (u'jengelhdatetime', 'ceac47cbc86fe4a15902392bdbb9bd2ae0ea02c6')(u'spielwiese', '0604212ebb110535022efecad887940825b97c3f')
 Children:
 7bee774991f75beab2ef716e056b41c2944caef2
 Parents:
 92f22582e01a56afdab3e7f9e6f70f47bf4230e5
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

Singular/LIB/dmod.lib
r92f225 re64e417 65 65 Sannfslog(F[,eng]); compute Ann^(1) F^s in D[s] for a polynomial F 66 66 bernsteinBM(F[,eng]); compute global Bernstein polynomial for a polynomial F (algorithm of BrianconMaisonobe) 67 bernsteinLift(I,F [,eng]); compute a possible multiple of Bernstein polynomial via liftlike procedure 67 68 operatorBM(F[,eng]); compute Ann F^s, Ann F^s0, BS and PS for a polynomial F (algorithm of BrianconMaisonobe) 68 69 operatorModulo(F, I, b); compute PS via the modulo approach … … 70 71 annfsBMI(F[,eng]); compute Ann F^s and Bernstein ideal for a polynomial F=f1*..*fP (multivariate algorithm of BrianconMaisonobe) 71 72 checkRoot(F,a[,S,eng]); check if a given rational is a root of the global Bernstein polynomial of F and compute its multiplicity 72 annfsBM(F[,eng]); compute Ann F^s0 in D and Bernstein polynomial for a polynomial F (algorithm of BrianconMaisonobe)73 annfsLOT(F[,eng]); compute Ann F^s0 in D and Bernstein polynomial for a polynomial F (Levandovskyy modification of the OakuTakayama algorithm)74 annfsOT(F[,eng]); compute Ann F^s0 in D and Bernstein polynomial for a polynomial F (algorithm of OakuTakayama)75 SannfsBM(F[,eng]); compute Ann F^s in D[s] for a polynomial F (algorithm of BrianconMaisonobe)76 73 SannfsBFCT(F[,eng]); compute Ann F^s in D[s] for a polynomial F (algorithm of BrianconMaisonobe, other output ordering) 77 SannfsLOT(F[,eng]); compute Ann F^s in D[s] for a polynomial F (Levandovskyy modification of the OakuTakayama algorithm)78 SannfsOT(F[,eng]); compute Ann F^s in D[s] for a polynomial F (algorithm of OakuTakayama)79 74 annfs0(I,F [,eng]); compute Ann F^s0 in D and Bernstein polynomial from the known Ann F^s in D[s] 80 75 annfs2(I,F [,eng]); compute Ann F^s0 in D and Bernstein polynomial from the known Ann F^s in D[s] by using a trick of Noro 81 annfsRB(I,F [,eng]); compute Ann F^s0 in D and Bernstein polynomial from the known Ann F^s in D[s] by reduceB strategy of Macaulay 82 checkRoot1(I,F,a[,eng]); check whether a rational is a root of the global Bernstein polynomial of F from the known Ann F^s in D[s] 83 checkRoot2(I,F,a[,eng]); check whether a rational is a root of the global Bernstein polynomial of F and compute its multiplicity from the known Ann F^s in D[s] 76 annfsRB(I,F [,eng]); compute Ann F^s0 in D and Bernstein polynomial from the known Ann F^s in D[s] by using Jacobian ideal 84 77 checkFactor(I,F,q[,eng]); check whether a polynomial q in K[s] is a factor of the global Bernstein polynomial of F from the known Ann F^s in D[s] 85 78 … … 96 89 SEE ALSO: gmssing_lib, bfun_lib, dmodapp_lib 97 90 "; 91 92 // added by VL on 2.3.2010: bernsteinLift 93 // ****** commented out for better readability by VL on 2.3.2010 94 // annfsBM(F[,eng]); compute Ann F^s0 in D and Bernstein polynomial for a polynomial F (algorithm of BrianconMaisonobe) 95 // annfsLOT(F[,eng]); compute Ann F^s0 in D and Bernstein polynomial for a polynomial F (Levandovskyy modification of the OakuTakayama algorithm) 96 // annfsOT(F[,eng]); compute Ann F^s0 in D and Bernstein polynomial for a polynomial F (algorithm of OakuTakayama) 97 // SannfsBM(F[,eng]); compute Ann F^s in D[s] for a polynomial F (algorithm of BrianconMaisonobe) 98 // SannfsLOT(F[,eng]); compute Ann F^s in D[s] for a polynomial F (Levandovskyy modification of the OakuTakayama algorithm) 99 // SannfsOT(F[,eng]); compute Ann F^s in D[s] for a polynomial F (algorithm of OakuTakayama) 100 // checkRoot1(I,F,a[,eng]); check whether a rational is a root of the global Bernstein polynomial of F from the known Ann F^s in D[s] 101 // checkRoot2(I,F,a[,eng]); check whether a rational is a root of the global Bernstein polynomial of F and compute its multiplicity from the known Ann F^s in D[s] 98 102 99 103 LIB "matrix.lib"; // for submat … … 1409 1413 1410 1414 // try to replace s with s1 => data is shorter as in annfs2 1411 // and use Macaulay'sreduceB strategy, that is add1412 // not F but <F,dF/dx1,...,dF/dxN>; the resulting Bfunction1415 // and use what Macaulay2 people call reduceB strategy, that is add 1416 // not F but Tjurina ideal <F,dF/dx1,...,dF/dxN>; the resulting Bfunction 1413 1417 // has to be multiplied with (s+1) at the very end 1414 1418 proc annfsRB(ideal I, poly F, list #) … … 1422 1426 @* If eng <>0, @code{std} is used for Groebner basis computations, 1423 1427 @* otherwise and by default @code{slimgb} is used. 1424 @* This procedure follows the 'reduceB' strategy, used in Macaulay2.1428 @* This procedure uses in addition to F its Jacobian ideal. 1425 1429 DISPLAY: If @code{printlevel}=1, progress debug messages will be printed, 1426 1430 @* if @code{printlevel}>=2, all the debug messages will be printed. … … 5930 5934 } 5931 5935 5936 proc bernsteinLift(ideal I, poly F, list #) 5937 "USAGE: bernsteinLift(I, F [,eng]); I an ideal, F a poly, eng an optional int 5938 RETURN: list 5939 PURPOSE: compute the (multiple of) BernsteinSato polynomial with liftlike method, 5940 @* based on the output of Sannfslike procedure 5941 NOTE: the output list contains the roots with multiplicities of the candidate 5942 @* for being BernsteinSato polynomial of f. 5943 @* If eng <>0, @code{std} is used for Groebner basis computations, 5944 @* otherwise and by default @code{slimgb} is used. 5945 @* If printlevel=1, progress debug messages will be printed, 5946 @* if printlevel>=2, all the debug messages will be printed. 5947 EXAMPLE: example bernsteinLift; shows examples 5948 " 5949 { 5950 // assume: s is the last variable! check in the code 5951 int eng = 0; 5952 if ( size(#)>0 ) 5953 { 5954 if ( typeof(#[1]) == "int" ) 5955 { 5956 eng = int(#[1]); 5957 } 5958 } 5959 def @R2 = basering; 5960 int Nnew = nvars(@R2); 5961 int N = Nnew/2; 5962 int ppl = printlevelvoice+2; 5963 // we're in D_n[s], where the elim ord for s is set 5964 // create D_n(s) 5965 // create the ordinary Weyl algebra and put the result into it, 5966 // keep: N, i,j,s, tmp, RL 5967 Nnew = Nnew  1; // former 2*N; 5968 list L = 0; 5969 list Lord, tmp; 5970 intvec iv; int i; 5971 list RL = ringlist(basering); 5972 // if we work over alg. extension => problem! 5973 if (size(RL[1]) > 1) 5974 { 5975 ERROR("cannot work over algebraic field extension"); 5976 } 5977 tmp[1] = RL[1]; // char 5978 tmp[2] = list("s"); 5979 tmp[3] = list(list("lp",int(1))); 5980 tmp[4] = ideal(0); 5981 L[1] = tmp; // field 5982 tmp = 0; 5983 L[4] = RL[4]; // factor ideal 5984 5985 // check whether vars have admissible names > done earlier 5986 // list Name = RL[2]M 5987 // DName is defined earlier 5988 list NName; // = RL[2]; // skip the last var 's' 5989 for (i=1; i<=Nnew; i++) 5990 { 5991 NName[i] = RL[2][i]; 5992 } 5993 L[2] = NName; 5994 // (c, ) ordering: 5995 tmp[1] = "c"; 5996 iv = 0; 5997 tmp[2] = iv; 5998 Lord[1] = tmp; 5999 tmp=0; 6000 // dp ordering; 6001 string s = "iv="; 6002 for (i=1; i<=Nnew; i++) 6003 { 6004 s = s+"1,"; 6005 } 6006 s[size(s)] = ";"; 6007 execute(s); 6008 tmp = 0; 6009 tmp[1] = "dp"; // string 6010 tmp[2] = iv; // intvec 6011 Lord[2] = tmp; 6012 kill s; 6013 tmp = 0; 6014 L[3] = Lord; 6015 // we are done with the list 6016 // Add: Plural part 6017 def @R4@ = ring(L); 6018 setring @R4@; 6019 matrix @D[Nnew][Nnew]; 6020 for (i=1; i<=N; i++) 6021 { 6022 @D[i,N+i]=1; 6023 } 6024 def @R4 = nc_algebra(1,@D); 6025 setring @R4; 6026 kill @R4@; 6027 dbprint(ppl,"// 31 the ring K(s)<x,dx> is ready"); 6028 dbprint(ppl1, @R4); 6029 // map things correctly, using names 6030 ideal J = imap(@R2, I), imap(@R2,F); 6031 module M; 6032 // make leadcoeffs positive 6033 for (i=1; i<= ncols(J); i++) 6034 { 6035 if (J[i]!=0) 6036 { 6037 M[i] = J[i]*gen(1) + gen(1+i); 6038 } 6039 } 6040 dbprint(ppl,"// 32 starting GB of the assoc. module M"); 6041 M = engine(M,eng); 6042 dbprint(ppl,"// 33 finished GB of the assoc. module M"); 6043 dbprint(ppl1, M); 6044 // now look for (1) entry with 1st comp nonzero 6045 // determine whether there are several 1st comps nonzero 6046 module M2; 6047 for (i=1; i<= ncols(M); i++) 6048 { 6049 if (M[1,i]!=0) 6050 { 6051 M2 = M2, M[i]; 6052 } 6053 } 6054 M2 = simplify(M2,2); // skip 0s 6055 if (ncols(M2) > 1) 6056 { 6057 dbprint(ppl,"// * more than 1 element with nonzero leading component"); 6058 option(redSB); option(redTail); // set them back? 6059 M2 = interred(M2); 6060 if (ncols(M2) > 1) 6061 { 6062 ERROR("more than one leading component after interred: assume violation!"); 6063 } 6064 if (leadexp(M2[1]) != 0) 6065 { 6066 ERROR("nonconstant entry after interred: assume violation!"); 6067 } 6068 } 6069 // now there's only one elt with leadcomp<>0 6070 vector V = M2[1]; 6071 number bcand = leadcoef(V[1]); // 1st component 6072 V[1]=0; 6073 number ct = content(V); // content of the cofactors 6074 poly CF = ct*V[ncols(J)]; // polynomial in K[s]<x,dx>, cofactor to F 6075 dbprint(ppl,"// 34 the cofactor candidate found"); 6076 dbprint(ppl1,CF); 6077 dbprint(ppl,"// 35 the entry as it is"); 6078 dbprint(ppl1,bcand); 6079 bcand = bcand*ct; // a product of both 6080 dbprint(ppl,"// 36 the content of the rest vector"); 6081 dbprint(ppl1,ct); 6082 ring @R3 = 0,s,dp; 6083 dbprint(ppl,"// 41 the ring @R3 i.e. K[s] is ready"); 6084 poly bcand = imap(@R4,bcand); 6085 dbprint(ppl,"// 42 factorization"); 6086 list P = factorize(bcand); //with constants and multiplicities 6087 ideal bs; intvec m; //the Bernstein polynomial is monic, so we are not interested in constants 6088 for (i=2; i<= size(P[1]); i++) //we delete P[1][1] and P[2][1] 6089 { 6090 bs[i1] = P[1][i]; 6091 m[i1] = P[2][i]; 6092 } 6093 bs = normalize(bs); bs = subst(bs,s,0); // to get roots only 6094 setring @R2; // the ring the story started with 6095 ideal bs = imap(@R3,bs); // intvec m is global 6096 intvec mm = m; m = 0; 6097 kill @R3; // kills m as well.... 6098 list @L = list(bs, mm); 6099 // look for (2) return the GB of syzygies? 6100 return(@L); 6101 } 6102 example 6103 { "EXAMPLE:"; echo = 2; 6104 ring r = 0,(x,y,z),Dp; 6105 poly F = x^3+y^3+z^3; 6106 printlevel = 0; 6107 def A = Sannfs(F); setring A; 6108 LD; 6109 poly F = imap(r,F); 6110 list L = bernsteinLift(LD,F); L; 6111 poly bs = fl2poly(L,"s"); bs; // the candidate for BernsteinSato polynomial 6112 } 6113 5932 6114 /// ****** EXAMPLES ************ 5933 6115
Note: See TracChangeset
for help on using the changeset viewer.