[380a17b] | 1 | ////////////////////////////////////////////////////////////////////////////// |
---|
[6391eb] | 2 | version="version mondromy.lib 4.1.2.0 Feb_2019 "; // $Id$ |
---|
[fd3fb7] | 3 | category="Singularities"; |
---|
[de9f10] | 4 | info=" |
---|
[8942a5] | 5 | LIBRARY: mondromy.lib Monodromy of an Isolated Hypersurface Singularity |
---|
[091424] | 6 | AUTHOR: Mathias Schulze, email: mschulze@mathematik.uni-kl.de |
---|
| 7 | |
---|
[337919] | 8 | OVERVIEW: |
---|
| 9 | A library to compute the monodromy of an isolated hypersurface singularity. |
---|
| 10 | It uses an algorithm by Brieskorn (manuscripta math. 2 (1970), 103-161) to |
---|
| 11 | compute a connection matrix of the meromorphic Gauss-Manin connection up to |
---|
| 12 | arbitrarily high order, and an algorithm of Gerard and Levelt (Ann. Inst. |
---|
[091424] | 13 | Fourier, Grenoble 23,1 (1973), pp. 157-195) to transform it to a simple pole. |
---|
[de9f10] | 14 | |
---|
[f34c37c] | 15 | PROCEDURES: |
---|
[de9f10] | 16 | detadj(U); determinant and adjoint matrix of square matrix U |
---|
[8942a5] | 17 | invunit(u,n); series inverse of polynomial u up to order n |
---|
[1eb7af] | 18 | jacoblift(f); lifts f^kappa in jacob(f) with minimal kappa |
---|
[efda70a] | 19 | monodromyB(f[,opt]); monodromy of isolated hypersurface singularity f |
---|
[0b59f5] | 20 | H2basis(f); basis of Brieskorn lattice H'' |
---|
[efda70a] | 21 | |
---|
[f01a1a] | 22 | KEYWORDS: Monodromy; hypersurface singularity; Gauss-Manin connection; |
---|
[efda70a] | 23 | Brieskorn lattice |
---|
| 24 | |
---|
[1e5e70b] | 25 | SEE ALSO: gmspoly_lib, gmssing_lib |
---|
[de9f10] | 26 | "; |
---|
| 27 | |
---|
| 28 | LIB "ring.lib"; |
---|
| 29 | LIB "sing.lib"; |
---|
[6dd42a] | 30 | LIB "linalg.lib"; |
---|
[0f8696] | 31 | |
---|
[de9f10] | 32 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 33 | |
---|
| 34 | static proc pcvladdl(list l1,list l2) |
---|
| 35 | { |
---|
| 36 | return(system("pcvLAddL",l1,l2)); |
---|
| 37 | } |
---|
| 38 | |
---|
| 39 | static proc pcvpmull(poly p,list l) |
---|
| 40 | { |
---|
| 41 | return(system("pcvPMulL",p,l)); |
---|
| 42 | } |
---|
| 43 | |
---|
| 44 | static proc pcvmindeg(list #) |
---|
| 45 | { |
---|
| 46 | return(system("pcvMinDeg",#[1])); |
---|
| 47 | } |
---|
| 48 | |
---|
| 49 | static proc pcvp2cv(list l,int i0,int i1) |
---|
| 50 | { |
---|
| 51 | return(system("pcvP2CV",l,i0,i1)); |
---|
| 52 | } |
---|
| 53 | |
---|
| 54 | static proc pcvcv2p(list l,int i0,int i1) |
---|
| 55 | { |
---|
| 56 | return(system("pcvCV2P",l,i0,i1)); |
---|
| 57 | } |
---|
| 58 | |
---|
| 59 | static proc pcvdim(int i0,int i1) |
---|
| 60 | { |
---|
| 61 | return(system("pcvDim",i0,i1)); |
---|
| 62 | } |
---|
| 63 | |
---|
| 64 | static proc pcvbasis(int i0,int i1) |
---|
| 65 | { |
---|
| 66 | return(system("pcvBasis",i0,i1)); |
---|
| 67 | } |
---|
| 68 | |
---|
| 69 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 70 | |
---|
| 71 | static proc min(intvec v) |
---|
| 72 | { |
---|
| 73 | int m=v[1]; |
---|
| 74 | int i; |
---|
| 75 | for(i=2;i<=size(v);i++) |
---|
| 76 | { |
---|
| 77 | if(m>v[i]) |
---|
| 78 | { |
---|
| 79 | m=v[i]; |
---|
| 80 | } |
---|
| 81 | } |
---|
| 82 | return(m); |
---|
| 83 | } |
---|
| 84 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 85 | |
---|
| 86 | static proc max(intvec v) |
---|
| 87 | { |
---|
| 88 | int m=v[1]; |
---|
| 89 | int i; |
---|
| 90 | for(i=2;i<=size(v);i++) |
---|
| 91 | { |
---|
| 92 | if(m<v[i]) |
---|
| 93 | { |
---|
| 94 | m=v[i]; |
---|
| 95 | } |
---|
| 96 | } |
---|
| 97 | return(m); |
---|
| 98 | } |
---|
| 99 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 100 | |
---|
| 101 | static proc mdivp(matrix m,poly p) |
---|
| 102 | { |
---|
| 103 | int i,j; |
---|
| 104 | for(i=nrows(m);i>=1;i--) |
---|
| 105 | { |
---|
| 106 | for(j=ncols(m);j>=1;j--) |
---|
| 107 | { |
---|
| 108 | m[i,j]=m[i,j]/p; |
---|
| 109 | } |
---|
| 110 | } |
---|
[917fb5] | 111 | return(m); |
---|
[de9f10] | 112 | } |
---|
| 113 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 114 | |
---|
| 115 | proc codimV(list V,int N) |
---|
| 116 | { |
---|
| 117 | int codim=pcvdim(0,N); |
---|
| 118 | if(size(V)>0) |
---|
| 119 | { |
---|
| 120 | dbprint(printlevel-voice+2,"//vector space dimension: "+string(codim)); |
---|
[1eb7af] | 121 | dbprint(printlevel-voice+2, |
---|
| 122 | "//number of subspace generators: "+string(size(V))); |
---|
[de9f10] | 123 | int t=timer; |
---|
| 124 | codim=codim-ncols(interred(module(V[1..size(V)]))); |
---|
[1eb7af] | 125 | dbprint(printlevel-voice+2,"//codimension: "+string(codim)); |
---|
[de9f10] | 126 | } |
---|
| 127 | return(codim); |
---|
| 128 | } |
---|
| 129 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 130 | |
---|
| 131 | proc quotV(list V,int N) |
---|
| 132 | { |
---|
| 133 | module Q=freemodule(pcvdim(0,N)); |
---|
| 134 | if(size(V)>0) |
---|
| 135 | { |
---|
| 136 | dbprint(printlevel-voice+2,"//vector space dimension: "+string(nrows(Q))); |
---|
[1eb7af] | 137 | dbprint(printlevel-voice+2, |
---|
| 138 | "//number of subspace generators: "+string(size(V))); |
---|
[de9f10] | 139 | int t=timer; |
---|
| 140 | Q=interred(reduce(std(Q),std(module(V[1..size(V)])))); |
---|
| 141 | } |
---|
| 142 | return(list(Q[1..size(Q)])); |
---|
| 143 | } |
---|
| 144 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 145 | proc invunit(poly u,int n) |
---|
[1eb7af] | 146 | "USAGE: invunit(u,n); u poly, n int |
---|
[de9f10] | 147 | ASSUME: The polynomial u is a series unit. |
---|
| 148 | RETURN: The procedure returns the series inverse of u up to order n |
---|
| 149 | or a zero polynomial if u is no series unit. |
---|
[4ad2bb] | 150 | DISPLAY: The procedure displays comments if printlevel>=1. |
---|
[de9f10] | 151 | EXAMPLE: example invunit; shows an example. |
---|
| 152 | " |
---|
| 153 | { |
---|
| 154 | if(pcvmindeg(u)==0) |
---|
| 155 | { |
---|
| 156 | dbprint(printlevel-voice+2,"//computing inverse..."); |
---|
| 157 | int t=timer; |
---|
[3c23b65] | 158 | poly u0=jet(u,0); |
---|
| 159 | u=jet(1-u/u0,n); |
---|
| 160 | poly ui=u; |
---|
| 161 | poly v=1+u; |
---|
| 162 | int i; |
---|
[5602535] | 163 | for(i=n div pcvmindeg(u);i>1;i--) |
---|
[0f8696] | 164 | { |
---|
[3c23b65] | 165 | ui=jet(ui*u,n); |
---|
| 166 | v=v+ui; |
---|
[0f8696] | 167 | } |
---|
[337919] | 168 | v=jet(v,n)/u0; |
---|
[de9f10] | 169 | dbprint(printlevel-voice+2,"//...inverse computed ["+string(timer-t)+ |
---|
[97a7b44] | 170 | " secs, "+string((memory(1)+1023)/1024)+" K]"); |
---|
[0f8696] | 171 | return(v); |
---|
[de9f10] | 172 | } |
---|
| 173 | else |
---|
| 174 | { |
---|
| 175 | print("//no series unit"); |
---|
| 176 | return(poly(0)); |
---|
| 177 | } |
---|
| 178 | } |
---|
| 179 | example |
---|
| 180 | { "EXAMPLE:"; echo=2; |
---|
[0f8696] | 181 | ring R=0,(x,y),dp; |
---|
[3c23b65] | 182 | invunit(2+x3+xy4,10); |
---|
[de9f10] | 183 | } |
---|
[0f8696] | 184 | |
---|
[de9f10] | 185 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 186 | |
---|
| 187 | proc detadj(module U) |
---|
| 188 | "USAGE: detadj(U); U matrix |
---|
| 189 | ASSUME: U is a square matrix with non zero determinant. |
---|
| 190 | RETURN: The procedure returns a list with at most 2 entries. |
---|
[3a0213] | 191 | If U is not a square matrix, the list is empty. |
---|
| 192 | If U is a square matrix, then the first entry is the determinant of U. |
---|
[917fb5] | 193 | If U is a square matrix and the determinant of U not zero, |
---|
[de9f10] | 194 | then the second entry is the adjoint matrix of U. |
---|
[4ad2bb] | 195 | DISPLAY: The procedure displays comments if printlevel>=1. |
---|
[de9f10] | 196 | EXAMPLE: example detadj; shows an example. |
---|
| 197 | " |
---|
| 198 | { |
---|
| 199 | if(nrows(U)==ncols(U)) |
---|
| 200 | { |
---|
| 201 | dbprint(printlevel-voice+2,"//computing determinant..."); |
---|
| 202 | int t=timer; |
---|
| 203 | poly detU=det(U); |
---|
| 204 | dbprint(printlevel-voice+2,"//...determinant computed ["+string(timer-t)+ |
---|
[97a7b44] | 205 | " secs, "+string((memory(1)+1023)/1024)+" K]"); |
---|
[de9f10] | 206 | |
---|
| 207 | if(detU==0) |
---|
| 208 | { |
---|
| 209 | print("//determinant zero"); |
---|
| 210 | return(list(detU)); |
---|
| 211 | } |
---|
| 212 | else |
---|
| 213 | { |
---|
| 214 | def br=basering; |
---|
[1e1ec4] | 215 | def pr=changeord(list(list("dp",1:nvars(basering)))); |
---|
| 216 | setring pr; |
---|
[de9f10] | 217 | matrix U=fetch(br,U); |
---|
| 218 | poly detU=fetch(br,detU); |
---|
| 219 | |
---|
| 220 | dbprint(printlevel-voice+2,"//computing adjoint matrix..."); |
---|
| 221 | t=timer; |
---|
| 222 | matrix adjU=lift(U,detU*freemodule(nrows(U))); |
---|
| 223 | dbprint(printlevel-voice+2,"//...adjoint matrix computed [" |
---|
[97a7b44] | 224 | +string(timer-t)+" secs, "+string((memory(1)+1023)/1024)+" K]"); |
---|
[de9f10] | 225 | |
---|
| 226 | setring br; |
---|
| 227 | matrix adjU=fetch(pr,adjU); |
---|
| 228 | kill pr; |
---|
| 229 | } |
---|
| 230 | } |
---|
| 231 | else |
---|
| 232 | { |
---|
| 233 | print("//no square matrix"); |
---|
| 234 | return(list()); |
---|
| 235 | } |
---|
| 236 | |
---|
| 237 | return(list(detU,adjU)); |
---|
| 238 | } |
---|
| 239 | example |
---|
| 240 | { "EXAMPLE:"; echo=2; |
---|
| 241 | ring R=0,x,dp; |
---|
| 242 | matrix U[2][2]=1,1+x,1+x2,1+x3; |
---|
| 243 | list daU=detadj(U); |
---|
| 244 | daU[1]; |
---|
| 245 | print(daU[2]); |
---|
| 246 | } |
---|
| 247 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 248 | |
---|
[1eb7af] | 249 | proc jacoblift(poly f) |
---|
| 250 | "USAGE: jacoblift(f); f poly |
---|
[917fb5] | 251 | ASSUME: The polynomial f in a series ring (local ordering) defines |
---|
[1eb7af] | 252 | an isolated hypersurface singularity. |
---|
[917fb5] | 253 | RETURN: The procedure returns a list with entries kappa, xi, u of type |
---|
[1eb7af] | 254 | int, vector, poly such that kappa is minimal with f^kappa in jacob(f), |
---|
| 255 | u is a unit, and u*f^kappa=(matrix(jacob(f))*xi)[1,1]. |
---|
[4ad2bb] | 256 | DISPLAY: The procedure displays comments if printlevel>=1. |
---|
[1eb7af] | 257 | EXAMPLE: example jacoblift; shows an example. |
---|
| 258 | " |
---|
[de9f10] | 259 | { |
---|
| 260 | dbprint(printlevel-voice+2,"//computing kappa..."); |
---|
| 261 | int t=timer; |
---|
| 262 | ideal jf=jacob(f); |
---|
| 263 | ideal sjf=std(jf); |
---|
| 264 | int kappa=1; |
---|
| 265 | poly fkappa=f; |
---|
| 266 | while(reduce(fkappa,sjf)!=0) |
---|
| 267 | { |
---|
| 268 | dbprint(printlevel-voice+2,"//kappa="+string(kappa)); |
---|
| 269 | kappa++; |
---|
| 270 | fkappa=fkappa*f; |
---|
| 271 | } |
---|
| 272 | dbprint(printlevel-voice+2,"//kappa="+string(kappa)); |
---|
[4ad2bb] | 273 | dbprint(printlevel-voice+2,"//...kappa computed ["+string(timer-t)+" secs, " |
---|
[97a7b44] | 274 | +string((memory(1)+1023)/1024)+" K]"); |
---|
[de9f10] | 275 | |
---|
| 276 | dbprint(printlevel-voice+2,"//computing xi..."); |
---|
| 277 | t=timer; |
---|
| 278 | vector xi=lift(jf,fkappa)[1]; |
---|
[4ad2bb] | 279 | dbprint(printlevel-voice+2,"//...xi computed ["+string(timer-t)+" secs, " |
---|
[97a7b44] | 280 | +string((memory(1)+1023)/1024)+" K]"); |
---|
[de9f10] | 281 | |
---|
| 282 | dbprint(printlevel-voice+2,"//computing u..."); |
---|
| 283 | t=timer; |
---|
| 284 | poly u=(matrix(jf)*xi)[1,1]/fkappa; |
---|
[4ad2bb] | 285 | dbprint(printlevel-voice+2,"//...u computed ["+string(timer-t)+" secs, " |
---|
[97a7b44] | 286 | +string((memory(1)+1023)/1024)+" K]"); |
---|
[de9f10] | 287 | |
---|
[1eb7af] | 288 | return(list(kappa,xi,u)); |
---|
| 289 | } |
---|
| 290 | example |
---|
| 291 | { "EXAMPLE:"; echo=2; |
---|
| 292 | ring R=0,(x,y),ds; |
---|
| 293 | poly f=x2y2+x6+y6; |
---|
| 294 | jacoblift(f); |
---|
[de9f10] | 295 | } |
---|
| 296 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 297 | |
---|
| 298 | static proc getdeltaP1(poly f,int K,int N,int dN) |
---|
| 299 | { |
---|
| 300 | return(pcvpmull(f^K,pcvbasis(0,N+dN-K*pcvmindeg(f)))); |
---|
| 301 | } |
---|
| 302 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 303 | |
---|
| 304 | static proc getdeltaP2(poly f,int N,int dN) |
---|
| 305 | { |
---|
| 306 | def of,jf=pcvmindeg(f),jacob(f); |
---|
| 307 | list b=pcvbasis(N-of+2,N+dN-of+2); |
---|
| 308 | list P2; |
---|
[85ba0a] | 309 | P2[size(b)*((nvars(basering)-1)*nvars(basering)) div 2]=0; |
---|
[de9f10] | 310 | int i,j,k,l; |
---|
| 311 | intvec alpha; |
---|
| 312 | for(k,l=1,1;k<=size(b);k++) |
---|
| 313 | { |
---|
| 314 | alpha=leadexp(b[k]); |
---|
| 315 | for(i=nvars(basering)-1;i>=1;i--) |
---|
| 316 | { |
---|
| 317 | for(j=nvars(basering);j>i;j--) |
---|
| 318 | { |
---|
| 319 | P2[l]=alpha[i]*jf[j]*(b[k]/var(i))-alpha[j]*jf[i]*(b[k]/var(j)); |
---|
| 320 | l++; |
---|
| 321 | } |
---|
| 322 | } |
---|
| 323 | } |
---|
| 324 | return(P2); |
---|
| 325 | } |
---|
| 326 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 327 | |
---|
| 328 | static proc getdeltaPe(poly f,list e,int K,int dK) |
---|
| 329 | { |
---|
| 330 | int k; |
---|
| 331 | list Pe,fke; |
---|
| 332 | for(k,fke=K,pcvpmull(f^K,e);k<K+dK;k,fke=k+1,pcvpmull(f,fke)) |
---|
| 333 | { |
---|
| 334 | Pe=Pe+fke; |
---|
| 335 | } |
---|
| 336 | return(Pe); |
---|
| 337 | } |
---|
| 338 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 339 | |
---|
| 340 | static proc incK(poly f,int mu,int K,int deltaK,int N, |
---|
| 341 | list e,list P1,list P2,list Pe,list V1,list V2,list Ve) |
---|
| 342 | { |
---|
| 343 | int deltaN=deltaK*pcvmindeg(f); |
---|
| 344 | |
---|
| 345 | list deltaP1; |
---|
| 346 | P1=pcvpmull(f^deltaK,P1); |
---|
| 347 | V1=pcvp2cv(P1,0,N+deltaN); |
---|
| 348 | |
---|
| 349 | list deltaP2=getdeltaP2(f,N,deltaN); |
---|
| 350 | V2=pcvladdl(V2,pcvp2cv(P2,N,N+deltaN))+pcvp2cv(deltaP2,0,N+deltaN); |
---|
| 351 | P2=P2+deltaP2; |
---|
| 352 | |
---|
| 353 | list deltaPe=getdeltaPe(f,e,K,deltaK); |
---|
| 354 | Ve=pcvladdl(Ve,pcvp2cv(Pe,N,N+deltaN))+pcvp2cv(deltaPe,0,N+deltaN); |
---|
| 355 | Pe=Pe+deltaPe; |
---|
| 356 | |
---|
| 357 | K=K+deltaK; |
---|
| 358 | dbprint(printlevel-voice+2,"//K="+string(K)); |
---|
| 359 | |
---|
| 360 | N=N+deltaN; |
---|
| 361 | dbprint(printlevel-voice+2,"//N="+string(N)); |
---|
| 362 | |
---|
| 363 | deltaN=1; |
---|
[1eb7af] | 364 | dbprint(printlevel-voice+2,"//computing codimension of"); |
---|
| 365 | dbprint(printlevel-voice+2,"//df^dOmega^(n-1)+f^K*Omega^(n+1) in " |
---|
| 366 | +"Omega^(n+1) mod m^N*Omega^(n+1)..."); |
---|
| 367 | int t=timer; |
---|
[de9f10] | 368 | while(codimV(V1+V2,N)<K*mu) |
---|
| 369 | { |
---|
[1eb7af] | 370 | dbprint(printlevel-voice+2,"//...codimension computed ["+string(timer-t) |
---|
[97a7b44] | 371 | +" secs, "+string((memory(1)+1023)/1024)+" K]"); |
---|
[1eb7af] | 372 | |
---|
[de9f10] | 373 | deltaP1=getdeltaP1(f,K,N,deltaN); |
---|
| 374 | V1=pcvladdl(V1,pcvp2cv(P1,N,N+deltaN))+pcvp2cv(deltaP1,0,N+deltaN); |
---|
| 375 | P1=P1+deltaP1; |
---|
| 376 | |
---|
| 377 | deltaP2=getdeltaP2(f,N,deltaN); |
---|
| 378 | V2=pcvladdl(V2,pcvp2cv(P2,N,N+deltaN))+pcvp2cv(deltaP2,0,N+deltaN); |
---|
| 379 | P2=P2+deltaP2; |
---|
| 380 | |
---|
| 381 | Ve=pcvladdl(Ve,pcvp2cv(Pe,N,N+deltaN)); |
---|
| 382 | |
---|
| 383 | N=N+deltaN; |
---|
| 384 | dbprint(printlevel-voice+2,"//N="+string(N)); |
---|
[1eb7af] | 385 | |
---|
| 386 | dbprint(printlevel-voice+2,"//computing codimension of"); |
---|
| 387 | dbprint(printlevel-voice+2,"//df^dOmega^(n-1)+f^K*Omega^(n+1) in " |
---|
| 388 | +"Omega^(n+1) mod m^N*Omega^(n+1)..."); |
---|
| 389 | t=timer; |
---|
[de9f10] | 390 | } |
---|
[1eb7af] | 391 | dbprint(printlevel-voice+2,"//...codimension computed ["+string(timer-t) |
---|
[97a7b44] | 392 | +" secs, "+string((memory(1)+1023)/1024)+" K]"); |
---|
[de9f10] | 393 | |
---|
| 394 | return(K,N,P1,P2,Pe,V1,V2,Ve); |
---|
| 395 | } |
---|
| 396 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 397 | |
---|
| 398 | static proc nablaK(poly f,int kappa,vector xi,poly u,int N,int prevN, |
---|
| 399 | list Vnablae,list e) |
---|
| 400 | { |
---|
| 401 | xi=jet(xi,N); |
---|
| 402 | u=invunit(u,N); |
---|
| 403 | poly fkappa=kappa*f^(kappa-1); |
---|
| 404 | |
---|
| 405 | poly p,q; |
---|
| 406 | list nablae; |
---|
| 407 | int i,j; |
---|
| 408 | for(i=1;i<=size(e);i++) |
---|
| 409 | { |
---|
[917fb5] | 410 | for(j,p=nvars(basering),0;j>=1;j--) |
---|
[de9f10] | 411 | { |
---|
| 412 | q=jet(e[i]*xi[j],N); |
---|
| 413 | if(q!=0) |
---|
| 414 | { |
---|
| 415 | p=p+diff(q*jet(u,N-pcvmindeg(q)),var(j)); |
---|
| 416 | } |
---|
| 417 | } |
---|
| 418 | nablae=nablae+list(p-jet(fkappa*e[i],N-1)); |
---|
| 419 | } |
---|
| 420 | |
---|
| 421 | return(pcvladdl(Vnablae,pcvp2cv(nablae,prevN,N-prevN))); |
---|
| 422 | } |
---|
| 423 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 424 | |
---|
| 425 | static proc MK(poly f,int mu,int kappa,vector xi,poly u, |
---|
| 426 | int K,int N,int prevN,list e,list V1,list V2,list Ve,list Vnablae) |
---|
| 427 | { |
---|
| 428 | dbprint(printlevel-voice+2,"//computing nabla(e)..."); |
---|
| 429 | int t=timer; |
---|
| 430 | Vnablae=nablaK(f,kappa,xi,u,N,prevN,Vnablae,e); |
---|
| 431 | dbprint(printlevel-voice+2,"//...nabla(e) computed ["+string(timer-t) |
---|
[97a7b44] | 432 | +" secs, "+string((memory(1)+1023)/1024)+" K]"); |
---|
[de9f10] | 433 | |
---|
| 434 | dbprint(printlevel-voice+2, |
---|
[1eb7af] | 435 | "//lifting nabla(e) to C-basis of H''/t^KH''..."); |
---|
[de9f10] | 436 | list V=Ve+V1+V2; |
---|
| 437 | module W=module(V[1..size(V)]); |
---|
| 438 | dbprint(printlevel-voice+2,"//vector space dimension: "+string(nrows(W))); |
---|
| 439 | dbprint(printlevel-voice+2,"//number of generators: "+string(ncols(W))); |
---|
| 440 | t=timer; |
---|
| 441 | matrix C=lift(W,module(Vnablae[1..size(Vnablae)])); |
---|
| 442 | dbprint(printlevel-voice+2,"//...nabla(e) lifted ["+string(timer-t) |
---|
[97a7b44] | 443 | +" secs, "+string((memory(1)+1023)/1024)+" K]"); |
---|
[de9f10] | 444 | |
---|
[1eb7af] | 445 | dbprint(printlevel-voice+2,"//computing e-lift of nabla(e)..."); |
---|
[de9f10] | 446 | t=timer; |
---|
| 447 | int i1,i2,j,k; |
---|
| 448 | matrix M[mu][mu]; |
---|
| 449 | for(j=1;j<=mu;j++) |
---|
| 450 | { |
---|
| 451 | for(k,i2=0,1;k<K;k++) |
---|
| 452 | { |
---|
| 453 | for(i1=1;i1<=mu;i1,i2=i1+1,i2+1) |
---|
| 454 | { |
---|
| 455 | M[i1,j]=M[i1,j]+C[i2,j]*var(1)^k; |
---|
| 456 | } |
---|
| 457 | } |
---|
| 458 | } |
---|
[1eb7af] | 459 | dbprint(printlevel-voice+2,"//...e-lift of nabla(e) computed [" |
---|
[97a7b44] | 460 | +string(timer-t)+" secs, "+string((memory(1)+1023)/1024)+" K]"); |
---|
[de9f10] | 461 | |
---|
| 462 | return(M,N,Vnablae); |
---|
| 463 | } |
---|
| 464 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 465 | |
---|
| 466 | static proc mid(ideal l) |
---|
| 467 | { |
---|
| 468 | int i,j,id; |
---|
| 469 | int mid=0; |
---|
| 470 | for(i=size(l);i>=1;i--) |
---|
| 471 | { |
---|
| 472 | for(j=i-1;j>=1;j--) |
---|
| 473 | { |
---|
| 474 | id=int(l[i]-l[j]); |
---|
| 475 | id=max(intvec(id,-id)); |
---|
| 476 | mid=max(intvec(id,mid)); |
---|
| 477 | } |
---|
| 478 | } |
---|
| 479 | return(mid); |
---|
| 480 | } |
---|
| 481 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 482 | |
---|
| 483 | static proc decmide(matrix M,ideal eM0,list bM0) |
---|
| 484 | { |
---|
| 485 | matrix M0=jet(M,0); |
---|
| 486 | |
---|
| 487 | dbprint(printlevel-voice+2, |
---|
| 488 | "//computing basis U of generalized eigenspaces of M0..."); |
---|
| 489 | int t=timer; |
---|
| 490 | int i,j; |
---|
| 491 | matrix U,M0e; |
---|
| 492 | matrix E=freemodule(nrows(M)); |
---|
| 493 | for(i=ncols(eM0);i>=1;i--) |
---|
| 494 | { |
---|
| 495 | M0e=E; |
---|
| 496 | for(j=max(bM0[i]);j>=1;j--) |
---|
| 497 | { |
---|
| 498 | M0e=M0e*(M0-eM0[i]*E); |
---|
| 499 | } |
---|
| 500 | U=syz(M0e)+U; |
---|
| 501 | } |
---|
[4ad2bb] | 502 | dbprint(printlevel-voice+2,"//...U computed ["+string(timer-t)+" secs, " |
---|
[97a7b44] | 503 | +string((memory(1)+1023)/1024)+" K]"); |
---|
[de9f10] | 504 | |
---|
| 505 | dbprint(printlevel-voice+2,"//transforming M to U..."); |
---|
| 506 | t=timer; |
---|
| 507 | list daU=detadj(U); |
---|
| 508 | daU[2]=(1/number(daU[1]))*daU[2]; |
---|
| 509 | M=daU[2]*M*U; |
---|
[4ad2bb] | 510 | dbprint(printlevel-voice+2,"//...M transformed ["+string(timer-t)+" secs, " |
---|
[97a7b44] | 511 | +string((memory(1)+1023)/1024)+" K]"); |
---|
[de9f10] | 512 | |
---|
| 513 | dbprint(printlevel-voice+2, |
---|
| 514 | "//computing integer differences of eigenvalues of M0..."); |
---|
| 515 | t=timer; |
---|
| 516 | int k; |
---|
| 517 | intvec ideM0; |
---|
| 518 | ideM0[ncols(eM0)]=0; |
---|
| 519 | for(i=ncols(eM0);i>=1;i--) |
---|
| 520 | { |
---|
| 521 | for(j=ncols(eM0);j>=1;j--) |
---|
| 522 | { |
---|
| 523 | k=int(eM0[i]-eM0[j]); |
---|
| 524 | if(k) |
---|
| 525 | { |
---|
| 526 | if(k>0) |
---|
| 527 | { |
---|
| 528 | ideM0[i]=max(intvec(k,ideM0[i])); |
---|
| 529 | } |
---|
| 530 | else |
---|
| 531 | { |
---|
| 532 | ideM0[j]=max(intvec(-k,ideM0[j])); |
---|
| 533 | } |
---|
| 534 | } |
---|
| 535 | } |
---|
| 536 | } |
---|
| 537 | for(i,k=size(bM0),nrows(M);i>=1;i--) |
---|
| 538 | { |
---|
| 539 | for(j=sum(bM0[i]);j>=1;j--) |
---|
| 540 | { |
---|
| 541 | ideM0[k]=ideM0[i]; |
---|
| 542 | k--; |
---|
| 543 | } |
---|
| 544 | } |
---|
| 545 | dbprint(printlevel-voice+2, |
---|
| 546 | "//...integer differences of eigenvalues of M0 computed ["+string(timer-t) |
---|
[97a7b44] | 547 | +" secs, "+string((memory(1)+1023)/1024)+" K]"); |
---|
[de9f10] | 548 | |
---|
| 549 | dbprint(printlevel-voice+2,"//transforming M..."); |
---|
| 550 | t=timer; |
---|
| 551 | for(i=nrows(M);i>=1;i--) |
---|
| 552 | { |
---|
| 553 | if(!ideM0[i]) |
---|
| 554 | { |
---|
| 555 | M[i,i]=M[i,i]+1; |
---|
| 556 | } |
---|
| 557 | for(j=ncols(M);j>=1;j--) |
---|
| 558 | { |
---|
| 559 | if(ideM0[i]&&!ideM0[j]) |
---|
| 560 | { |
---|
| 561 | M[i,j]=M[i,j]*var(1); |
---|
| 562 | } |
---|
| 563 | else |
---|
| 564 | { |
---|
| 565 | if(!ideM0[i]&&ideM0[j]) |
---|
| 566 | { |
---|
| 567 | M[i,j]=M[i,j]/var(1); |
---|
| 568 | } |
---|
| 569 | } |
---|
| 570 | } |
---|
| 571 | } |
---|
[4ad2bb] | 572 | dbprint(printlevel-voice+2,"//...M transformed ["+string(timer-t)+" secs, " |
---|
[97a7b44] | 573 | +string((memory(1)+1023)/1024)+" K]"); |
---|
[de9f10] | 574 | |
---|
| 575 | return(M); |
---|
| 576 | } |
---|
| 577 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 578 | |
---|
| 579 | static proc nonqhmonodromy(poly f,int mu,int opt) |
---|
| 580 | { |
---|
[1eb7af] | 581 | dbprint(printlevel-voice+2,"//computing kappa, xi and u with "+ |
---|
| 582 | "u*f^kappa=(matrix(jacob(f))*xi)[1,1]..."); |
---|
| 583 | list jl=jacoblift(f); |
---|
| 584 | def kappa,xi,u=jl[1..3]; |
---|
[de9f10] | 585 | dbprint(printlevel-voice+2,"//...kappa, xi and u computed"); |
---|
| 586 | dbprint(printlevel-voice+2,"//kappa="+string(kappa)); |
---|
| 587 | if(kappa==1) |
---|
| 588 | { |
---|
[1eb7af] | 589 | dbprint(printlevel-voice+2, |
---|
| 590 | "//f quasihomogenous with respect to suitable coordinates"); |
---|
[de9f10] | 591 | } |
---|
| 592 | else |
---|
| 593 | { |
---|
[1eb7af] | 594 | dbprint(printlevel-voice+2, |
---|
| 595 | "//f not quasihomogenous for any choice of coordinates"); |
---|
[de9f10] | 596 | } |
---|
| 597 | dbprint(printlevel-voice+2,"//xi="); |
---|
| 598 | dbprint(printlevel-voice+2,xi); |
---|
| 599 | dbprint(printlevel-voice+2,"//u="+string(u)); |
---|
| 600 | |
---|
| 601 | int K,N,prevN; |
---|
| 602 | list e,P1,P2,Pe,V1,V2,Ve,Vnablae; |
---|
| 603 | |
---|
| 604 | dbprint(printlevel-voice+2,"//increasing K and N..."); |
---|
| 605 | K,N,P1,P2,Pe,V1,V2,Ve=incK(f,mu,K,1,N,e,P1,P2,Pe,V1,V2,Ve); |
---|
| 606 | dbprint(printlevel-voice+2,"//...K and N increased"); |
---|
| 607 | |
---|
[1eb7af] | 608 | dbprint(printlevel-voice+2,"//computing C{f}-basis e of Brieskorn lattice " |
---|
| 609 | +"H''=Omega^(n+1)/df^dOmega^(n-1)..."); |
---|
| 610 | int t=timer; |
---|
[de9f10] | 611 | e=pcvcv2p(quotV(V1+V2,N),0,N); |
---|
[4ad2bb] | 612 | dbprint(printlevel-voice+2,"//...e computed ["+string(timer-t)+" secs, " |
---|
[97a7b44] | 613 | +string((memory(1)+1023)/1024)+" K]"); |
---|
[de9f10] | 614 | |
---|
| 615 | dbprint(printlevel-voice+2,"//e="); |
---|
| 616 | dbprint(printlevel-voice+2,e); |
---|
| 617 | |
---|
| 618 | Pe=e; |
---|
| 619 | Ve=pcvp2cv(Pe,0,N); |
---|
| 620 | |
---|
| 621 | if(kappa==1) |
---|
| 622 | { |
---|
| 623 | dbprint(printlevel-voice+2, |
---|
| 624 | "//computing 0-jet M of e-matrix of t*nabla..."); |
---|
| 625 | matrix M=list(MK(f,mu,kappa,xi,u,K,N,prevN,e,V1,V2,Ve,Vnablae))[1]; |
---|
| 626 | dbprint(printlevel-voice+2,"//...M computed"); |
---|
| 627 | } |
---|
| 628 | else |
---|
| 629 | { |
---|
| 630 | dbprint(printlevel-voice+2, |
---|
| 631 | "//computing transformation matrix U to simple pole..."); |
---|
| 632 | |
---|
| 633 | dbprint(printlevel-voice+2,"//computing t*nabla-stable lattice..."); |
---|
| 634 | matrix M,prevU; |
---|
| 635 | matrix U=freemodule(mu)*var(1)^((mu-1)*(kappa-1)); |
---|
| 636 | int i; |
---|
| 637 | dbprint(printlevel-voice+2,"//comparing with previous lattice..."); |
---|
[1eb7af] | 638 | t=timer; |
---|
[6518eba] | 639 | for(i=mu-1;i>=1&&size(reduce(U,std(prevU),5))>0;i--) |
---|
[de9f10] | 640 | { |
---|
| 641 | dbprint(printlevel-voice+2,"//...compared with previous lattice [" |
---|
[97a7b44] | 642 | +string(timer-t)+" secs, "+string((memory(1)+1023)/1024)+" K]"); |
---|
[de9f10] | 643 | |
---|
| 644 | dbprint(printlevel-voice+2,"//increasing K and N..."); |
---|
| 645 | K,N,P1,P2,Pe,V1,V2,Ve=incK(f,mu,K,kappa-1,N,e,P1,P2,Pe,V1,V2,Ve); |
---|
| 646 | dbprint(printlevel-voice+2,"//...K and N increased"); |
---|
| 647 | |
---|
| 648 | dbprint(printlevel-voice+2, |
---|
| 649 | "//computing (K-1)-jet M of e-matrix of t^kappa*nabla..."); |
---|
| 650 | M,prevN,Vnablae=MK(f,mu,kappa,xi,u,K,N,prevN,e,V1,V2,Ve,Vnablae); |
---|
| 651 | dbprint(printlevel-voice+2,"//...M computed"); |
---|
| 652 | |
---|
| 653 | prevU=U; |
---|
| 654 | |
---|
| 655 | dbprint(printlevel-voice+2,"//enlarging lattice..."); |
---|
| 656 | t=timer; |
---|
| 657 | U=interred(jet(module(U)+module(var(1)*diff(U,var(1)))+ |
---|
| 658 | module(mdivp(M*U,var(1)^(kappa-1))),(kappa-1)*(mu-1))); |
---|
| 659 | dbprint(printlevel-voice+2,"//...lattice enlarged ["+string(timer-t) |
---|
[97a7b44] | 660 | +" secs, "+string((memory(1)+1023)/1024)+" K]"); |
---|
[de9f10] | 661 | |
---|
| 662 | dbprint(printlevel-voice+2,"//comparing with previous lattice..."); |
---|
| 663 | t=timer; |
---|
| 664 | } |
---|
| 665 | dbprint(printlevel-voice+2,"//...compared with previous lattice [" |
---|
[97a7b44] | 666 | +string(timer-t)+" secs, "+string((memory(1)+1023)/1024)+" K]"); |
---|
[de9f10] | 667 | dbprint(printlevel-voice+2,"//...t*nabla-stable lattice computed"); |
---|
| 668 | |
---|
| 669 | if(ncols(U)>nrows(U)) |
---|
| 670 | { |
---|
| 671 | dbprint(printlevel-voice+2, |
---|
[1eb7af] | 672 | "//computing C{f}-basis of t*nabla-stable lattice..."); |
---|
[de9f10] | 673 | t=timer; |
---|
| 674 | U=minbase(U); |
---|
| 675 | dbprint(printlevel-voice+2, |
---|
[1eb7af] | 676 | "//...C{f}-basis of t*nabla-stable lattice computed ["+string(timer-t) |
---|
[97a7b44] | 677 | +" secs, "+string((memory(1)+1023)/1024)+" K]"); |
---|
[de9f10] | 678 | } |
---|
| 679 | |
---|
| 680 | U=mdivp(U,var(1)^pcvmindeg(U)); |
---|
| 681 | |
---|
| 682 | dbprint(printlevel-voice+2,"//...U computed"); |
---|
| 683 | |
---|
| 684 | dbprint(printlevel-voice+2, |
---|
| 685 | "//computing determinant and adjoint matrix of U..."); |
---|
| 686 | list daU=detadj(U); |
---|
| 687 | poly p=var(1)^min(intvec(pcvmindeg(daU[2]),pcvmindeg(daU[1]))); |
---|
| 688 | daU[1]=daU[1]/p; |
---|
| 689 | daU[2]=mdivp(daU[2],p); |
---|
| 690 | dbprint(printlevel-voice+2, |
---|
| 691 | "//...determinant and adjoint matrix of U computed"); |
---|
| 692 | |
---|
| 693 | if(K<kappa+pcvmindeg(daU[1])) |
---|
| 694 | { |
---|
| 695 | dbprint(printlevel-voice+2,"//increasing K and N..."); |
---|
| 696 | K,N,P1,P2,Pe,V1,V2,Ve= |
---|
| 697 | incK(f,mu,K,kappa+pcvmindeg(daU[1])-K,N,e,P1,P2,Pe,V1,V2,Ve); |
---|
| 698 | dbprint(printlevel-voice+2,"//...K and N increased"); |
---|
| 699 | |
---|
| 700 | dbprint(printlevel-voice+2,"//computing M..."); |
---|
| 701 | M,prevN,Vnablae=MK(f,mu,kappa,xi,u,K,N,prevN,e,V1,V2,Ve,Vnablae); |
---|
| 702 | dbprint(printlevel-voice+2,"//...M computed"); |
---|
| 703 | } |
---|
| 704 | |
---|
| 705 | dbprint(printlevel-voice+2,"//transforming M/t^kappa to simple pole..."); |
---|
| 706 | t=timer; |
---|
| 707 | M=mdivp(daU[2]*(var(1)^kappa*diff(U,var(1))+M*U), |
---|
| 708 | leadcoef(daU[1])*var(1)^(kappa+pcvmindeg(daU[1])-1)); |
---|
| 709 | dbprint(printlevel-voice+2,"//...M/t^kappa transformed to simple pole [" |
---|
[97a7b44] | 710 | +string(timer-t)+" secs, "+string((memory(1)+1023)/1024)+" K]"); |
---|
[de9f10] | 711 | } |
---|
| 712 | |
---|
| 713 | if(opt==0) |
---|
| 714 | { |
---|
| 715 | dbprint(printlevel-voice+2, |
---|
[2948a39] | 716 | "//computing maximal integer difference delta of eigenvalues of M0..."); |
---|
[de9f10] | 717 | t=timer; |
---|
| 718 | list jd=jordan(M); |
---|
| 719 | def eM0,bM0=jd[1..2]; |
---|
| 720 | int delta=mid(eM0); |
---|
| 721 | dbprint(printlevel-voice+2,"//...delta computed ["+string(timer-t) |
---|
[97a7b44] | 722 | +" secs, "+string((memory(1)+1023)/1024)+" K]"); |
---|
[de9f10] | 723 | |
---|
| 724 | dbprint(printlevel-voice+2,"//delta="+string(delta)); |
---|
| 725 | |
---|
| 726 | if(delta>0) |
---|
| 727 | { |
---|
| 728 | dbprint(printlevel-voice+2,"//increasing K and N..."); |
---|
| 729 | if(kappa==1) |
---|
| 730 | { |
---|
| 731 | K,N,P1,P2,Pe,V1,V2,Ve=incK(f,mu,K,1+delta-K,N,e,P1,P2,Pe,V1,V2,Ve); |
---|
| 732 | } |
---|
| 733 | else |
---|
| 734 | { |
---|
| 735 | K,N,P1,P2,Pe,V1,V2,Ve= |
---|
| 736 | incK(f,mu,K,kappa+pcvmindeg(daU[1])+delta-K,N,e,P1,P2,Pe,V1,V2,Ve); |
---|
| 737 | } |
---|
| 738 | dbprint(printlevel-voice+2,"//...K and N increased"); |
---|
| 739 | |
---|
| 740 | dbprint(printlevel-voice+2,"//computing M..."); |
---|
| 741 | M,prevN,Vnablae=MK(f,mu,kappa,xi,u,K,N,prevN,e,V1,V2,Ve,Vnablae); |
---|
| 742 | dbprint(printlevel-voice+2,"//...M computed"); |
---|
| 743 | |
---|
| 744 | if(kappa>1) |
---|
| 745 | { |
---|
| 746 | dbprint(printlevel-voice+2, |
---|
| 747 | "//transforming M/t^kappa to simple pole..."); |
---|
| 748 | t=timer; |
---|
| 749 | M=mdivp(invunit(daU[1]/var(1)^pcvmindeg(daU[1]),delta)* |
---|
| 750 | daU[2]*(var(1)^kappa*diff(U,var(1))+M*U), |
---|
| 751 | var(1)^(kappa+pcvmindeg(daU[1])-1)); |
---|
| 752 | dbprint(printlevel-voice+2, |
---|
| 753 | "//...M/t^kappa transformed to simple pole ["+string(timer-t) |
---|
[97a7b44] | 754 | +" secs, "+string((memory(1)+1023)/1024)+" K]"); |
---|
[de9f10] | 755 | } |
---|
| 756 | |
---|
| 757 | dbprint(printlevel-voice+2,"//decreasing delta..."); |
---|
| 758 | M=decmide(M,eM0,bM0); |
---|
| 759 | delta--; |
---|
| 760 | dbprint(printlevel-voice+2,"//delta="+string(delta)); |
---|
| 761 | |
---|
| 762 | while(delta>0) |
---|
| 763 | { |
---|
| 764 | jd=jordan(M); |
---|
| 765 | eM0,bM0=jd[1..2]; |
---|
| 766 | M=decmide(M,eM0,bM0); |
---|
| 767 | delta--; |
---|
| 768 | dbprint(printlevel-voice+2,"//delta="+string(delta)); |
---|
| 769 | } |
---|
| 770 | dbprint(printlevel-voice+2,"//...delta decreased"); |
---|
| 771 | } |
---|
| 772 | } |
---|
| 773 | |
---|
| 774 | dbprint(printlevel-voice+2,"//computing 0-jet M0 of M..."); |
---|
| 775 | matrix M0=jet(M,0); |
---|
| 776 | dbprint(printlevel-voice+2,"//...M0 computed"); |
---|
| 777 | |
---|
| 778 | return(M0); |
---|
| 779 | } |
---|
| 780 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 781 | |
---|
| 782 | static proc qhmonodromy(poly f,intvec w) |
---|
| 783 | { |
---|
| 784 | dbprint(printlevel-voice+2,"//computing basis e of Milnor algebra..."); |
---|
[1eb7af] | 785 | int t=timer; |
---|
[de9f10] | 786 | ideal e=kbase(std(jacob(f))); |
---|
[4ad2bb] | 787 | dbprint(printlevel-voice+2,"//...e computed ["+string(timer-t)+" secs, " |
---|
[97a7b44] | 788 | +string((memory(1)+1023)/1024)+" K]"); |
---|
[de9f10] | 789 | |
---|
| 790 | dbprint(printlevel-voice+2, |
---|
| 791 | "//computing Milnor number mu and quasihomogeneous degree d..."); |
---|
| 792 | int mu,d=size(e),(transpose(leadexp(f))*w)[1]; |
---|
| 793 | dbprint(printlevel-voice+2,"...mu and d computed"); |
---|
| 794 | |
---|
| 795 | dbprint(printlevel-voice+2,"//computing te-matrix M of t*nabla..."); |
---|
| 796 | matrix M[mu][mu]; |
---|
| 797 | int i; |
---|
| 798 | for(i=mu;i>=1;i--) |
---|
| 799 | { |
---|
| 800 | M[i,i]=number((transpose(leadexp(e[i])+1)*w)[1])/d; |
---|
| 801 | } |
---|
| 802 | dbprint(printlevel-voice+2,"//...M computed"); |
---|
| 803 | |
---|
| 804 | return(M); |
---|
| 805 | } |
---|
| 806 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 807 | |
---|
[efda70a] | 808 | proc monodromyB(poly f, list #) |
---|
| 809 | "USAGE: monodromyB(f[,opt]); f poly, opt int |
---|
[917fb5] | 810 | ASSUME: The polynomial f in a series ring (local ordering) defines |
---|
[de9f10] | 811 | an isolated hypersurface singularity. |
---|
[917fb5] | 812 | RETURN: The procedure returns a residue matrix M of the meromorphic |
---|
| 813 | Gauss-Manin connection of the singularity defined by f |
---|
| 814 | or an empty matrix if the assumptions are not fulfilled. |
---|
[862bf0f] | 815 | If opt=0 (default), exp(-2*pi*i*M) is a monodromy matrix of f, |
---|
| 816 | else, only the characteristic polynomial of exp(-2*pi*i*M) coincides |
---|
[1eb7af] | 817 | with the characteristic polynomial of the monodromy of f. |
---|
[4ad2bb] | 818 | DISPLAY: The procedure displays more comments for higher printlevel. |
---|
[efda70a] | 819 | EXAMPLE: example monodromyB; shows an example. |
---|
[de9f10] | 820 | " |
---|
| 821 | { |
---|
| 822 | int opt; |
---|
| 823 | if(size(#)>0) |
---|
| 824 | { |
---|
[7d74df] | 825 | if(typeof(#[1])=="int") |
---|
[de9f10] | 826 | { |
---|
| 827 | opt=#[1]; |
---|
| 828 | } |
---|
| 829 | else |
---|
| 830 | { |
---|
| 831 | print("\\second parameter no int"); |
---|
| 832 | return(); |
---|
| 833 | } |
---|
[917fb5] | 834 | |
---|
[de9f10] | 835 | } |
---|
| 836 | |
---|
[1eb7af] | 837 | dbprint(printlevel-voice+2,"//basering="+string(basering)); |
---|
| 838 | |
---|
[de9f10] | 839 | int i; |
---|
| 840 | for(i=nvars(basering);i>=1;i--) |
---|
| 841 | { |
---|
| 842 | if(1<var(i)) |
---|
| 843 | { |
---|
| 844 | i=-1; |
---|
| 845 | } |
---|
| 846 | } |
---|
| 847 | |
---|
| 848 | if(i<0) |
---|
| 849 | { |
---|
| 850 | print("//no series ring (local ordering)"); |
---|
[1eb7af] | 851 | |
---|
| 852 | matrix M[1][0]; |
---|
| 853 | return(M); |
---|
[de9f10] | 854 | } |
---|
| 855 | else |
---|
| 856 | { |
---|
| 857 | dbprint(printlevel-voice+2,"//f="+string(f)); |
---|
| 858 | |
---|
| 859 | dbprint(printlevel-voice+2,"//computing milnor number mu of f..."); |
---|
[1eb7af] | 860 | int t=timer; |
---|
[de9f10] | 861 | int mu=milnor(f); |
---|
[4ad2bb] | 862 | dbprint(printlevel-voice+2,"//...mu computed ["+string(timer-t)+" secs, " |
---|
[97a7b44] | 863 | +string((memory(1)+1023)/1024)+" K]"); |
---|
[de9f10] | 864 | |
---|
| 865 | dbprint(printlevel-voice+2,"//mu="+string(mu)); |
---|
| 866 | |
---|
| 867 | if(mu<=0) |
---|
| 868 | { |
---|
| 869 | if(mu==0) |
---|
| 870 | { |
---|
| 871 | print("//no singularity"); |
---|
| 872 | } |
---|
| 873 | else |
---|
| 874 | { |
---|
| 875 | print("//non isolated singularity"); |
---|
| 876 | } |
---|
| 877 | |
---|
| 878 | matrix M[1][0]; |
---|
| 879 | return(M); |
---|
| 880 | } |
---|
| 881 | else |
---|
| 882 | { |
---|
| 883 | dbprint(printlevel-voice+2,"//computing weight vector w..."); |
---|
| 884 | intvec w=qhweight(f); |
---|
| 885 | dbprint(printlevel-voice+2,"//...w computed"); |
---|
| 886 | |
---|
| 887 | dbprint(printlevel-voice+2,"//w="+string(w)); |
---|
| 888 | |
---|
| 889 | if(w==0) |
---|
| 890 | { |
---|
[1eb7af] | 891 | dbprint(printlevel-voice+2, |
---|
| 892 | "//f not quasihomogeneous with respect to given coordinates"); |
---|
[de9f10] | 893 | return(nonqhmonodromy(f,mu,opt)); |
---|
| 894 | } |
---|
| 895 | else |
---|
| 896 | { |
---|
[1eb7af] | 897 | dbprint(printlevel-voice+2, |
---|
| 898 | "//f quasihomogeneous with respect to given coordinates"); |
---|
[de9f10] | 899 | return(qhmonodromy(f,w)); |
---|
| 900 | } |
---|
| 901 | } |
---|
| 902 | } |
---|
| 903 | } |
---|
| 904 | example |
---|
| 905 | { "EXAMPLE:"; echo=2; |
---|
| 906 | ring R=0,(x,y),ds; |
---|
| 907 | poly f=x2y2+x6+y6; |
---|
[efda70a] | 908 | matrix M=monodromyB(f); |
---|
[de9f10] | 909 | print(M); |
---|
| 910 | } |
---|
| 911 | /////////////////////////////////////////////////////////////////////////////// |
---|
[1eb7af] | 912 | |
---|
[0b59f5] | 913 | proc H2basis(poly f) |
---|
| 914 | "USAGE: H2basis(f); f poly |
---|
[917fb5] | 915 | ASSUME: The polynomial f in a series ring (local ordering) defines |
---|
[1eb7af] | 916 | an isolated hypersurface singularity. |
---|
| 917 | RETURN: The procedure returns a list of representatives of a C{f}-basis of the |
---|
| 918 | Brieskorn lattice H''=Omega^(n+1)/df^dOmega^(n-1). |
---|
| 919 | THEORY: H'' is a free C{f}-module of rank milnor(f). |
---|
[4ad2bb] | 920 | DISPLAY: The procedure displays more comments for higher printlevel. |
---|
[0b59f5] | 921 | EXAMPLE: example H2basis; shows an example. |
---|
[1eb7af] | 922 | " |
---|
| 923 | { |
---|
| 924 | dbprint(printlevel-voice+2,"//basering="+string(basering)); |
---|
| 925 | |
---|
| 926 | int i; |
---|
| 927 | for(i=nvars(basering);i>=1;i--) |
---|
| 928 | { |
---|
| 929 | if(1<var(i)) |
---|
| 930 | { |
---|
| 931 | i=-1; |
---|
| 932 | } |
---|
| 933 | } |
---|
| 934 | |
---|
| 935 | if(i<0) |
---|
| 936 | { |
---|
| 937 | print("//no series ring (local ordering)"); |
---|
| 938 | |
---|
| 939 | return(list()); |
---|
| 940 | } |
---|
| 941 | else |
---|
| 942 | { |
---|
| 943 | dbprint(printlevel-voice+2,"//f="+string(f)); |
---|
| 944 | |
---|
| 945 | dbprint(printlevel-voice+2,"//computing milnor number mu of f..."); |
---|
| 946 | int t=timer; |
---|
| 947 | int mu=milnor(f); |
---|
[4ad2bb] | 948 | dbprint(printlevel-voice+2,"//...mu computed ["+string(timer-t)+" secs, " |
---|
[97a7b44] | 949 | +string((memory(1)+1023)/1024)+" K]"); |
---|
[1eb7af] | 950 | |
---|
| 951 | dbprint(printlevel-voice+2,"//mu="+string(mu)); |
---|
| 952 | |
---|
| 953 | if(mu<=0) |
---|
| 954 | { |
---|
| 955 | if(mu==0) |
---|
| 956 | { |
---|
| 957 | print("//no singularity"); |
---|
| 958 | } |
---|
| 959 | else |
---|
| 960 | { |
---|
| 961 | print("//non isolated singularity"); |
---|
| 962 | } |
---|
| 963 | |
---|
| 964 | return(list()); |
---|
| 965 | } |
---|
| 966 | else |
---|
| 967 | { |
---|
| 968 | dbprint(printlevel-voice+2,"//computing kappa, xi and u with "+ |
---|
| 969 | "u*f^kappa=(matrix(jacob(f))*xi)[1,1]..."); |
---|
| 970 | list jl=jacoblift(f); |
---|
| 971 | def kappa,xi,u=jl[1..3]; |
---|
| 972 | dbprint(printlevel-voice+2,"//...kappa, xi and u computed"); |
---|
| 973 | dbprint(printlevel-voice+2,"//kappa="+string(kappa)); |
---|
| 974 | if(kappa==1) |
---|
| 975 | { |
---|
| 976 | dbprint(printlevel-voice+2, |
---|
| 977 | "//f quasihomogenous with respect to suitable coordinates"); |
---|
| 978 | } |
---|
| 979 | else |
---|
| 980 | { |
---|
| 981 | dbprint(printlevel-voice+2, |
---|
| 982 | "//f not quasihomogenous for any choice of coordinates"); |
---|
| 983 | } |
---|
| 984 | dbprint(printlevel-voice+2,"//xi="); |
---|
| 985 | dbprint(printlevel-voice+2,xi); |
---|
| 986 | dbprint(printlevel-voice+2,"//u="+string(u)); |
---|
| 987 | |
---|
| 988 | int K,N,prevN; |
---|
| 989 | list e,P1,P2,Pe,V1,V2,Ve,Vnablae; |
---|
| 990 | |
---|
| 991 | dbprint(printlevel-voice+2,"//increasing K and N..."); |
---|
| 992 | K,N,P1,P2,Pe,V1,V2,Ve=incK(f,mu,K,1,N,e,P1,P2,Pe,V1,V2,Ve); |
---|
| 993 | dbprint(printlevel-voice+2,"//...K and N increased"); |
---|
| 994 | |
---|
| 995 | dbprint(printlevel-voice+2, |
---|
| 996 | "//computing C{f}-basis e of Brieskorn lattice " |
---|
| 997 | +"H''=Omega^(n+1)/df^dOmega^(n-1)..."); |
---|
| 998 | t=timer; |
---|
| 999 | e=pcvcv2p(quotV(V1+V2,N),0,N); |
---|
[4ad2bb] | 1000 | dbprint(printlevel-voice+2,"//...e computed ["+string(timer-t)+" secs, " |
---|
[97a7b44] | 1001 | +string((memory(1)+1023)/1024)+" K]"); |
---|
[1eb7af] | 1002 | |
---|
| 1003 | dbprint(printlevel-voice+2,"//e="); |
---|
| 1004 | dbprint(printlevel-voice+2,e); |
---|
| 1005 | |
---|
| 1006 | return(e); |
---|
| 1007 | } |
---|
| 1008 | } |
---|
| 1009 | } |
---|
| 1010 | example |
---|
| 1011 | { "EXAMPLE:"; echo=2; |
---|
| 1012 | ring R=0,(x,y),ds; |
---|
| 1013 | poly f=x2y2+x6+y6; |
---|
[0b59f5] | 1014 | H2basis(f); |
---|
[1eb7af] | 1015 | } |
---|
| 1016 | /////////////////////////////////////////////////////////////////////////////// |
---|