md=20; (* maximal degree *) expansion=Normal[Series[u Exp[Sum[a[i]u^i,{i,4,md+5,2}]],{u,0,md+5}]]; gg[x_]:=expansion/.u->x FF[x_,y_]:=g[x+y]/(g[x]g[y]) Print["Blow-up relation"] LHS=F[x1,b1+b2] F[x2-x1,b2]+F[x2,b1+b2] F[x1-x2,b1]; RHS=F[x1,b1] F[x2,b2]; Rel0=Numerator[Factor[LHS-RHS/.F->FF]] Print["if g''[0]=0, then g is an odd function"] inic={g[0]->0,g'[0]->1,g''[0]->0}; Factor[D[Rel0,{x2,1},{b1,1},{b2,1}]/.{x2->0,b1->0,b2->0,x1->x}/.inic]==0 Print["relation, assuming that g is antisymmetric"] Rel=Factor[Rel0/g[x1-x2]/.g[x2-x1]->-g[x1-x2]] Print["differential relation for odd function"] inic={g[0]->0,g'[0]->1,g''[0]->0,g'''[0]->0}; asym={g[-x]->-g[x],g'[-x]->g'[x],g''[-x]->-g''[x],g'''[-x]->g'''[x],g''''[-x]->-g''''[x]}; DR=Factor[D[Rel,{x2,2},{b1,2},{b2,2}]/.{x2->0,b1->0,b2->0,x1->x}/.inic/.asym] Print["the sequence of relations, d[j] depends linearly on a[j+2]"] Do[d[j]=Factor[Coefficient[DR/.g->gg,x,j]],{j,0,md,2}] Do[Print["d[",j,"]=",d[j]],{j,0,16,2}] Print["coefficients obey polynomial pattern -2(j-4)(1+j)(2+j)(3+j)"] Table[-2(j-4)(1+j)(2+j)(3+j)==Coefficient[d[j],a[j+2]],{j,6,md-2,2}] Print["expressions for a[j], j>8"] p={};Do[p=Union[p,Solve[0==d[i]/.p,a[i+2]][[1]]],{i,6,md,2}]; Column[Expand[p]] Print["a simpler form of the equation"] Expand[Solve[Factor[DR/.g->Function[x,x E^(-2 v[x])]/.{v[0]->0,v'[0]->0,v''[0]->0}]==0,v''''[x]]] Print["Braid relation"] LHS=F[z2-z1,m3-m2] F[z3-z2,m3-m1] F[z2-z1,m2-m1]+F[z1-z2,h] F[z3-z1,m3-m1] F[z2-z1,h]; RHS=F[z3-z2,m2-m1] F[z2-z1,m3-m1] F[z3-z2,m3-m2]+F[z2-z3,h] F[z3-z1,m3-m1] F[z3-z2,h]; Rel0=Numerator[Factor[LHS-RHS/.F->FF/.m1->0/.z1->0]] Print["if g''[0]=0,then g is an odd function"] inic={g[0]->0,g'[0]->1,g''[0]->0}; Factor[D[Rel0,{m2,1},{m3,1},{z2,3},{h,1}]/.{m2->0,m3->0,z2->0,h->0}/.inic]==0 Print["reletion,assuming that g is antisymmetric"] Rel=Factor[Rel0/(g[z2]g[z2-z3])/.{g[-z2]->-g[z2],g[z3-z2]->-g[z2-z3]}] Print["differential relation for odd function"] inic={g[0]->0,g'[0]->1,g''[0]->0,g'''[0]->0}; asym={g[-x]->-g[x],g'[-x]->g'[x],g''[-x]->-g''[x],g'''[-x]->g'''[x],g''''[-x]->-g''''[x]}; DBr=Factor[D[Rel,{m2,1},{m3,2},{z2,2},{h,4}]/.{m2->0,m3->0,z2->0,z3->x,h->0}/.inic/.asym] Print["new differential equation differs by an invertible factor"] Factor[DBr/DR] Print["Atiyah Flop"] expansion=Normal[Series[u Exp[Sum[b[i]u^i,{i,2,md+14}]],{u,0,md+14}]]; gg[x_]:=expansion/.u->x Print["the relation"] SA1=1/(g[t1-t2] g[s1+t2] g[s2+t2])+1/(g[s1+t1] g[s2+t1] g[-t1+t2]); SA2=1/(g[-s1+s2] g[s1+t1] g[s1+t2])+1/(g[s1-s2] g[s2+t1] g[s2+t2]); RA=Numerator[Factor[SA1-SA2]] Print["differential equation assuming g(0)=0, g'(0)=1, g''(0)=0"] inic={g[0]->0,g'[0]->1,g''[0]->0}; DR=Factor[D[RA,{s1,2},{s2,2}]/.{s1->0,s2->0,t1->0,t2->t}/.inic]; Collect[DR,g[-t],Factor] Print["the sequence of relations: d[j] depends linearly on b[j-1]"] Do[d[j]=Factor[Coefficient[DR/.g->gg,t,j]],{j,0,md}] Do[Print["d[",j,"]=",d[j]],{j,0,10}] Print["coefficient obey a polynomial pattern, 4(j-4)(j-1), j even "] Table[Coefficient[d[j],b[j-1]]==4(j-4)(j-1),{j,6,md,2}] Print["coefficient obey a polynomial pattern, 4(j-4)j, j odd "] Table[Coefficient[d[j],b[j-1]]==4(j-5)j,{j,5,md,2}] Print["expressions for a[j] for j>4"] p={};Do[p=Union[p,Solve[0==d[i]/.p,b[i-1]][[1]]],{i,6,md}];Column[Expand[p]] Print["Grassmannian flop"] S1[n_]:=Sum[Product[1/(g[x[i]-x[p]]g[x[p]-x[i]+s]),{i,Complement[Range[n],{p}]}],{p,1,n}] S2[n_]:=Sum[Product[1/(g[x[p]-x[i]]g[x[i]-x[p]+s]),{i,Complement[Range[n],{p}]}],{p,1,n}] R[n_]:=Numerator[Factor[S1[n]-S2[n]]] inic={g[0]->0,g'[0]->1,g''[0]->0}; Print["differential equation for the nilpotent cone, n=3"] DR3=Factor[D[Factor[D[R[3]/.x[1]->0,{x[2],5}]/.x[2]->0]/.inic,{x[3],4}]/.x[3]->0/.inic]; Collect[DR3/40,g[s],Factor] Print["the sequence of relations, d[j] depends linearly on b[j-1]"] Do[d[j]=Factor[SeriesCoefficient[DR3/.g->gg,{s,0,j}]],{j,0,md}] Do[Print["d[",j,"]=",d[j]],{j,0,16}] Print["the polynomial pattern -240(j-6)(j-5)(j-2)(j+1)(j+2)"] Table[Coefficient[d[j],b[j+1]]==-240(j-6)(j-5)(j-2)(j+1)(j+2),{j,7,md}] Print["expressions for b[j] for j>7"] p3={};Do[p3=Union[p3,Solve[0==d[i]/.p3,b[i+1]][[1]]],{i,7,md}];Column[Expand[p3]] Print["differential equation for the nilpotent cone, n=4"] DR4=Factor[D[R[4]/.x[1]->0,{x[2],5}]/.x[2]->0/.inic]; DR4=Factor[D[DR4,{x[3],5}]/.x[3]->0/.inic]; DR4=Collect[D[DR4,{x[4],5}]/.x[4]->0/.inic,g[s],Factor]; Collect[DR4/144000,g[s]] Print["the sequence of relations, d[j] depends linearly on b[j-3]"] Do[d[j]=Factor[SeriesCoefficient[DR4/.g->gg,{s,0,j}]],{j,0,md}] Do[Print["d[",j,"]=",d[j]],{j,0,16}] Print["polynomial pattern 144000(j-12)(j-11)(j-10)(j-3)(j-2)(7j-43)"] Table[Coefficient[d[j],b[j-3]]==144000(j-12)(j-11)(j-10)(j-3)(j-2)(7j-43),{j,13,md}] Print["expressions for b[j] j>9"] p4={};Do[p4=Union[p4,Solve[0==d[i]/.p4,b[i-3]][[1]]],{i,13,md}]; Column[Expand[p4]] Print["combined relations"] diff=Factor[(Table[b[i],{i,10,13}]/.p3)-Table[b[i],{i,10,13}]/.p4/.p3]; Solve[diff=={0,0,0,0},Table[b[i],{i,5,7}]]