\\ jacalg5.gp \\ An algorithm for computing the Jacobian of a genus 1 \\ curve in degree 5 \\ Author: Tom Fisher \\ Web address: http://www.dpmms.cam.ac.uk/~taf1000 \\ Date: October 2001. \\ Written using pari/gp http://www.parigp-home.de \\ --------------------------------------------------------- \\ Let C/Q in P^4 be a smooth curve of genus 1 and degree 5, \\ and suppose that C is contained in no hyperplane. \\ Then C is defined by 5 quadrics q_0 ,..., q_4 ( in the \\ variables x0 ,..., x4 taken as co-ordinates on P^4 ). \\ We are interested in the case where C either does not \\ have a rational point, or is not known to have a rational \\ point. \\ We provide a routine jac5([q_0 ,..., q_4]) that computes \\ a minimal Weierstrass equation for the Jacobian of C expressed \\ in the form [a1,a2,a3,a4,a6]. \\ Our method is based on invariant theory, and does not require \\ any field extensions. The corresponding algorithms in degrees \\ 2, 3 and 4 are classical. See for example the recent paper of \\ S.Y. An, S.Y. Kim, D.C. Marshall, S.H. Marshall, W.G. McCallum \\ and A.R. Perlis, entitled "Jacobians of genus one curves". \\ In our case we are yet to find the covariants that describe \\ the map from C to its Jacobian. \\ To run our program first run gp and then type \r jacalg5.gp \\ The program will give a series of examples. \\ These should be commented out by anyone wishing to use \\ the routine jac5(..) directly. \\ Remarks \\ 1. We do not claim that this is a particularly efficient \\ implementation of our algorithm. We apologise to the authors \\ of pari/gp for the inexpert use of their programming language. \\ 2. If we choose 5 quadrics on P^4 at random, then they are \\ very unlikely to define a curve. The program will complain \\ accordingly. However if A is a 5 x 5 skew symmetric matrix, \\ whose entries are linear forms on P^4, then the 4 x 4 pfaffians \\ of A - computed using pfaffsubmax(..) - will be quadrics. \\ In general these define a smooth curve of genus 1. \\ 3. A paper explaining why our algorithm works is in preparation. \\ --------------------------------------------------------- \\ Global variables used: xx, mon, mons \\ Indeterminates used: x0, x1, x2, x3, x4, tt \\ Extracting coefficients from homogenous polynomials initialise_monomials(maxdeg)= { local(m,i,z); mon=vector(maxdeg,i,[]); m=vector(maxdeg); i=vector(maxdeg); z=1;i[1]=1; while(i[z]<=5, m[z]=if(z>1,m[z-1],vector(5)); m[z][i[z]]++; mon[z]=concat(mon[z],[m[z]]); z++; if(z>maxdeg,z--;i[z]++; while((i[z]>5)&&(z>1),z--;i[z]++), i[z]=i[z-1])); mons=vector(maxdeg,i, vector(length(mon[i]),j,prod(k=1,5,xx[k]^mon[i][j][k]))); } polycoeff(poly,deg)= { local(coeff); vector(length(mon[deg]),i, coeff=poly; for(j=1,5, coeff=polcoeff(coeff,mon[deg][i][j],xx[j])); coeff); } \\ Computing pfaffians matdelete(mat,d)= { local(mm,dd,m,c,z); mm=length(mat);dd=length(d); m=vector(mm);for(i=1,dd,m[d[i]]=1); c=vector(mm-dd);z=0; for(i=1,mm,if(m[i]==0,c[z++]=i)); matrix(mm-dd,mm-dd,i,j,mat[c[i],c[j]]); } pfaffian(mat)= { local(n); n=length(mat); if(n==0,1, if(n==1,0, sum(i=2,n, (-1)^i*mat[1,i]*pfaffian(matdelete(mat,[1,i]))))); } pfaffsubmax(mat)= vector(length(mat),i,(-1)^(i+1)*pfaffian(matdelete(mat,[i]))); \\ Computing syzygies quadtoskew(quads)= { local(quadmat,rankq,quadint,mat,mk,syzygies,row,skewmat,pf); quadmat=matrix(5,15); for(i=1,5,quadmat[i,]=polycoeff(quads[i],2)); rankq=matrank(quadmat); if(rankq<5,print("error: too few quadrics provided");break); quadint=vector(5,i,quads[i]/content(quads[i])); mat=matrix(25,35); for(i=1,5, for(j=1,5, mat[5*(i-1)+j,]=polycoeff(xx[i]*quadint[j],3))); mk=matkerint(mat~); if(length(mk)<5,print("error: too few syzygies");break); if(length(mk)>5,print("error: too many syzygies");break); syzygies=matrix(5,5,i,j, sum(k=1,5,mk[5*(k-1)+j,i]*xx[k])); syzygies=syzygies/content(syzygies); mat=matrix(25,175); for(i=1,5, for(j=1,5, for(k=1,5, row=polycoeff(syzygies[j,i]*quadint[k],3); for(l=1,35,mat[5*(j-1)+k,35*(i-1)+l]=row[l]))); mk=matkerint(mat~); if(length(mk)==1,break)); if(length(mk)!=1,print("error: problem with syzygies");break); skewmat=matrix(5,5,i,j,mk[5*(j-1)+i,1])*syzygies; if(skewmat+skewmat~!=0,print("error: failure of skew symmetry");break); skewmat=skewmat/content(skewmat); pf=pfaffsubmax(skewmat); mat=matrix(2,15); [skewmat,vector(5,i, mat[1,]=quadmat[i,]; mat[2,]=polycoeff(pf[i],2); mk=matker(mat~); if(length(mk)!=1,print("error: quadtoskew fails");break); -mk[2,1]/mk[1,1])]; } \\ Computing invariants invar5(skewmat)= { local(quads,jacmat,secvar,quartics,mat,quadprod,mk,endmat,auxquads, mat1,mat2,mat3,row1,row2,Fpoly,c4,c6); kill(tt); if(skewmat+skewmat~!=0, print("error: skewmat is not skew symmetric");break); quads=pfaffsubmax(skewmat); jacmat=matrix(5,5,i,j,deriv(quads[i],xx[j])); secvar=matdet(jacmat); quartics=vector(5,i,deriv(secvar,xx[i])); mat=matrix(20,70); for(i=1,15, quadprod=prod(j=1,5,quads[j]^(mon[2][i][j])); mat[i,]=polycoeff(quadprod,4)); for(i=1,5, mat[15+i,]=polycoeff(quartics[i],4)); mk=matkerint(mat~); if(length(mk)<5,print("error: too few auxiliary quadrics");break); if(length(mk)>5,print("error: too many auxiliary quadrics");break); endmat=matrix(5,5,i,j,mk[15+i,j]); if(matdet(endmat)==0, print("error: problem with auxiliary quadrics");break); mk=-mk*endmat^(-1); auxquads=vector(5,i,sum(j=1,15,mk[j,i]*mons[2][j])); mat1=sum(i=1,5,xx[i]*matrix(5,5,j,k,polcoeff(jacmat[i,j],1,xx[k]))); mat2=matrix(5,5,i,j,deriv(auxquads[i],xx[j])); mat3=sum(i=1,5,xx[i]*matrix(5,5,j,k,polcoeff(skewmat[i,k],1,xx[j]))); row1=polycoeff(matdet(mat1),5); row2=polycoeff(matdet(mat2+tt*mat3),5); Fpoly=sum(i=1,126,row1[i]*row2[i]*prod(j=1,5,mon[5][i][j]!)); c4=polcoeff(Fpoly,4)/40; c6=-polcoeff(Fpoly,2)/320; if(polcoeff(Fpoly,0)-128*c4^2!=0, print("error: problem with Fpoly");break); [c4,c6]; } \\ Computing the Jacobian jac5(quads)= { local(skewdata,skewmat,matconst,invariants,c4,c6,ell,egr); skewdata=quadtoskew(quads); if(skewdata==0,print("error: quadrics are illegal");break); skewmat=skewdata[1]; matconst=matdiagonal(skewdata[2]); if(quads-pfaffsubmax(skewmat)*matconst!=0, print("error: quadtoskew gives incorrect answer")); invariants=invar5(skewmat); if(length(invariants)==0,print("error: invar5 fails");break); c4=invariants[1]; c6=invariants[2]; if(c4^3-c6^2==0,print("error: curve is singular");break); ell=ellinit([0,0,0,-27*c4,-54*c6]); egr=ellglobalred(ell); vector(5,i,ellchangecurve(ell,egr[2])[i]); } \\ Routines to help with testing eqnproj4(e)= { [x0*x3-x1^2,x0*x4-x1*x2, x2^2+e.a1*x1*x2+e.a3*x0*x2-x1*x3-e.a2*x0*x3-e.a4*x0*x1-e.a6*x0^2, x1*x4-x2*x3, x2*x4+e.a1*x2*x3+e.a3*x0*x4-x3^2-e.a2*x1*x3-e.a4*x0*x3-e.a6*x0*x1]; } elldisc(e)= { -432*e[5]^2 + ((72*e[1]^2 + 288*e[2])*e[4] + (-e[1]^6 - 12*e[2]*e[1]^4 + 36*e[3]*e[1]^3 - 48*e[2]^2*e[1]^2 + 144*e[3]*e[2]*e[1] + (-64*e[2]^3 - 216*e[3]^2)))*e[5] + (-64*e[4]^3 + (e[1]^4 + 8*e[2]*e[1]^2 - 96*e[3]*e[1] + 16*e[2]^2)*e[4]^2 + (e[3]*e[1]^5 + 8*e[3]*e[2]*e[1]^3 - 30*e[3]^2*e[1]^2 + 16*e[3]*e[2]^2*e[1] + 72*e[3]^2*e[2])*e[4] + (-e[3]^2*e[2]*e[1]^4 + e[3]^3*e[1]^3 - 8*e[3]^2*e[2]^2*e[1]^2 + 36*e[3]^3*e[2]*e[1] + (-16*e[3]^2*e[2]^3 - 27*e[3]^4))); } clambda(d)=[1-d,-d,-d,-5*d*(d^2+2*d-1),-d*(d^4+10*d^3-5*d^2+15*d-1)]; tskewmat(tau)= { local(a,b,r,s); a=[0,1,0,0,-1]; b=[0,0,1,-1,0]; matrix(5,5,i,j, r=lift(Mod(i-j,5))+1; s=lift(Mod(i+j-1,5))+1; (a[r]*tau[s]+b[r])*xx[s]); } randomec(size)= { local(disc,vec); disc=0; while(disc==0, vec=vector(5,i,random(2*size)-size); disc=elldisc(vec)); vec; } randommat(size)= { local(det,mat); det=0; while(det==0, mat=matrix(5,5,i,j,(random(2*size)-size)); det=matdet(mat)); mat; } print_example(torsor,jacobian)= { local(ell,jac,egr,elljac,cond); if(length(jacobian),ell=ellinit(jacobian)); if(length(torsor), print("\nLet C be the curve in P^4 defined by quadrics\n"), print("\nThe elliptic curve C = ",jacobian," embeds in P^4\n"); torsor=eqnproj4(ell)); for(i=1,5,print("q_"i-1" = "torsor[i])); jac=jac5(torsor); if(jac==0,print("\nWe find that C is singular\n"), print("\nThen C has Jacobian E = ",jac); if(length(jacobian), egr=ellglobalred(ell); ell=ellchangecurve(ell,egr[2]); if(jac==vector(5,i,ell[i]), print1("This agrees"), print1("This does not agree")); print(" with the Jacobian computed via another method")); elljac=ellinit(jac); cond=ellglobalred(elljac)[1]; print("E is an elliptic curve with conductor "cond"\n")); } \\ Examples { xx=[x1,x2,x3,x4,x0]; initialise_monomials(5); print("\nEXAMPLE 1 An elliptic curve of conductor 11"); torsor=[x0^2+x1*x4-x2*x3,x1^2+x2*x0-x3*x4,x2^2+x3*x1-x4*x0, x3^2+x4*x2-x0*x1,x4^2+x0*x3-x1*x2]; jacobian=clambda(1); print_example(torsor,jacobian); print("EXAMPLE 2 A randomly chosen elliptic curve"); jacobian=randomec(10); print_example([],jacobian); print("EXAMPLE 3 A torsor with a mu_5 action"); lambda=0; while(lambda==0, tau=vector(5,i,random(20)-10); lambda=prod(i=1,5,tau[i])); torsor=pfaffsubmax(tskewmat(tau)); jacobian=clambda(lambda); print_example(torsor,jacobian); print("EXAMPLE 4 The last example after a change of co-ordinates"); cob=randommat(10); yy=[y1,y2,y3,y4,y0]; zz=xx*cob; for(i=1,5,torsor=subst(torsor,xx[i],yy[i])); for(i=1,5,torsor=subst(torsor,yy[i],zz[i])); print_example(torsor,jacobian); print("EXAMPLE 5 An element of III[5] found by T. Fisher"); torsor=[11*x0^2-x1^2+5*x2^2+x3^2-5*x4^2, x1^2+10*x1*x2+5*x2^2+2*x0*x3-x1*x3-5*x2*x3-5*x1*x4-5*x2*x4, x1^2+2*x1*x2+5*x2^2+x1*x3+x2*x3+2*x0*x4+x1*x4+5*x2*x4, 11*x0*x1+55*x0*x2+2*x1*x3+2*x3^2-10*x2*x4+10*x4^2, 11*x0*x1+11*x0*x2-2*x2*x3+2*x1*x4-4*x3*x4]; print_example(torsor,[]); print("EXAMPLE 6 The last example disguised"); cob=randommat(10); torsor=torsor*cob; print_example(torsor,[]); print("EXAMPLE 7 An element of III[5] found by C. Wuthrich"); torsor=[-3*x0^2-x0*x4+x1*x3+x2^2, 17*x0^2-10*x0*x2+7*x0*x4-7*x1*x3-4*x1*x4+4*x2*x3, 215*x0^2-16*x0*x1-80*x0*x2+16*x0*x3+81*x0*x4-49*x1*x3-28*x1*x4 -16*x2*x4-16*x3^2, 60*x0^2+48*x0*x1-34*x0*x2-24*x0*x3+20*x0*x4-8*x1^2-5*x1*x2 -12*x1*x3+16*x1*x4-14*x2*x4-8*x3*x4, 18*x0^2+9*x0*x2-4*x0*x3-4*x0*x4-4*x1*x2-8*x1*x3-6*x1*x4+8*x2*x4-4*x4^2]; print_example(torsor,[]); } /* Sample output ? \rjacalg5.gp EXAMPLE 1 An elliptic curve of conductor 11 Let C be the curve in P^4 defined by quadrics q_0 = x4*x1 + (-x3*x2 + x0^2) q_1 = x1^2 + (x0*x2 - x4*x3) q_2 = x3*x1 + (x2^2 - x0*x4) q_3 = -x0*x1 + (x4*x2 + x3^2) q_4 = -x2*x1 + (x0*x3 + x4^2) Then C has Jacobian E = [0, -1, 1, -10, -20] This agrees with the Jacobian computed via another method E is an elliptic curve with conductor 11 EXAMPLE 2 A randomly chosen elliptic curve The elliptic curve C = [-7, 5, 2, 0, 7] embeds in P^4 q_0 = -x1^2 + x0*x3 q_1 = -x2*x1 + x0*x4 q_2 = (-7*x2 - x3)*x1 + (x2^2 + 2*x0*x2 + (-5*x0*x3 - 7*x0^2)) q_3 = x4*x1 - x3*x2 q_4 = (-5*x3 - 7*x0)*x1 + ((-7*x3 + x4)*x2 + (-x3^2 + 2*x0*x4)) Then C has Jacobian E = [1, -1, 0, -106, 455] This agrees with the Jacobian computed via another method E is an elliptic curve with conductor 2678687 EXAMPLE 3 A torsor with a mu_5 action Let C be the curve in P^4 defined by quadrics q_0 = -x3*x1 + (-6*x2^2 + x0*x4) q_1 = -24*x2*x1 + (-x0*x3 + x4^2) q_2 = 4*x1^2 + (-x0*x2 + 7*x4*x3) q_3 = 4*x0*x1 + (-x4*x2 + 7*x3^2) q_4 = -x4*x1 + (-42*x3*x2 + x0^2) Then C has Jacobian E = [1, 0, 0, -63053, -4104903] This agrees with the Jacobian computed via another method E is an elliptic curve with conductor 221550 EXAMPLE 4 The last example after a change of co-ordinates Let C be the curve in P^4 defined by quadrics q_0 = -493*x1^2 + (842*x2 + (395*x3 + (978*x4 + 150*x0)))*x1 + (-336*x2^2 + (-28 5*x3 + (-631*x4 - 132*x0))*x2 + (-59*x3^2 + (-268*x4 - 62*x0)*x3 + (-573*x4^2 - 70*x0*x4 - 6*x0^2))) q_1 = 280*x1^2 + (-865*x2 + (-1197*x3 + (-2168*x4 - 1480*x0)))*x1 + (616*x2^2 + (1197*x3 + (1999*x4 + 1220*x0))*x2 + (405*x3^2 + (1631*x4 + 652*x0)*x3 + (2009*x 4^2 + 1452*x0*x4 + 244*x0^2))) q_2 = -388*x1^2 + (-154*x2 + (-64*x3 + (245*x4 + 442*x0)))*x1 + (442*x2^2 + (623 *x3 + (-249*x4 + 643*x0))*x2 + (255*x3^2 + (52*x4 + 525*x0)*x3 + (399*x4^2 - 66* x0*x4 + 144*x0^2))) q_3 = 271*x1^2 + (769*x2 + (441*x3 + (-609*x4 + 98*x0)))*x1 + (402*x2^2 + (576*x 3 + (-500*x4 + 139*x0))*x2 + (197*x3^2 + (-408*x4 + 85*x0)*x3 + (82*x4^2 - 279*x 0*x4 - 10*x0^2))) q_4 = 2654*x1^2 + (557*x2 + (585*x3 + (-5361*x4 - 352*x0)))*x1 + (-1956*x2^2 + ( -1918*x3 + (-678*x4 - 222*x0))*x2 + (-454*x3^2 + (-680*x4 - 88*x0)*x3 + (2683*x4 ^2 + 366*x0*x4 + 60*x0^2))) Then C has Jacobian E = [1, 0, 0, -63053, -4104903] This agrees with the Jacobian computed via another method E is an elliptic curve with conductor 221550 EXAMPLE 5 An element of III[5] found by T. Fisher Let C be the curve in P^4 defined by quadrics q_0 = -x1^2 + (5*x2^2 + (x3^2 + (-5*x4^2 + 11*x0^2))) q_1 = x1^2 + (10*x2 + (-x3 - 5*x4))*x1 + (5*x2^2 + (-5*x3 - 5*x4)*x2 + 2*x0*x3) q_2 = x1^2 + (2*x2 + (x3 + x4))*x1 + (5*x2^2 + (x3 + 5*x4)*x2 + 2*x0*x4) q_3 = (2*x3 + 11*x0)*x1 + ((-10*x4 + 55*x0)*x2 + (2*x3^2 + 10*x4^2)) q_4 = (2*x4 + 11*x0)*x1 + ((-2*x3 + 11*x0)*x2 - 4*x4*x3) Then C has Jacobian E = [0, 1, 1, -195508, -33338481] E is an elliptic curve with conductor 275 EXAMPLE 6 The last example disguised Let C be the curve in P^4 defined by quadrics q_0 = 9*x1^2 + (-34*x2 + (-9*x3 + (23*x4 - 88*x0)))*x1 + (-55*x2^2 + (23*x3 + (1 15*x4 - 440*x0))*x2 + (-26*x3^2 - 8*x0*x3 + (-30*x4^2 + 6*x0*x4 - 110*x0^2))) q_1 = -20*x1^2 + (-38*x2 + (-9*x3 + (-3*x4 - 33*x0)))*x1 + (-10*x2^2 + (5*x3 + ( -25*x4 - 77*x0))*x2 + (7*x3^2 + (8*x4 - 4*x0)*x3 + (-55*x4^2 - 18*x0*x4 + 99*x0^ 2))) q_2 = -3*x1^2 + (-20*x2 + (-30*x3 + (4*x4 - 33*x0)))*x1 + (-85*x2^2 + (-24*x3 + (50*x4 - 473*x0))*x2 + (-27*x3^2 - 28*x4*x3 + (-65*x4^2 - 20*x0*x4 - 77*x0^2))) q_3 = -11*x1^2 + (-64*x2 + (16*x3 + (42*x4 + 55*x0)))*x1 + (15*x2^2 + (34*x3 + ( 20*x4 + 187*x0))*x2 + (13*x3^2 + (-8*x4 - 14*x0)*x3 + (-5*x4^2 + 6*x0*x4 + 77*x0 ^2))) q_4 = 17*x1^2 + (54*x2 + (-15*x3 + (-19*x4 - 132*x0)))*x1 + (25*x2^2 + (-7*x3 + (105*x4 - 528*x0))*x2 + (-24*x3^2 + (12*x4 + 8*x0)*x3 + (-60*x4^2 + 14*x0*x4 - 6 6*x0^2))) Then C has Jacobian E = [0, 1, 1, -195508, -33338481] E is an elliptic curve with conductor 275 EXAMPLE 7 An element of III[5] found by C. Wuthrich Let C be the curve in P^4 defined by quadrics q_0 = x3*x1 + (x2^2 + (-x0*x4 - 3*x0^2)) q_1 = (-7*x3 - 4*x4)*x1 + ((4*x3 - 10*x0)*x2 + (7*x0*x4 + 17*x0^2)) q_2 = (-49*x3 + (-28*x4 - 16*x0))*x1 + ((-16*x4 - 80*x0)*x2 + (-16*x3^2 + 16*x0* x3 + (81*x0*x4 + 215*x0^2))) q_3 = -8*x1^2 + (-5*x2 + (-12*x3 + (16*x4 + 48*x0)))*x1 + ((-14*x4 - 34*x0)*x2 + ((-8*x4 - 24*x0)*x3 + (20*x0*x4 + 60*x0^2))) q_4 = (-4*x2 + (-8*x3 - 6*x4))*x1 + ((8*x4 + 9*x0)*x2 + (-4*x0*x3 + (-4*x4^2 - 4 *x0*x4 + 18*x0^2))) Then C has Jacobian E = [1, 1, 1, -3146, 39049] E is an elliptic curve with conductor 1289106508910 */