LIB"aeq.lib"; /////////////////////////////////////////////////////////////////// proc ClassifierSSC(ideal I) //"USAGE": ClassifierSSC(I); I ideal //RETURN: An ideal.Ideal is one of the singularity in the list of V.I. Arnold // (Simple singularities of curves. (Russia) Tr. Mat. Inst. Steklova 226 (1999), //Mat. Fiz. probl. Kvantovoi Teor. Polya, 27-35; translation in Proc. Steklov Inst. Math. 226 (1999), 20-28).) { int n, sgsa, s1,s2,s3,s4,s5,s6,st1,st2,st3,st4,st5,st6, con, k,q ; intvec gsa, gsm, sogsa, sogsm; ideal J, K,g,m, D, H, T, Redg; list sa, sm; // ideal D=diff(I,var(1)); n=size(I); if(n==3) { K=spaceCur(I); return (K); } if(n<=2) { K=planeCur(I); return (K); } g=sagbiAlg(I); //Compute the Sagbi-basis of the Algebra. int b=ConductorBound(g); Redg=interReduceSagbi(g,b) ; int sRedg=size(Redg); if(sRedg==3) { K=spaceCur(I); return (K); } if(sRedg<=2) { K=planeCur(I); return (K); } // m=sagbiMod(D,g); //Compute the Sagbi- basis of the Module. sa=semiGroup(Redg); //Compute the Semi-Group of the Algebra provided the input is Sagbi Bases of the Algebra. // sm=semiMod(m,g); //Compute the Semi-Module provided that the input are the Sagbi Bases of the Algebra resp.Module. gsa=sa[1]; // gsm=sm[4]; con=sa[2]; sogsa=sortIntvec(gsa); // sogsm=sortIntvec(gsm); sgsa=size(gsa); if (sgsa==4) { s1=sogsa[1]; s2=sogsa[2]; s3=sogsa[3]; s4=sogsa[4]; if (s1==4 && s2==5 && s3==6 && s4==7) {K=var(1)^4,var(1)^5, var(1)^6, var(1)^7 ; return(K);} if (s1==4 && s2==6 && s3==7 && s4==9) {K=var(1)^4,var(1)^6, var(1)^7, var(1)^9 ; return(K);} if (s1==4 && s2==7 && s3==9 && s4==10) {K=var(1)^4,var(1)^7, var(1)^9, var(1)^10 ; return(K);} if (s1==4 && s2==9 && s3==10 && s4==11) {K=var(1)^4,var(1)^9, var(1)^10, var(1)^11 ; return(K);} if (s1==5 && s2==6 && s3==7 && s4==8) {K=var(1)^5,var(1)^6, var(1)^7, var(1)^8 ; return(K);} if (s1==5 && s2==6 && s3==7 && s4==9) {K=var(1)^5,var(1)^6, var(1)^7, var(1)^9 ; return(K);} if (s1==5 && s2==6 && s3==8 && s4==9) {K=var(1)^5,var(1)^6, var(1)^8, var(1)^9 ; return(K);} if (s1==5 && s2==7 && s3==8 && s4==9) {K=var(1)^5,var(1)^7, var(1)^8, var(1)^9 ; return(K);} if (s1==4 && s2==7 && s3==10 && s4==13) { J=sortideal4(I); H=planeCur(J); if(H[1]==var(1)^4 && H[2]==var(1)^7) {K=var(1)^4,var(1)^7, var(1)^10, var(1)^13 ; return(K);} if(H[1]==var(1)^4 && H[2]==var(1)^7+var(1)^9) {K=var(1)^4,var(1)^7+var(1)^9, var(1)^10, var(1)^13 ; return(K);} } k=(con-8)/2; if (s1==4 && s2==6 && s3==2*k+9 && s4==2*k+11) { J=sortideal44(I); T=var(1)^2; if (sagbiNF(J[1],T,b)==0 && sagbiNF(J[2],T,b)==0){K=var(1)^4,var(1)^6, var(1)^(2*k+9), var(1)^(2*k+11) ; return(K);} K=var(1)^4,var(1)^6+var(1)^(2*k+7), var(1)^(2*k+9), var(1)^(2*k+11); return(K); // H=planeCur(J); ~ //if(H[1]==var(1)^4 && H[2]==var(1)^6+var(1)^(2*k+7)){K=var(1)^4,var(1)^6+var(1)^(2*k+7), var(1)^(2*k+9), var(1)^(2*k+11) ; return(K);} // K=var(1)^4,var(1)^6, var(1)^(2*k+9), var(1)^(2*k+11); return(K); } } if (sgsa==5) { s1=sogsa[1]; s2=sogsa[2]; s3=sogsa[3]; s4=sogsa[4]; s5=sogsa[5]; if (s1==5 && s2==6 && s3==7 && s4==8 && s5==9 ) {K=var(1)^5,var(1)^6, var(1)^7, var(1)^8, var(1)^9 ; return(K);} if (s1==5 && s2==7 && s3==8 && s4==9 && s5==11) {K=var(1)^5,var(1)^7, var(1)^8, var(1)^9, var(1)^11 ; return(K);} if (s1==6 && s2==7 && s3==8 && s4==9 && s5==11) {K=var(1)^6,var(1)^7, var(1)^8, var(1)^9, var(1)^11 ; return(K);} if (s1==6 && s2==7 && s3==8 && s4==9 && s5==10) {K=var(1)^6,var(1)^7, var(1)^8, var(1)^9, var(1)^10 ; return(K);} } if (sgsa==6) { s1=sogsa[1]; s2=sogsa[2]; s3=sogsa[3]; s4=sogsa[4]; s5=sogsa[5]; s6=sogsa[6]; if (s1==6 && s2==7 && s3==8 && s4==9 && s5==10 && s6==11 ) {K=var(1)^6,var(1)^7, var(1)^8, var(1)^9, var(1)^10, var(1)^11 ; return(K);} } return (K); } /////////////////////////////////////////EXAMPLE////////// // ideal j=t4+4t5+6t6+8t7+13t8+12t9+10t10+12t11+6t12+4t13+4t14+t16, //t7+22t9+51t10+113t11+219t12+366t13+589t14+876t15+1170t16+1514t17+1828t18+2011t19+2165t20+2163t21+1982t22+1806t23+1491t24+1141t25+889t26+588t27+379t28+252t29+120t30+72t31+36t32+9t33+9t34+t36, //7t10+13t67+52t18+t28, 12t13+14t15 ; //ClassifierSSC (j); //_[1]=t4 //_[2]=t7+t9 //_[3]=t10 //_[4]=t13 ///////////////////////////////////////////////////////////////////////// proc sortideal4(ideal I) { int n, i,j ; ideal J; n=size(I); for(i=1;i<=n;i++) { if(leadmonom(I[i])==var(1)^4) {J[1]=I[i];} } for(j=1;j<=n;j++) { if(leadmonom(I[j])==var(1)^7) {J[2]=I[j];} } return(J); } ////////////////////////////////////////////////////////////////////////////////////// proc sortideal44(ideal I) { int n, i,j ; ideal J; n=size(I); for(i=1;i<=n;i=i++) { if(leadmonom(I[i])==var(1)^4) {J[1]=I[i];} } for(j=1;j<=n;j++) { if(leadmonom(I[j])==var(1)^6) {J[2]=I[j];} } return(J); } //////////////////////////////////////////////////////////////////////////////////////////////////// //Following procedures which we have used in the classifier are taken from the library "aeq.lib" as they are static in it. ////////////////////////////////////////////////////////////////////////////////////////////////////////// proc sagbiNF(poly f,ideal I,int b) { //computes the Sagbi normal form list L=1; map psi; f=jet(f,b); if(f==0){return(f);} while((f!=0) && (L[1]!=0)) { L= algebra_containment(lead(f),lead(I),1); if (L[1]==1) { def S= L[2]; psi= S,maxideal(1),I; f=jet(f-psi(check),b); kill S; } } return (lead(f)+sagbiNF(f-lead(f),I,b)); } ////////////////////////////////////////////////////////////////////////////////////////////////////////// proc sagbiSP(ideal I) { //computes the set of Sagbi-s-polys if(I==0){ return(I); } list L=algDependent(lead(I)); def S= L[2]; map phi= S,maxideal(1),I; return(simplify(phi(ker),2)); } ////////////////////////////////////////////////////////////////////////////////////////////////////////// proc sortSagbi(ideal I) { //sorts, makes input monic and removes zeros I=simplify(I,2); I=simplify(I,1); int i; int n=1; poly p; while(n) { n=0; for(i=1;ideg(lead(I[i+1]))) { n=1; p=I[i]; I[i]=I[i+1]; I[i+1]=p; break; } } } return(I); } ////////////////////////////////////////////////////////////////////////////////////////////////////////// proc insertOne(poly p, ideal I, int b) { //assume I is sorted, inserts p at the correct place int i,j; poly q; for(i=1;i<=size(I);i++) { if(deg(lead(p))i;j--) { I[j]=I[j-1]; } I[i]=simplify(p,1); } if(i=c list L; int i; for(i=1;i<=size(I);i++) { L[i]=I[i]; } list M=WSemigroup(L,b); if(b>M[2]) {b=M[2]+1;} return(b); } ////////////////////////////////////////////////////////////////////////////////////////////////////////// proc sortMinord(ideal I) { //input an ideal //output a list L[1]=minimal order, // L[2]=poly having the minimal order, // L[3]=the k suchthat I[k] has the minimal order, // L[4]=ideal I sorted in a way that minimal degree polynomial //appears as the last polynomial of the ideal.ie I[size(I)]=I[k]. int i; int n=1; list L; poly p; while(n) { n=0; for(i=1;i1)) { p=L[2]/var(1)^L[1]; J=L[4]; for(i=1;i<=L[3]-1;i++) { J[i]=J[i]/var(1)^L[1]*inversP(p,b); if(deg(lead(J[i]))==0){J[i]=J[i]-lead(J[i]);} } J=simplify(J,2); L=sortMinord(J); M[size(M)+1]=L[1]; } if(M[size(M)]==1){break;} } for(i=1;i<=size(M)-1;i++) { c=c+M[i]*(M[i]-1); } return(c+1); } ////////////////////////////////////////////////////////////////////////////////////////////////////////// proc sortMOD(ideal I) { //sorts, makes input monic and removes zeros I=simplify(I,2); I=simplify(I,1); int i; int n=1; poly p; while(n) { n=0; for(i=1;ideg(lead(I[i+1]))) { n=1; p=I[i]; I[i]=I[i+1]; I[i+1]=p; break; } } } return(I); } ////////////////////////////////////////////////////////////////////////////////////////////////////////// proc SpolyMOD(ideal S,ideal P) { //Assume that the basering is a ring in one variable. //input two ideals ideal S= generators of the module and ideal P= the sagbi basis of the algebra //output is an ideal generated by Q[p_1,p_2,...p_n]s_1-R[p_1,p_2,...p_n]s_2 for generators of //Q[lead(p_1),lead(p_2),.,lead(p_n)]lead(s_1)-R[lead(p_1),lead(p_2),.,lead(p_n)]lead(s_2)=0 . def br=basering; int n=ncols(P); ideal P1=lead(P); ideal S1=lead(S); execute ("ring T=("+charstr(br)+",x(1),z(1..n)),(y(1..2)),dp;"); poly q; execute ("ring R=("+charstr(br)+"),(x(1),y(1..2),z(1..n)),(lp(3),dp(n));"); map phi=br,x(1); ideal G=phi(P1); ideal I=phi(S1); ideal K,J; int d,o,s,j; poly q=I[1]; if(deg(I[1])>deg(I[2])) { o=1; q=I[2]; } I=I/q; for(int i=1;i<=2;i++) { K[i]=I[i]-y(i); } for(i=1;i<=n;i++) { K[2+i]=G[i]-z(i); } option(redSB); K=std(K); for(i=1;i<=size(K);i++) { if((K[i]/x(1)==0)&&((diff(K[i],y(1))!=0)||(diff(K[i],y(2))!=0))) { q=K[i]; for(j=1;j<=2;j++) { q=subst(q,y(j),0); } K[i]=K[i]-q+q*y(o+1); q=K[i]; setring T; q=imap(R,q); s=deg(q); setring R; if(s==1){J[size(J)+1]=simplify(q,1);} } } setring br; map phi=R,maxideal(1),S,P; return(phi(J)); } ///////////////////////////////////////////////////////////////////////////////////// proc sagbiNFMODO(poly p, ideal G, ideal I,int b) { //input a poly ideal G ideal I int b is a bound //output an ideal K such that in each K[i] generators of I appear in linear. def br=basering; p=jet(p,b); if(p==0){return(p);} int n=ncols(G); int m=ncols(I); ideal G1=lead(G); ideal I1=lead(I); poly p1=lead(p); //create new ring with extra variables - execute ("ring T=("+charstr(br)+",x(1),z(1..n)),(x(2),y(1..m)),dp;"); execute ("ring R=("+charstr(br)+"),(x(1..2),y(1..m),z(1..n)),(lp(m+2),dp(n));"); map phi = br,x(1); ideal P = phi(G1); ideal S = phi(I1); poly check = phi(p1); poly keep=S[1]; S=S/keep; check=check/keep; ideal M; poly q; for (int i=1;i<=m;i=i+1) { M[i]=S[i]-y(i); } for (i=1;i<=n;i=i+1) { M[m+i]=P[i]-z(i); } M[size(M)+1]=check-x(2); check=check*keep; option(redSB); M=std(M); int j,s; for(i=1;i<=size(M);i++) { if((deg(M[i]/x(2))==0)&&(M[i]/x(1)==0)) { q=subst(M[i],x(2),0); for(j=1;j<=m;j++) { q=subst(q,y(j),0); } M[i]=M[i]-q+q*y(1); q=M[i]; setring T; poly q=imap(R,q); s=deg(q); setring R; if(s==1){check=simplify(q,1);break;} } } setring br; map psi=R,maxideal(1),p,I,G; return(psi(check)); } ///////////////////////////////////////////////////////////////////////////////////////////// proc sagbiNFMOD(poly p, ideal G, ideal I, int b) { poly f=jet(p,b); if(f==0){return(f);} poly h; while(f!=h) { h=f; f=sagbiNFMODO(f,G,I,b); } if(f==0){return(f);} return(lead(f)+sagbiNFMOD(f-lead(f),G,I,b)); } ///////////////////////////////////////////////////////////////////////////////////////////// proc createP(ideal I) { list P; int i=1; int j; while(i<=size(I)-1) { j=i+1; while(j<=size(I)) { P[size(P)+1]=list(I[i],I[j]); j++; } i++; } return(P); } //////////////////////////////////////////////////////////////////////////////////////////// proc enlargeP(poly h,list P,ideal I) { int i; for(i=1;i<=size(I);i++) { P[size(P)+1]=list(I[i],h); } return(P); } /* ring r=0,t,Ds; ideal I=4t3,7t6+10t9; ideal G=t4,t7+t10; sagbiMOD(I,G,18); */ //////////////////////////////////////////////////////////////////////////////////////////// proc sortIntvec(intvec L) { //input: intvec L. //output: L sorted, multiple elements canceled. int i; int j; int n=1; intvec M; while(n) { for(i=1;i<=size(L);i++) { for(j=i+1;j<=size(L);j++) { if(L[i]==L[j]) { L[j]=0; } } } n=0; } for(i=1;i<=size(L);i++) { if((L[i]!=0)||(i==1)) { M[size(M)+1]=L[i]; } } int m=1;int p; while(m) { m=0; for(i=1;iM[i+1]) { m=1; p=M[i]; M[i]=M[i+1]; M[i+1]=p; break; } } } M=M[2..size(M)]; return(M); } ////////////////////////////////////////////////////////////////////////////////////// proc findConductor(intvec L) { //input a intvec L //output is an integer which came before the gap from right to left. int i;int j; list K; int c; for(i=size(L);i>=2;i--) { if(L[i]!=L[i-1]+1) { c=L[i]; break; } } if(c==0){c=1;} return(c); } ///////////////////////////////////////////////////////////////////////////////////// proc cutAfterConductor(intvec L) { //input an integer vector //output cut all the integers in the intvec which came after the conductor int i;int j; intvec K; int c=findConductor(L); for(i=1;i<=size(L);i++) { if(L[i]==c) { K[1..i]=L[1..i]; } } return(K); } //////////////////////////////////////////////////////////////////////////////////// proc CompareList(list L,list M,int n) { //input two list L,M with the same size n //out put 0 if not equal 1 if equal. for(int i=1;i<=n;i++) { if(L[i]!=M[i]) { i=0; break; } } return(i); } //////////////////////////////////////////////////////////////////////////////////// proc Guess(ideal I) { // comput the sagbi basis of the module //which we guess . I=sagbiAlg(I); ideal H=diff(I,var(1)); H=sagbiMod(H,I); list K=semiMod(H,I); return(K); } ///////////////////////////////////////////////////////////////////////////////////////////////////////////