Changeset 34a9eb1 in git
 Timestamp:
 Jul 31, 2001, 7:37:43 PM (22 years ago)
 Branches:
 (u'spielwiese', '91fdef05f09f54b8d58d92a472e9c4a43aa4656f')
 Children:
 1418c4ecec6f1dda76f77dca9a541a4f29998c7e
 Parents:
 fa01b75313d60b772595052a5fd57fb8c2ec49e2
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

Singular/LIB/gaussman.lib
rfa01b7 r34a9eb1 1 1 /////////////////////////////////////////////////////////////////////////////// 2 version="$Id: gaussman.lib,v 1.4 5 20010621 14:59:10mschulze Exp $";2 version="$Id: gaussman.lib,v 1.46 20010731 17:37:43 mschulze Exp $"; 3 3 category="Singularities"; 4 4 … … 15 15 gmsnf(p,K[,Kmax]); GaussManin system normal form 16 16 gmscoeffs(p,K[,Kmax]); GaussManin system basis representation 17 monodromy(f[,opt]); monodromy matrix, spectrum of monodromy of f 18 vfiltration(f[,opt]); Vfiltration on H''/H', singularity spectrum of f 19 spectrum(f); singularity spectrum of f 17 monodromy(f[,opt]); monodromy matrix or spectrum of monodromy of f 18 vfilt(f[,opt]); Vfiltration on H''/H' or spectrum of f 20 19 endfilt(poly f,list V); endomorphism filtration of filtration V 21 spprint(list S); print spectrum S 22 spadd(list S1,list S2); sum of spectra S1 and S2 23 spsub(list S1,list S2); difference of spectra S1 and S2 24 spmul(list S,int k); product of spectrum S and integer k 25 spmul(list S,intvec k); linear combination of spectra S with coefficients k 26 spissemicont(list S[,opt]); test spectrum S for semicontinuity 27 spsemicont(list S0,list S[,opt]); relative semicontinuity of spectra S0 and S 28 spmilnor(list S); milnor number of spectrum S 29 spgeomgenus(list S); geometrical genus of spectrum S 30 spgamma(list S); gamma invariant of spectrum S 20 spectrum(f); spectrum of f 21 sppairs(f[,opt]); spectral pairs or spectrum of f 22 spgen(a); generate spectrum defined by a 23 sppgen(a,w); generate spectral pairs defined by a and w 24 spprint(list Sp); print spectrum or spectral pairs Sp 25 spadd(list Sp1,list Sp2); sum of spectra Sp1 and Sp2 26 spsub(list Sp1,list Sp2); difference of spectra Sp1 and Sp2 27 spmul(list Sp,int k); product of spectrum Sp and integer k 28 spmul(list Sp,intvec k); linear combination of spectra Sp with coeffs k 29 spissemicont(list Sp[,opt]); test spectrum Sp for semicontinuity 30 spsemicont(list Sp0,list Sp[,opt]); semicontinuity of spectra Sp0 and Sp 31 spmilnor(list Sp); milnor number of spectrum Sp 32 spgeomgenus(list Sp); geometrical genus of spectrum Sp 33 spgamma(list Sp); gamma invariant of spectrum Sp 31 34 32 35 SEE ALSO: mondromy_lib, spectrum_lib 33 36 34 KEYWORDS: singularities; GaussManin connection; monodromy; spectrum; 35 Brieskorn lattice; Hodge filtration; Vfiltration 37 KEYWORDS: singularities; GaussManin connection; Brieskorn lattice; 38 monodromy; spectrum; spectral pairs; 39 Hodge filtration; Vfiltration; weight filtration 36 40 "; 37 41 … … 44 48 def R=basering; 45 49 46 string s=ordstr(R);47 int j=find( s,",C");50 string os=ordstr(R); 51 int j=find(os,",C"); 48 52 if(j==0) 49 53 { 50 j=find( s,"C,");54 j=find(os,"C,"); 51 55 } 52 56 if(j==0) 53 57 { 54 j=find( s,",c");58 j=find(os,",c"); 55 59 } 56 60 if(j==0) 57 61 { 58 j=find( s,"c,");62 j=find(os,"c,"); 59 63 } 60 64 if(j>0) 61 65 { 62 s[j..j+1]=" ";63 } 64 65 execute("ring S="+charstr(R)+",(gmspoly,"+varstr(R)+"),(c,dp,"+ s+");");66 os[j..j+1]=" "; 67 } 68 69 execute("ring S="+charstr(R)+",(gmspoly,"+varstr(R)+"),(c,dp,"+os+");"); 66 70 67 71 ideal I=homog(imap(R,I),gmspoly); … … 103 107 proc gmsring(poly t,string s) 104 108 "USAGE: gmsring(f,s); poly f, string s; 105 ASSUME: basering hascharacteristic 0 and local degree ordering,106 f hasisolated singularity at 0109 ASSUME: basering with characteristic 0 and local degree ordering, 110 f with isolated singularity at 0 107 111 RETURN: 108 112 @format … … 120 124 @end format 121 125 NOTE: do not modify gms variables if you want to use gms procedures 122 KEYWORDS: singularities; GaussManin connection 126 KEYWORDS: singularities; GaussManin connection; Brieskorn lattice 123 127 EXAMPLE: example gms; shows examples 124 128 " … … 163 167 } 164 168 169 string os=ordstr(R); 170 int j=find(os,",C"); 171 if(j==0) 172 { 173 j=find(os,"C,"); 174 } 175 if(j==0) 176 { 177 j=find(os,",c"); 178 } 179 if(j==0) 180 { 181 j=find(os,"c,"); 182 } 183 if(j>0) 184 { 185 os[j..j+1]=" "; 186 } 187 165 188 execute("ring G="+string(charstr(R))+",("+s+","+varstr(R)+"),(ws("+ 166 string(deg(highcorner(g))+2*gmsmaxweight)+"),"+o rdstr(R)+");");189 string(deg(highcorner(g))+2*gmsmaxweight)+"),"+os+",c);"); 167 190 168 191 poly gmspoly=imap(R,t); … … 202 225 NOTE: by setting p=l[2] the computation can be continued up to order 203 226 at most Kmax, by default Kmax=infinity 204 KEYWORDS: singularities; GaussManin connection 227 KEYWORDS: singularities; GaussManin connection; Brieskorn lattice 205 228 EXAMPLE: example gmsnf; shows examples 206 229 " … … 305 328 NOTE: by setting p=l[2] the computation can be continued up to order 306 329 at most Kmax, by default Kmax=infinity 307 KEYWORDS: singularities; GaussManin connection 330 KEYWORDS: singularities; GaussManin connection; Brieskorn lattice 308 331 EXAMPLE: example gmscoeffs; shows examples 309 332 " … … 387 410 proc monodromy(poly f,list #) 388 411 "USAGE: monodromy(f[,opt]); poly f, int opt 389 ASSUME: basering hascharacteristic 0 and local degree ordering,390 f hasisolated singularity at 0412 ASSUME: basering with characteristic 0 and local degree ordering, 413 f with isolated singularity at 0 391 414 RETURN: 392 415 @format 393 if opt==0: 394 matrix M: exp(2*pi*i*M) is a monodromy matrix of f 395 if opt==1: 396 ideal e: exp(2*pi*i*e) are the eigenvalues of the monodromy of f 416 if opt=0: 417 list l: 418 ideal l[1]: exp(2*pi*i*l[1]) are the eigenvalues of the monodromy 419 if opt=1: 420 list l: Jordan data jordan(M) of a monodromy matrix exp(2*pi*i*M) 397 421 default: opt=1 398 422 @end format 399 423 SEE ALSO: mondromy_lib 400 KEYWORDS: singularities; GaussManin connection; monodromy424 KEYWORDS: singularities; GaussManin connection; Brieskorn lattice; monodromy 401 425 EXAMPLE: example monodromy; shows examples 402 426 " … … 412 436 413 437 def R=basering; 438 int n=nvars(R)1; 414 439 def G=gmsring(f,"s"); 415 440 setring G; 416 417 int n=nvars(R)1;418 441 int mu,modm=ncols(gmsbasis),maxorddif(gmsbasis); 419 ideal w=gmspoly*gmsbasis;442 ideal r=gmspoly*gmsbasis; 420 443 list l; 421 444 matrix U=freemodule(mu); 422 matrix A0[mu][mu], A,C;445 matrix A0[mu][mu],C; 423 446 module H,dH=freemodule(mu),freemodule(mu); 424 447 module H0; 425 int sdH=1;426 448 int k=1; 427 428 while(sdH>0) 449 while(size(reduce(H,std(H0*s)))>0) 429 450 { 430 451 k++; … … 433 454 if(opt==0) 434 455 { 435 l=gmscoeffs( w,k,mu);456 l=gmscoeffs(r,k,mu); 436 457 } 437 458 else 438 459 { 439 l=gmscoeffs( w,k,mu+n);440 } 441 C, w=l[1..2];460 l=gmscoeffs(r,k,mu+n); 461 } 462 C,r=l[1..2]; 442 463 A0=A0+C; 443 464 … … 448 469 449 470 dbprint(printlevelvoice+2,"//gaussman::monodromy: test dH==0"); 450 sdH=size(reduce(H,std(H0*s))); 451 } 452 453 A0=A0s^k; 471 } 472 A0=A0k*s; 454 473 455 474 dbprint(printlevelvoice+2, 456 475 "//gaussman::monodromy: compute basis of saturation"); 457 H= minbase(H0);476 H=std(H0); 458 477 int modH=maxorddif(H)/deg(s); 459 478 dbprint(printlevelvoice+2,"//gaussman::monodromy: k="+string(modH+1)); … … 461 480 if(opt==0) 462 481 { 463 l=gmscoeffs( w,modH+1,modH+1);482 l=gmscoeffs(r,modH+1,modH+1); 464 483 } 465 484 else 466 485 { 467 l=gmscoeffs( w,modH+1,modH+1+n);468 } 469 C, w=l[1..2];486 l=gmscoeffs(r,modH+1,modH+1+n); 487 } 488 C,r=l[1..2]; 470 489 A0=A0+C; 471 472 490 dbprint(printlevelvoice+2, 473 491 "//gaussman::monodromy: compute A on saturation"); 474 492 l=division(H*s,A0*H+s^2*diff(matrix(H),s)); 475 A=jet(l[1],l[2],0);493 matrix A=jet(l[1],l[2],0); 476 494 477 495 dbprint(printlevelvoice+2, … … 488 506 setring(R); 489 507 ideal e=imap(G,e); 490 return( e);508 return(list(e)); 491 509 } 492 510 493 511 int mide=maxintdif(e); 494 495 512 if(mide>0) 496 513 { … … 498 515 "//gaussman::monodromy: k="+string(modH+1+mide)); 499 516 dbprint(printlevelvoice+2,"//gaussman::monodromy: compute C"); 500 l=gmscoeffs( w,modH+1+mide,modH+1+mide);501 C, w=l[1..2];517 l=gmscoeffs(r,modH+1+mide,modH+1+mide); 518 C,r=l[1..2]; 502 519 A0=A0+C; 520 l=division(H*s,A0*H+s^2*diff(matrix(H),s)); 521 A=jet(l[1],l[2],mide); 503 522 504 523 intvec ide; … … 510 529 { 511 530 k=int(e[j]e[i]); 512 if(k>ide[ i])513 { 514 ide[ i]=k;515 } 516 if(k>ide[ j])517 { 518 ide[ j]=k;531 if(k>ide[j]) 532 { 533 ide[j]=k; 534 } 535 if(k>ide[i]) 536 { 537 ide[i]=k; 519 538 } 520 539 } … … 528 547 } 529 548 } 530 } 531 while(mide>0) 532 { 533 dbprint(printlevelvoice+2,"//gaussman::monodromy: mide="+string(mide)); 534 535 U=0; 536 A0=jet(A,0); 537 for(i=ncols(e);i>=1;i) 538 { 539 U=syz(power(A0e[i],n+1))+U; 540 } 541 A=division(U,A*U)[1]; 542 543 for(i=mu;i>=1;i) 544 { 545 for(j=mu;j>=1;j) 546 { 547 if(ide[i]==0&&ide[j]>0) 548 { 549 A[i,j]=A[i,j]*s; 550 } 551 else 552 { 553 if(ide[i]>0&&ide[j]==0) 549 550 while(mide>0) 551 { 552 dbprint(printlevelvoice+2,"//gaussman::monodromy: mide="+string(mide)); 553 554 A0=jet(A,0); 555 U=0; 556 for(i=ncols(e);i>=1;i) 557 { 558 U=syz(power(A0e[i],n+1))+U; 559 } 560 A=lift(U,A*U); 561 562 for(i=mu;i>=1;i) 563 { 564 for(j=mu;j>=1;j) 565 { 566 if(ide[i]==0&&ide[j]>0) 554 567 { 555 568 A[i,j]=A[i,j]/s; 556 569 } 557 } 558 } 559 } 560 for(i=mu;i>=1;i) 561 { 562 if(ide[i]>0) 563 { 564 A[i,i]=A[i,i]+1; 565 e[i]=e[i]+1; 566 ide[i]=ide[i]1; 567 } 568 } 569 mide; 570 } 571 A=jet(A,0); 570 else 571 { 572 if(ide[i]>0&&ide[j]==0) 573 { 574 A[i,j]=A[i,j]*s; 575 } 576 } 577 } 578 } 579 for(i=mu;i>=1;i) 580 { 581 if(ide[i]>0) 582 { 583 A[i,i]=A[i,i]1; 584 ide[i]=ide[i]1; 585 } 586 } 587 mide; 588 } 589 590 A=jet(A,0); 591 } 572 592 573 593 setring(R); 574 594 matrix A=imap(G,A); 575 return( A);595 return(jordan(A)); 576 596 } 577 597 example … … 583 603 /////////////////////////////////////////////////////////////////////////////// 584 604 585 proc vfilt ration(poly f,list #)586 "USAGE: vfilt ration(f[,opt]); poly f, int opt587 ASSUME: basering hascharacteristic 0 and local degree ordering,588 f hasisolated singularity at 0605 proc vfilt(poly f,list #) 606 "USAGE: vfilt(f[,opt]); poly f, int opt 607 ASSUME: basering with characteristic 0 and local degree ordering, 608 f with isolated singularity at 0 589 609 RETURN: 590 610 @format 591 611 list V: Vfiltration of f on H''/H' 592 if opt= =0 or opt==1:612 if opt=0 or opt=1: 593 613 intvec V[1]: numerators of spectral numbers 594 614 intvec V[2]: denominators of spectral numbers 595 615 intvec V[3]: 596 616 int V[3][i]: multiplicity of spectral number V[1][i]/V[2][i] 597 if opt= =1:617 if opt=1: 598 618 list V[4]: 599 619 module V[4][i]: vector space basis of V[1][i]/V[2][i]th graded part … … 604 624 NOTE: H' and H'' denote the Brieskorn lattices 605 625 SEE ALSO: spectrum_lib 606 KEYWORDS: singularities; GaussManin connection; 607 Brieskorn lattice;Hodge filtration; Vfiltration; spectrum608 EXAMPLE: example vfilt ration; shows examples626 KEYWORDS: singularities; GaussManin connection; Brieskorn lattice; 627 Hodge filtration; Vfiltration; spectrum 628 EXAMPLE: example vfilt; shows examples 609 629 " 610 630 { … … 624 644 int n=nvars(R)1; 625 645 int mu,modm=ncols(gmsbasis),maxorddif(gmsbasis); 626 ideal w=gmspoly*gmsbasis;646 ideal r=gmspoly*gmsbasis; 627 647 list l; 628 648 matrix U=freemodule(mu); … … 637 657 { 638 658 k++; 639 dbprint(printlevelvoice+2,"//gaussman::vfilt ration: k="+string(k));640 dbprint(printlevelvoice+2,"//gaussman::vfilt ration: compute C");641 l=gmscoeffs( w,k);642 C, w=l[1..2];659 dbprint(printlevelvoice+2,"//gaussman::vfilt: k="+string(k)); 660 dbprint(printlevelvoice+2,"//gaussman::vfilt: compute C"); 661 l=gmscoeffs(r,k); 662 C,r=l[1..2]; 643 663 A=A+C; 644 664 645 665 H0=H; 646 dbprint(printlevelvoice+2,"//gaussman::vfilt ration: compute dH");666 dbprint(printlevelvoice+2,"//gaussman::vfilt: compute dH"); 647 667 dH=jet(module(A*dH+s^2*diff(matrix(dH),s)),k); 648 668 H=H*s+dH; 649 669 650 dbprint(printlevelvoice+2,"//gaussman::vfilt ration: test dH==0");670 dbprint(printlevelvoice+2,"//gaussman::vfilt: test dH==0"); 651 671 sdH=size(reduce(H,std(H0*s))); 652 672 } 653 654 A=As^k; 655 656 dbprint(printlevelvoice+2, 657 "//gaussman::vfiltration: compute basis of saturation"); 673 A=Ak*s; 674 675 dbprint(printlevelvoice+2,"//gaussman::vfilt: compute basis of saturation"); 658 676 H=minbase(H0); 659 677 int modH=maxorddif(H)/deg(s); 660 678 dbprint(printlevelvoice+2,"//gaussman::monodromy: k="+string(N+modH)); 661 679 dbprint(printlevelvoice+2,"//gaussman::monodromy: compute C"); 662 l=gmscoeffs( w,N+modH,N+modH);663 C, w=l[1..2];680 l=gmscoeffs(r,N+modH,N+modH); 681 C,r=l[1..2]; 664 682 A=A+C; 665 683 666 dbprint(printlevelvoice+2, 667 "//gaussman::vfiltration: transform H0 to saturation"); 684 dbprint(printlevelvoice+2,"//gaussman::vfilt: transform H0 to saturation"); 668 685 l=division(H,freemodule(mu)*s^k); 669 686 H0=jet(l[1],l[2],N1); 670 687 671 688 dbprint(printlevelvoice+2, 672 "//gaussman::vfilt ration: compute H0 as vector space V0");689 "//gaussman::vfilt: compute H0 as vector space V0"); 673 690 dbprint(printlevelvoice+2, 674 "//gaussman::vfilt ration: compute H1 as vector space V1");691 "//gaussman::vfilt: compute H1 as vector space V1"); 675 692 poly p; 676 693 int i0,j0,i1,j1; … … 699 716 } 700 717 701 dbprint(printlevelvoice+2, 702 "//gaussman::vfiltration: compute A on saturation"); 718 dbprint(printlevelvoice+2,"//gaussman::vfilt: compute A on saturation"); 703 719 l=division(H*s,A*H+s^2*diff(matrix(H),s)); 704 720 A=jet(l[1],l[2],N1); 705 721 706 dbprint(printlevelvoice+2,"//gaussman::vfilt ration: compute matrix M of A");722 dbprint(printlevelvoice+2,"//gaussman::vfilt: compute matrix M of A"); 707 723 matrix M[mu*N][mu*N]; 708 724 for(i0=mu;i0>=1;i0) … … 730 746 } 731 747 732 dbprint(printlevelvoice+2, 733 "//gaussman::vfiltration: compute eigenvalues eA of A"); 748 dbprint(printlevelvoice+2,"//gaussman::vfilt: compute eigenvalues eA of A"); 734 749 ideal eA=eigenval(jet(A,0))[1]; 735 dbprint(printlevelvoice+2,"//gaussman::vfiltration: eA="+string(eA)); 736 737 dbprint(printlevelvoice+2, 738 "//gaussman::vfiltration: compute eigenvalues eM of M"); 750 dbprint(printlevelvoice+2,"//gaussman::vfilt: eA="+string(eA)); 751 752 dbprint(printlevelvoice+2,"//gaussman::vfilt: compute eigenvalues eM of M"); 739 753 ideal eM; 740 754 k=0; … … 762 776 } 763 777 } 764 dbprint(printlevelvoice+2,"//gaussman::vfilt ration: eM="+string(eM));778 dbprint(printlevelvoice+2,"//gaussman::vfilt: eM="+string(eM)); 765 779 766 780 dbprint(printlevelvoice+2, 767 "//gaussman::vfilt ration: compute Vfiltration on H0/H1");781 "//gaussman::vfilt: compute Vfiltration on H0/H1"); 768 782 ideal a; 769 783 k=0; … … 776 790 { 777 791 dbprint(printlevelvoice+2, 778 "//gaussman::vfilt ration: compute V["+string(i)+"]");792 "//gaussman::vfilt: compute V["+string(i)+"]"); 779 793 V1=module(V1)+syz(power(MeM[i],n+1)); 780 794 V[i]=interred(intersect(V1,V0)); … … 789 803 790 804 dbprint(printlevelvoice+2, 791 "//gaussman::vfilt ration: symmetry index found");805 "//gaussman::vfilt: symmetry index found"); 792 806 int j=k; 793 807 … … 795 809 { 796 810 dbprint(printlevelvoice+2, 797 "//gaussman::vfilt ration: compute V["+string(i)+"]");811 "//gaussman::vfilt: compute V["+string(i)+"]"); 798 812 V1=module(V1)+syz(power(MeM[i],n+1)); 799 813 V[i]=interred(intersect(V1,V0)); … … 807 821 } 808 822 809 dbprint(printlevelvoice+2,"//gaussman::vfilt ration: apply symmetry");823 dbprint(printlevelvoice+2,"//gaussman::vfilt: apply symmetry"); 810 824 while(j>=1) 811 825 { … … 828 842 { 829 843 dbprint(printlevelvoice+2, 830 "//gaussman::vfilt ration: compute V["+string(i)+"]");844 "//gaussman::vfilt: compute V["+string(i)+"]"); 831 845 V1=module(V1)+syz(power(MeM[i],n+1)); 832 846 V[i]=interred(intersect(V1,V0)); … … 839 853 a[k]=eM[i]1; 840 854 dbprint(printlevelvoice+2, 841 "//gaussman::vfilt ration: transform to V0");855 "//gaussman::vfilt: transform to V0"); 842 856 v[k]=matrix(freemodule(ncols(V[i])),mu,mu*N)*division(V0,V[i])[1]; 843 857 } … … 860 874 v[k]=v[j]; 861 875 dbprint(printlevelvoice+2, 862 "//gaussman::vfilt ration: transform to V0");876 "//gaussman::vfilt: transform to V0"); 863 877 v[j]=matrix(freemodule(ncols(V[i])),mu,mu*N)*division(V0,V[i])[1]; 864 878 j; … … 867 881 } 868 882 869 dbprint(printlevelvoice+2, 870 "//gaussman::vfiltration: compute graded parts"); 883 dbprint(printlevelvoice+2,"//gaussman::vfilt: compute graded parts"); 871 884 for(k=1;k<size(v);k++) 872 885 { … … 888 901 ring R=0,(x,y),ds; 889 902 poly f=x5+x2y2+y5; 890 vfiltration(f); 891 } 892 /////////////////////////////////////////////////////////////////////////////// 893 894 proc spectrum(poly f) 895 "USAGE: spectrum(f); poly f 896 ASSUME: basering has characteristic 0 and local degree ordering, 897 f has isolated singularity at 0 898 RETURN: 899 @format 900 list S: singularity spectrum of f 901 ideal S[1]: spectral numbers in increasing order 902 intvec S[2]: 903 int S[2][i]: multiplicity of spectral number S[1][i] 904 @end format 905 SEE ALSO: spectrum_lib 906 KEYWORDS: singularities; GaussManin connection; spectrum 907 EXAMPLE: example spectrum; shows examples 908 " 909 { 910 return(vfiltration(f,0)); 911 } 912 example 913 { "EXAMPLE:"; echo=2; 914 ring R=0,(x,y),ds; 915 poly f=x5+x2y2+y5; 916 spprint(spectrum(f)); 903 vfilt(f); 917 904 } 918 905 /////////////////////////////////////////////////////////////////////////////// … … 920 907 proc endfilt(poly f,list V) 921 908 "USAGE: endfilt(f,V); poly f, list V 922 ASSUME: basering hascharacteristic 0 and local degree ordering,923 f hasisolated singularity at 0909 ASSUME: basering with characteristic 0 and local degree ordering, 910 f with isolated singularity at 0 924 911 RETURN: 925 912 @format … … 934 921 @end format 935 922 SEE ALSO: spectrum_lib 936 KEYWORDS: singularities; GaussManin connection; spectrum;937 Brieskorn lattice;Hodge filtration; Vfiltration923 KEYWORDS: singularities; GaussManin connection; Brieskorn lattice; spectrum; 924 Hodge filtration; Vfiltration 938 925 EXAMPLE: example endfilt; shows examples 939 926 " … … 1100 1087 ring R=0,(x,y),ds; 1101 1088 poly f=x5+x2y2+y5; 1102 endfilt(f,vfiltration(f)); 1103 } 1104 /////////////////////////////////////////////////////////////////////////////// 1105 1106 proc spprint(list S) 1107 "USAGE: spprint(S); list S 1108 RETURN: string: spectrum S 1109 EXAMPLE: example spprint; shows examples 1089 endfilt(f,vfilt(f)); 1090 } 1091 /////////////////////////////////////////////////////////////////////////////// 1092 1093 proc spectrum(poly f) 1094 "USAGE: spectrum(f); poly f 1095 ASSUME: basering with characteristic 0 and local degree ordering, 1096 f with isolated singularity at 0 1097 RETURN: 1098 @format 1099 list Sp: spectrum of f 1100 ideal Sp[1]: spectral numbers in increasing order 1101 intvec Sp[2]: 1102 int Sp[2][i]: multiplicity of spectral number Sp[1][i] 1103 @end format 1104 SEE ALSO: spectrum_lib 1105 KEYWORDS: singularities; GaussManin connection; Brieskorn lattice; spectrum 1106 EXAMPLE: example spnumbers; shows examples 1110 1107 " 1111 1108 { 1112 string s; 1113 for(int i=1;i<size(S[2]);i++) 1114 { 1115 s=s+"("+string(S[1][i])+","+string(S[2][i])+"),"; 1116 } 1117 s=s+"("+string(S[1][i])+","+string(S[2][i])+")"; 1118 return(s); 1109 return(sppairs(f,0)); 1119 1110 } 1120 1111 example 1121 1112 { "EXAMPLE:"; echo=2; 1122 1113 ring R=0,(x,y),ds; 1123 list S=list(ideal(1/2,3/10,1/10,0,1/10,3/10,1/2),intvec(1,2,2,1,2,2,1)); 1124 spprint(S); 1125 } 1126 /////////////////////////////////////////////////////////////////////////////// 1127 1128 proc spadd(list S1,list S2) 1129 "USAGE: spadd(S1,S2); list S1,S2 1130 RETURN: list: sum of spectra S1 and S2 1114 poly f=x5+x2y2+y5; 1115 spprint(spectrum(f)); 1116 } 1117 /////////////////////////////////////////////////////////////////////////////// 1118 1119 proc sppairs(poly f,list #) 1120 "USAGE: sppairs(f[,opt]); poly f, int opt 1121 ASSUME: basering with characteristic 0 and local degree ordering, 1122 f with isolated singularity at 0 1123 RETURN: 1124 @format 1125 if opt=0 1126 list Sp: spectrum of f 1127 ideal Sp[1]: spectral numbers in increasing order 1128 intvec Sp[2]: corresponding multiplicities of spectral numbers 1129 if opt=1: 1130 list Spp: spectral pairs of f 1131 ideal Spp[1]: spectral numbers in increasing order 1132 intvec Spp[2]: corresponding nilpotency indices in increasing order 1133 intvec Spp[3]: corresponding multiplicities of spectral pairs 1134 default: opt=1 1135 @end format 1136 SEE ALSO: spectrum_lib 1137 KEYWORDS: singularities; GaussManin connection; Brieskorn lattice; 1138 spectrum; spectral pairs 1139 EXAMPLE: example sppairs; shows examples 1140 " 1141 { 1142 int opt=1; 1143 if(size(#)>0) 1144 { 1145 if(typeof(#[1])=="int") 1146 { 1147 opt=#[1]; 1148 } 1149 } 1150 1151 def R=basering; 1152 int n=nvars(R)1; 1153 def G=gmsring(f,"s"); 1154 setring(G); 1155 int mu,modm=ncols(gmsbasis),maxorddif(gmsbasis); 1156 ideal r=gmspoly*gmsbasis; 1157 list l; 1158 matrix U=freemodule(mu); 1159 matrix A0[mu][mu],C; 1160 module H0; 1161 module H,dH=freemodule(mu),freemodule(mu); 1162 int k=1; 1163 while(size(reduce(H,std(H0*s)))>0) 1164 { 1165 k++; 1166 l=gmscoeffs(r,k,mu+n); 1167 C,r=l[1..2]; 1168 A0=A0+C; 1169 H0=H; 1170 dH=jet(module(A0*dH+s^2*diff(matrix(dH),s)),k); 1171 H=H*s+dH; 1172 } 1173 A0=A0k*s; 1174 1175 H=std(H0); 1176 int modH=maxorddif(H)/deg(s); 1177 l=division(H,freemodule(mu)*s^k); 1178 H0=l[1]; 1179 l=gmscoeffs(r,modH+1,modH+1+n); 1180 C,r=l[1..2]; 1181 A0=A0+C; 1182 l=division(H*s,A0*H+s^2*diff(matrix(H),s)); 1183 matrix A=jet(l[1],l[2],0); 1184 1185 int i,j; 1186 matrix V; 1187 if(!opt) 1188 { 1189 U=jordanbasis(A); 1190 V=lift(U,freemodule(mu)); 1191 A=V*A*U; 1192 H0=std(V*H0); 1193 ideal a; 1194 for(i=1;i<=mu;i++) 1195 { 1196 j=leadexp(H0[i])[nvars(basering)+1]; 1197 a[i]=A[j,j]+deg(lead(H0[i]))/deg(s)1; 1198 } 1199 setring(R); 1200 return(spgen(imap(G,a))); 1201 } 1202 1203 l=eigenval(A); 1204 def e,b=l[1..2]; 1205 int mide=maxintdif(e); 1206 if(mide>0) 1207 { 1208 l=gmscoeffs(r,modH+1+mide,modH+1+mide); 1209 C,r=l[1..2]; 1210 A0=A0+C; 1211 l=division(H*s,A0*H+s^2*diff(matrix(H),s)); 1212 A=jet(l[1],l[2],mide); 1213 1214 intvec ide; 1215 ide[mu]=0; 1216 for(i=ncols(e);i>=1;i) 1217 { 1218 for(j=i1;j>=1;j) 1219 { 1220 k=int(e[j]e[i]); 1221 if(k>ide[j]) 1222 { 1223 ide[j]=k; 1224 } 1225 if(k>ide[i]) 1226 { 1227 ide[i]=k; 1228 } 1229 } 1230 } 1231 for(j,k=ncols(e),mu;j>=1;j) 1232 { 1233 for(i=b[j];i>=1;i) 1234 { 1235 ide[k]=ide[j]; 1236 k; 1237 } 1238 } 1239 1240 while(mide>0) 1241 { 1242 A0=jet(A,0); 1243 U=0; 1244 for(i=ncols(e);i>=1;i) 1245 { 1246 U=syz(power(A0e[i],n+1))+U; 1247 } 1248 V=lift(U,freemodule(mu)); 1249 A=V*A*U; 1250 H0=V*H0; 1251 1252 for(i=mu;i>=1;i) 1253 { 1254 for(j=mu;j>=1;j) 1255 { 1256 if(ide[i]==0&&ide[j]>0) 1257 { 1258 A[i,j]=A[i,j]/s; 1259 } 1260 else 1261 { 1262 if(ide[i]>0&&ide[j]==0) 1263 { 1264 A[i,j]=A[i,j]*s; 1265 } 1266 } 1267 } 1268 } 1269 H0=transpose(H0); 1270 for(i=mu;i>=1;i) 1271 { 1272 if(ide[i]>0) 1273 { 1274 A[i,i]=A[i,i]1; 1275 ide[i]=ide[i]1; 1276 H0[i]=H0[i]*s; 1277 } 1278 } 1279 H0=transpose(H0); 1280 mide; 1281 } 1282 1283 A=jet(A,0); 1284 } 1285 1286 U=jordanbasis(A); 1287 V=lift(U,freemodule(mu)); 1288 A0=V*A*U; 1289 1290 intvec w; 1291 w[mu]=1; 1292 j=1; 1293 for(i=mu1;i>=1;i) 1294 { 1295 j++; 1296 if(A0[i,i+1]==0) 1297 { 1298 j=1; 1299 } 1300 w[i]=j; 1301 } 1302 1303 vector u; 1304 for(i=1;i<ncols(A);i++) 1305 { 1306 j=i+1; 1307 while(j<ncols(A)&&A[i,i]==A[j,j]) 1308 { 1309 if(w[i]<w[j]) 1310 { 1311 k=w[i]; 1312 w[i]=w[j]; 1313 w[i]=k; 1314 u=U[i]; 1315 U[i]=U[j]; 1316 U[j]=u; 1317 } 1318 j++; 1319 } 1320 } 1321 1322 V=lift(U,freemodule(mu)); 1323 A=V*A*U; 1324 H0=std(V*H0); 1325 ideal a; 1326 for(i=1;i<=mu;i++) 1327 { 1328 j=leadexp(H0[i])[nvars(basering)+1]; 1329 a[i]=A[j,j]+deg(lead(H0[i]))/deg(s)1; 1330 } 1331 setring(R); 1332 return(sppgen(imap(G,a),w)); 1333 } 1334 example 1335 { "EXAMPLE:"; echo=2; 1336 ring R=0,(x,y),ds; 1337 poly f=x5+x2y2+y5; 1338 spprint(sppairs(f)); 1339 } 1340 /////////////////////////////////////////////////////////////////////////////// 1341 1342 proc spgen(ideal a) 1343 "USAGE: spgen(a); ideal a 1344 RETURN: 1345 @format 1346 list Sp: numbers in a with multiplicities 1347 ideal Sp[1]: numbers in a in increasing order 1348 intvec Sp[2]: corresponding multiplicities 1349 @end format 1350 EXAMPLE: example spgen; shows examples 1351 " 1352 { 1353 ideal a0=jet(a,0); 1354 int i,j; 1355 number n; 1356 for(i=1;i<=ncols(a0);i++) 1357 { 1358 for(j=i+1;j<=ncols(a0);j++) 1359 { 1360 if(number(a0[i])>number(a0[j])) 1361 { 1362 n=a0[i]; 1363 a0[i]=a0[j]; 1364 a0[j]=n; 1365 } 1366 } 1367 } 1368 j=1; 1369 a=a0[1]; 1370 intvec m=1; 1371 for(i=2;i<=ncols(a0);i++) 1372 { 1373 if(a0[i]==a[j]) 1374 { 1375 m[j]=m[j]+1; 1376 } 1377 else 1378 { 1379 j++; 1380 a[j]=a0[i]; 1381 m[j]=1; 1382 } 1383 } 1384 return(list(a,m)); 1385 } 1386 example 1387 { "EXAMPLE:"; echo=2; 1388 ring R=0,(x,y),ds; 1389 ideal a=1/2,3/10,3/10,1/10,1/10,0,1/10,1/10,3/10,3/10,1/2; 1390 spprint(spgen(a)); 1391 } 1392 /////////////////////////////////////////////////////////////////////////////// 1393 1394 proc sppgen(ideal a,intvec w) 1395 "USAGE: sppgen(a); ideal a 1396 RETURN: 1397 @format 1398 list Spp: pairs in a and w with multiplicities 1399 ideal Spp[1]: numbers in a 1400 intvec Spp[2]: corresponding integers in w 1401 intvec Spp[3]: corresponding multiplicities 1402 @end format 1403 EXAMPLE: example sppgen; shows examples 1404 " 1405 { 1406 ideal a0=jet(a,0); 1407 intvec w0=w; 1408 int i,j,k; 1409 number n; 1410 for(i=1;i<=ncols(a0);i++) 1411 { 1412 for(j=i+1;j<=ncols(a0);j++) 1413 { 1414 if(number(a0[i])>number(a0[j])a0[i]==a0[j]&&w0[i]>w0[j]) 1415 { 1416 n=a0[i]; 1417 a0[i]=a0[j]; 1418 a0[j]=n; 1419 k=w0[i]; 1420 w0[i]=w0[j]; 1421 w0[j]=k; 1422 } 1423 } 1424 } 1425 j=1; 1426 a=a0[1]; 1427 w=w0[1]; 1428 intvec m=1; 1429 for(i=2;i<=ncols(a0);i++) 1430 { 1431 if(a0[i]==a[j]&&w0[i]==w[j]) 1432 { 1433 m[j]=m[j]+1; 1434 } 1435 else 1436 { 1437 j++; 1438 a[j]=a0[i]; 1439 w[j]=w0[i]; 1440 m[j]=1; 1441 } 1442 } 1443 return(list(a,w,m)); 1444 } 1445 example 1446 { "EXAMPLE:"; echo=2; 1447 ring R=0,(x,y),ds; 1448 ideal a=1/2,3/10,3/10,1/10,1/10,0,1/10,1/10,3/10,3/10,1/2; 1449 intvec w=2,1,1,1,1,1,1,1,1,1,1; 1450 spprint(sppgen(a,w)); 1451 } 1452 /////////////////////////////////////////////////////////////////////////////// 1453 1454 proc spprint(list Sp) 1455 "USAGE: spprint(Sp); list Sp 1456 RETURN: string: spectrum or spectral pairs Sp 1457 EXAMPLE: example spprint; shows examples 1458 " 1459 { 1460 string s; 1461 if(size(Sp)==2) 1462 { 1463 for(int i=1;i<size(Sp[2]);i++) 1464 { 1465 s=s+"("+string(Sp[1][i])+","+string(Sp[2][i])+"),"; 1466 } 1467 s=s+"("+string(Sp[1][i])+","+string(Sp[2][i])+")"; 1468 } 1469 else 1470 { 1471 for(int i=1;i<size(Sp[3]);i++) 1472 { 1473 s=s+"(("+string(Sp[1][i])+","+string(Sp[2][i])+"),"+string(Sp[3][i])+"),"; 1474 } 1475 s=s+"(("+string(Sp[1][i])+","+string(Sp[2][i])+"),"+string(Sp[3][i])+")"; 1476 } 1477 return(s); 1478 } 1479 example 1480 { "EXAMPLE:"; echo=2; 1481 ring R=0,(x,y),ds; 1482 list Sp=list(ideal(1/2,3/10,1/10,0,1/10,3/10,1/2),intvec(1,2,2,1,2,2,1)); 1483 spprint(Sp); 1484 } 1485 /////////////////////////////////////////////////////////////////////////////// 1486 1487 proc spadd(list Sp1,list Sp2) 1488 "USAGE: spadd(Sp1,Sp2); list Sp1,Sp2 1489 RETURN: list: sum of spectra Sp1 and Sp2 1131 1490 EXAMPLE: example spadd; shows examples 1132 1491 " … … 1135 1494 intvec m; 1136 1495 int i,i1,i2=1,1,1; 1137 while(i1<=size(S 1[2])i2<=size(S2[2]))1138 { 1139 if(i1<=size(S 1[2]))1140 { 1141 if(i2<=size(S 2[2]))1142 { 1143 if(number(S 1[1][i1])<number(S2[1][i2]))1144 { 1145 s[i]=S 1[1][i1];1146 m[i]=S 1[2][i1];1496 while(i1<=size(Sp1[2])i2<=size(Sp2[2])) 1497 { 1498 if(i1<=size(Sp1[2])) 1499 { 1500 if(i2<=size(Sp2[2])) 1501 { 1502 if(number(Sp1[1][i1])<number(Sp2[1][i2])) 1503 { 1504 s[i]=Sp1[1][i1]; 1505 m[i]=Sp1[2][i1]; 1147 1506 i++; 1148 1507 i1++; … … 1150 1509 else 1151 1510 { 1152 if(number(S 1[1][i1])>number(S2[1][i2]))1511 if(number(Sp1[1][i1])>number(Sp2[1][i2])) 1153 1512 { 1154 s[i]=S 2[1][i2];1155 m[i]=S 2[2][i2];1513 s[i]=Sp2[1][i2]; 1514 m[i]=Sp2[2][i2]; 1156 1515 i++; 1157 1516 i2++; … … 1159 1518 else 1160 1519 { 1161 if(S 1[2][i1]+S2[2][i2]!=0)1520 if(Sp1[2][i1]+Sp2[2][i2]!=0) 1162 1521 { 1163 s[i]=S 1[1][i1];1164 m[i]=S 1[2][i1]+S2[2][i2];1522 s[i]=Sp1[1][i1]; 1523 m[i]=Sp1[2][i1]+Sp2[2][i2]; 1165 1524 i++; 1166 1525 } … … 1172 1531 else 1173 1532 { 1174 s[i]=S 1[1][i1];1175 m[i]=S 1[2][i1];1533 s[i]=Sp1[1][i1]; 1534 m[i]=Sp1[2][i1]; 1176 1535 i++; 1177 1536 i1++; … … 1180 1539 else 1181 1540 { 1182 s[i]=S 2[1][i2];1183 m[i]=S 2[2][i2];1541 s[i]=Sp2[1][i2]; 1542 m[i]=Sp2[2][i2]; 1184 1543 i++; 1185 1544 i2++; … … 1191 1550 { "EXAMPLE:"; echo=2; 1192 1551 ring R=0,(x,y),ds; 1193 list S 1=list(ideal(1/2,3/10,1/10,0,1/10,3/10,1/2),intvec(1,2,2,1,2,2,1));1194 spprint(S 1);1195 list S 2=list(ideal(1/6,1/6),intvec(1,1));1196 spprint(S 2);1197 spprint(spadd(S 1,S2));1198 } 1199 /////////////////////////////////////////////////////////////////////////////// 1200 1201 proc spsub(list S 1,list S2)1202 "USAGE: spsub(S 1,S2); list S1,S21203 RETURN: list: difference of spectra S 1 and S21552 list Sp1=list(ideal(1/2,3/10,1/10,0,1/10,3/10,1/2),intvec(1,2,2,1,2,2,1)); 1553 spprint(Sp1); 1554 list Sp2=list(ideal(1/6,1/6),intvec(1,1)); 1555 spprint(Sp2); 1556 spprint(spadd(Sp1,Sp2)); 1557 } 1558 /////////////////////////////////////////////////////////////////////////////// 1559 1560 proc spsub(list Sp1,list Sp2) 1561 "USAGE: spsub(Sp1,Sp2); list Sp1,Sp2 1562 RETURN: list: difference of spectra Sp1 and Sp2 1204 1563 EXAMPLE: example spsub; shows examples 1205 1564 " 1206 1565 { 1207 return(spadd(S 1,spmul(S2,1)));1566 return(spadd(Sp1,spmul(Sp2,1))); 1208 1567 } 1209 1568 example 1210 1569 { "EXAMPLE:"; echo=2; 1211 1570 ring R=0,(x,y),ds; 1212 list S 1=list(ideal(1/2,3/10,1/10,0,1/10,3/10,1/2),intvec(1,2,2,1,2,2,1));1213 spprint(S 1);1214 list S 2=list(ideal(1/6,1/6),intvec(1,1));1215 spprint(S 2);1216 spprint(spsub(S 1,S2));1571 list Sp1=list(ideal(1/2,3/10,1/10,0,1/10,3/10,1/2),intvec(1,2,2,1,2,2,1)); 1572 spprint(Sp1); 1573 list Sp2=list(ideal(1/6,1/6),intvec(1,1)); 1574 spprint(Sp2); 1575 spprint(spsub(Sp1,Sp2)); 1217 1576 } 1218 1577 /////////////////////////////////////////////////////////////////////////////// … … 1221 1580 "USAGE: 1222 1581 @format 1223 1) spmul(S ,k); list S, int k1224 2) spmul(S ,k); list S, intvec k1582 1) spmul(Sp,k); list Sp, int k 1583 2) spmul(Sp,k); list Sp, intvec k 1225 1584 @end format 1226 1585 RETURN: 1227 1586 @format 1228 1) list: product of spectrum S and integer k1229 2) list: linear combination of spectra S with coefficients k1587 1) list: product of spectrum Sp and integer k 1588 2) list: linear combination of spectra Sp with coefficients k 1230 1589 @end format 1231 1590 EXAMPLE: example spmul; shows examples … … 1242 1601 if(typeof(#[2])=="intvec") 1243 1602 { 1244 list S 0=list(ideal(),intvec(0));1603 list Sp0=list(ideal(),intvec(0)); 1245 1604 for(int i=size(#[2]);i>=1;i) 1246 1605 { 1247 S 0=spadd(S0,spmul(#[1][i],#[2][i]));1248 } 1249 return(S 0);1606 Sp0=spadd(Sp0,spmul(#[1][i],#[2][i])); 1607 } 1608 return(Sp0); 1250 1609 } 1251 1610 } … … 1256 1615 { "EXAMPLE:"; echo=2; 1257 1616 ring R=0,(x,y),ds; 1258 list S =list(ideal(1/2,3/10,1/10,0,1/10,3/10,1/2),intvec(1,2,2,1,2,2,1));1259 spprint(S );1260 spprint(spmul(S ,2));1261 list S 1=list(ideal(1/6,1/6),intvec(1,1));1262 spprint(S 1);1263 list S 2=list(ideal(1/3,0,1/3),intvec(1,2,1));1264 spprint(S 2);1265 spprint(spmul(list(S 1,S2),intvec(1,2)));1266 } 1267 /////////////////////////////////////////////////////////////////////////////// 1268 1269 proc spissemicont(list S ,list #)1270 "USAGE: spissemicont(S [,opt]); list S, int opt1617 list Sp=list(ideal(1/2,3/10,1/10,0,1/10,3/10,1/2),intvec(1,2,2,1,2,2,1)); 1618 spprint(Sp); 1619 spprint(spmul(Sp,2)); 1620 list Sp1=list(ideal(1/6,1/6),intvec(1,1)); 1621 spprint(Sp1); 1622 list Sp2=list(ideal(1/3,0,1/3),intvec(1,2,1)); 1623 spprint(Sp2); 1624 spprint(spmul(list(Sp1,Sp2),intvec(1,2))); 1625 } 1626 /////////////////////////////////////////////////////////////////////////////// 1627 1628 proc spissemicont(list Sp,list #) 1629 "USAGE: spissemicont(Sp[,opt]); list Sp, int opt 1271 1630 RETURN: 1272 1631 @format 1273 1632 int k= 1274 if opt= =0:1275 1, if sum of spectrum S over all intervals [a,a+1) is positive1276 0, if sum of spectrum S over some interval [a,a+1) is negative1277 if opt= =1:1278 1, if sum of spectrum S over all intervals [a,a+1) and (a,a+1) is positive1279 0, if sum of spectrum S over some interval [a,a+1) or (a,a+1) is negative1633 if opt=0: 1634 1, if sum of spectrum Sp over all intervals [a,a+1) is positive 1635 0, if sum of spectrum Sp over some interval [a,a+1) is negative 1636 if opt=1: 1637 1, if sum of spectrum Sp over all intervals [a,a+1) and (a,a+1) is positive 1638 0, if sum of spectrum Sp over some interval [a,a+1) or (a,a+1) is negative 1280 1639 default: opt=0 1281 1640 @end format … … 1292 1651 } 1293 1652 int i,j,k=1,1,0; 1294 while(j<=size(S [2]))1295 { 1296 while(j+1<=size(S [2])&&S[1][j]<S[1][i]+1)1297 { 1298 k=k+S [2][j];1653 while(j<=size(Sp[2])) 1654 { 1655 while(j+1<=size(Sp[2])&&Sp[1][j]<Sp[1][i]+1) 1656 { 1657 k=k+Sp[2][j]; 1299 1658 j++; 1300 1659 } 1301 if(j==size(S [2])&&S[1][j]<S[1][i]+1)1302 { 1303 k=k+S [2][j];1660 if(j==size(Sp[2])&&Sp[1][j]<Sp[1][i]+1) 1661 { 1662 k=k+Sp[2][j]; 1304 1663 j++; 1305 1664 } … … 1308 1667 return(0); 1309 1668 } 1310 k=kS [2][i];1669 k=kSp[2][i]; 1311 1670 if(k<0&&opt==1) 1312 1671 { … … 1320 1679 { "EXAMPLE:"; echo=2; 1321 1680 ring R=0,(x,y),ds; 1322 list S 1=list(ideal(1/2,3/10,1/10,0,1/10,3/10,1/2),intvec(1,2,2,1,2,2,1));1323 spprint(S 1);1324 list S 2=list(ideal(1/6,1/6),intvec(1,1));1325 spprint(S 2);1326 spissemicont(spsub(S 1,spmul(S2,5)));1327 spissemicont(spsub(S 1,spmul(S2,5)),1);1328 spissemicont(spsub(S 1,spmul(S2,6)));1329 } 1330 /////////////////////////////////////////////////////////////////////////////// 1331 1332 proc spsemicont(list S 0,list S,list #)1333 "USAGE: spsemicont(S ,k[,opt]); list S0, list S, int opt1681 list Sp1=list(ideal(1/2,3/10,1/10,0,1/10,3/10,1/2),intvec(1,2,2,1,2,2,1)); 1682 spprint(Sp1); 1683 list Sp2=list(ideal(1/6,1/6),intvec(1,1)); 1684 spprint(Sp2); 1685 spissemicont(spsub(Sp1,spmul(Sp2,5))); 1686 spissemicont(spsub(Sp1,spmul(Sp2,5)),1); 1687 spissemicont(spsub(Sp1,spmul(Sp2,6))); 1688 } 1689 /////////////////////////////////////////////////////////////////////////////// 1690 1691 proc spsemicont(list Sp0,list Sp,list #) 1692 "USAGE: spsemicont(Sp,k[,opt]); list Sp0, list Sp, int opt 1334 1693 RETURN: list of intvecs l: 1335 spissemicont(sub(S 0,spmul(S,k)),opt)==1 iff k<=l[i] for some i1336 NOTE: if the spectra S occur with multiplicities k in a deformation1337 of the [quasihomogeneous] spectrum S 0 then1338 spissemicont(sub(S 0,spmul(S,k))[,1])==11694 spissemicont(sub(Sp0,spmul(Sp,k)),opt)==1 iff k<=l[i] for some i 1695 NOTE: if the spectra Sp occur with multiplicities k in a deformation 1696 of the [quasihomogeneous] spectrum Sp0 then 1697 spissemicont(sub(Sp0,spmul(Sp,k))[,1])==1 1339 1698 EXAMPLE: example spsemicont; shows examples 1340 1699 " … … 1342 1701 list l,l0; 1343 1702 int i,j,k; 1344 while(spissemicont(S 0,#))1345 { 1346 if(size(S )>1)1347 { 1348 l0=spsemicont(S 0,list(S[1..size(S)1]));1703 while(spissemicont(Sp0,#)) 1704 { 1705 if(size(Sp)>1) 1706 { 1707 l0=spsemicont(Sp0,list(Sp[1..size(Sp)1])); 1349 1708 for(i=1;i<=size(l0);i++) 1350 1709 { … … 1358 1717 if(l[j]==l0[i]) 1359 1718 { 1360 l[j][size(S )]=k;1719 l[j][size(Sp)]=k; 1361 1720 } 1362 1721 else 1363 1722 { 1364 l0[i][size(S )]=k;1723 l0[i][size(Sp)]=k; 1365 1724 l=l+list(l0[i]); 1366 1725 } … … 1372 1731 } 1373 1732 } 1374 S 0=spsub(S0,S[size(S)]);1733 Sp0=spsub(Sp0,Sp[size(Sp)]); 1375 1734 k++; 1376 1735 } 1377 if(size(S )>1)1736 if(size(Sp)>1) 1378 1737 { 1379 1738 return(l); … … 1387 1746 { "EXAMPLE:"; echo=2; 1388 1747 ring R=0,(x,y),ds; 1389 list S 0=list(ideal(1/2,3/10,1/10,0,1/10,3/10,1/2),intvec(1,2,2,1,2,2,1));1390 spprint(S 0);1391 list S 1=list(ideal(1/6,1/6),intvec(1,1));1392 spprint(S 1);1393 list S 2=list(ideal(1/3,0,1/3),intvec(1,2,1));1394 spprint(S 2);1395 list S =S1,S2;1396 list l=spsemicont(S 0,S);1748 list Sp0=list(ideal(1/2,3/10,1/10,0,1/10,3/10,1/2),intvec(1,2,2,1,2,2,1)); 1749 spprint(Sp0); 1750 list Sp1=list(ideal(1/6,1/6),intvec(1,1)); 1751 spprint(Sp1); 1752 list Sp2=list(ideal(1/3,0,1/3),intvec(1,2,1)); 1753 spprint(Sp2); 1754 list Sp=Sp1,Sp2; 1755 list l=spsemicont(Sp0,Sp); 1397 1756 l; 1398 spissemicont(spsub(S 0,spmul(S,l[1])));1399 spissemicont(spsub(S 0,spmul(S,l[1]1)));1400 spissemicont(spsub(S 0,spmul(S,l[1]+1)));1401 } 1402 /////////////////////////////////////////////////////////////////////////////// 1403 1404 proc spmilnor(list S )1405 "USAGE: spmilnor(S ); list S1406 RETURN: int: Milnor number of spectrum S 1757 spissemicont(spsub(Sp0,spmul(Sp,l[1]))); 1758 spissemicont(spsub(Sp0,spmul(Sp,l[1]1))); 1759 spissemicont(spsub(Sp0,spmul(Sp,l[1]+1))); 1760 } 1761 /////////////////////////////////////////////////////////////////////////////// 1762 1763 proc spmilnor(list Sp) 1764 "USAGE: spmilnor(Sp); list Sp 1765 RETURN: int: Milnor number of spectrum Sp 1407 1766 EXAMPLE: example spmilnor; shows examples 1408 1767 " 1409 1768 { 1410 return(sum(S [2]));1769 return(sum(Sp[2])); 1411 1770 } 1412 1771 example 1413 1772 { "EXAMPLE:"; echo=2; 1414 1773 ring R=0,(x,y),ds; 1415 list S =list(ideal(1/2,3/10,1/10,0,1/10,3/10,1/2),intvec(1,2,2,1,2,2,1));1416 spprint(S );1417 spmilnor(S );1418 } 1419 /////////////////////////////////////////////////////////////////////////////// 1420 1421 proc spgeomgenus(list S )1422 "USAGE: spgeomgenus(S ); list S1423 RETURN: int: geometrical genus of spectrum S 1774 list Sp=list(ideal(1/2,3/10,1/10,0,1/10,3/10,1/2),intvec(1,2,2,1,2,2,1)); 1775 spprint(Sp); 1776 spmilnor(Sp); 1777 } 1778 /////////////////////////////////////////////////////////////////////////////// 1779 1780 proc spgeomgenus(list Sp) 1781 "USAGE: spgeomgenus(Sp); list Sp 1782 RETURN: int: geometrical genus of spectrum Sp 1424 1783 EXAMPLE: example spgeomgenus; shows examples 1425 1784 " … … 1427 1786 int g=0; 1428 1787 int i=1; 1429 while(i+1<=size(S [2])&&number(S[1][i])<=number(0))1430 { 1431 g=g+S [2][i];1788 while(i+1<=size(Sp[2])&&number(Sp[1][i])<=number(0)) 1789 { 1790 g=g+Sp[2][i]; 1432 1791 i++; 1433 1792 } 1434 if(i==size(S [2])&&number(S[1][i])<=number(0))1435 { 1436 g=g+S [2][i];1793 if(i==size(Sp[2])&&number(Sp[1][i])<=number(0)) 1794 { 1795 g=g+Sp[2][i]; 1437 1796 } 1438 1797 return(g); … … 1441 1800 { "EXAMPLE:"; echo=2; 1442 1801 ring R=0,(x,y),ds; 1443 list S =list(ideal(1/2,3/10,1/10,0,1/10,3/10,1/2),intvec(1,2,2,1,2,2,1));1444 spprint(S );1445 spgeomgenus(S );1446 } 1447 /////////////////////////////////////////////////////////////////////////////// 1448 1449 proc spgamma(list S )1450 "USAGE: spgamma(S ); list S1451 RETURN: number: gamma invariant of spectrum S 1802 list Sp=list(ideal(1/2,3/10,1/10,0,1/10,3/10,1/2),intvec(1,2,2,1,2,2,1)); 1803 spprint(Sp); 1804 spgeomgenus(Sp); 1805 } 1806 /////////////////////////////////////////////////////////////////////////////// 1807 1808 proc spgamma(list Sp) 1809 "USAGE: spgamma(Sp); list Sp 1810 RETURN: number: gamma invariant of spectrum Sp 1452 1811 EXAMPLE: example spgamma; shows examples 1453 1812 " … … 1455 1814 int i,j; 1456 1815 number g=0; 1457 for(i=1;i<=ncols(S [1]);i++)1458 { 1459 for(j=1;j<=S [2][i];j++)1460 { 1461 g=g+(number(S [1][i])number(nvars(basering)2)/2)^2;1462 } 1463 } 1464 g=g/4+sum(S [2])*number(S[1][ncols(S[1])]S[1][1])/48;1816 for(i=1;i<=ncols(Sp[1]);i++) 1817 { 1818 for(j=1;j<=Sp[2][i];j++) 1819 { 1820 g=g+(number(Sp[1][i])number(nvars(basering)2)/2)^2; 1821 } 1822 } 1823 g=g/4+sum(Sp[2])*number(Sp[1][ncols(Sp[1])]Sp[1][1])/48; 1465 1824 return(g); 1466 1825 } … … 1468 1827 { "EXAMPLE:"; echo=2; 1469 1828 ring R=0,(x,y),ds; 1470 list S =list(ideal(1/2,3/10,1/10,0,1/10,3/10,1/2),intvec(1,2,2,1,2,2,1));1471 spprint(S );1472 spgamma(S );1473 } 1474 /////////////////////////////////////////////////////////////////////////////// 1829 list Sp=list(ideal(1/2,3/10,1/10,0,1/10,3/10,1/2),intvec(1,2,2,1,2,2,1)); 1830 spprint(Sp); 1831 spgamma(Sp); 1832 } 1833 ///////////////////////////////////////////////////////////////////////////////
Note: See TracChangeset
for help on using the changeset viewer.