# In the following, we use the example: # y^2 = x*(x-1)*(x-e1)*(x+e1)*(x-e1^2)*(x-e1^2-1) # with e1 = 2, that is: y^2 = x*(x-1)*(x-2)*(x+2)*(x-4)*(x-5) # which has [ infty+ - infty- ] in 2*J(Q), which is [ 0, 0, ?, 1] on Kummer. # Since f5^2 = 4*f4*f6, the Kummer equation is cubic in k3, # and k1=k2=0 has solns in k3 (giving identity or [ infty+ - infty- ]) # which all lift to members of 2*J(Q). # So, if v1,v2 are close to 0 at 2,3,5,7, then take the cubic extn # given by the cubic in v3. # v2^2-4*v1*v3-160*v1^2*v2+464*v1^2*v3-40*v1*v2*v3-100*v1*v3^2 # +20*v2*v3^2-4*v3^3+6400*v1^4-3200*v1^3*v3-8000*v1^2*v2*v3 # +10400*v1^2*v3^2+3200*v1*v2^2*v3-4320*v1*v2*v3^2+400*v1*v3^3 # -320*v2^3*v3+464*v2^2*v3^2-80*v2*v3^3 # k2^2-4*k1*k3-160*k1^2*k2+464*k1^2*k3-40*k1*k2*k3-100*k1*k3^2 # +20*k2*k3^2-4*k3^3+6400*k1^4-3200*k1^3*k3-8000*k1^2*k2*k3 # +10400*k1^2*k3^2+3200*k1*k2^2*k3-4320*k1*k2*k3^2+400*k1*k3^3 # -320*k2^3*k3+464*k2^2*k3^2-80*k2*k3^3 # # General thoughts: if I replace k4 with k1k4/k1 (for F6=0), # then that might lift to Jacobian, but quite hard to get # this cubic in any specific variable. # Also, will it lift better if the desingularised Kummer is used?? # # Furthermore, it is fairly easy to express the duplication # law on the Kummer here as M3 tau M2 tau M1, where # M1,M2,M3 are matrices and tau is the coordinate-squared # map, so maybe a Sato-style arguement can give quite # good densities. # # ##################################################################### # The following checks that composition of isogeny and dual gives dupl. # Article corrections: # (1) Delta should be replaced with -Delta in the [1,1] entry # of the second matrix of equation (13). # (2) The first occurence of hk^2 in equation (14) (which is in # the first term of the [1,2] entry of the first matrix) # should be replaced hj^2, so that [1,2] entry should read: # < 4 f_i f_k g_k h_i h_j^2 + 2 f_i^2 g_j h_j h_k^2 > # (3) In the second line of the proof of Example 4.2, # Delta = -2 should be: Delta = 1. # (4) For the matrix W2 in Example 4.2, the [3,1] entry: # -1 - \sqrt{3} + \sqrt{6} should be: -1 + \sqrt{3} - \sqrt{6} interface(quiet,quiet=true): interface(prettyprint,prettyprint=false): with(linalg): ####### compl := proc(expr): # performs = sum epsilon(i,j,k)*expr(i,j,k), # where expr is in terms of i,j,k and epsilon(i,j,k) is the sign of # the permutation 1 --> i, 2 --> j, 3 --> j. Note that we everywhere # must use ffi instead of fi, since fi is reserved in Maple. subs({ffi=f1,fj=f2,fk=f3,gi=g1,gj=g2,gk=g3,hi=h1,hj=h2,hk=h3}, expr) + subs({ffi=f2,fj=f3,fk=f1,gi=g2,gj=g3,gk=g1,hi=h2,hj=h3,hk=h1}, expr) + subs({ffi=f3,fj=f1,fk=f2,gi=g3,gj=g1,gk=g2,hi=h3,hj=h1,hk=h2}, expr) - subs({ffi=f2,fj=f1,fk=f3,gi=g2,gj=g1,gk=g3,hi=h2,hj=h1,hk=h3}, expr) - subs({ffi=f3,fj=f2,fk=f1,gi=g3,gj=g2,gk=g1,hi=h3,hj=h2,hk=h1}, expr) - subs({ffi=f1,fj=f3,fk=f2,gi=g1,gj=g3,gk=g2,hi=h1,hj=h3,hk=h2}, expr): end: # The following are some expressions we'll use later as matrix entries. # These will be the [1,2],[1,3],[1,4] entries for the right # hand matrix in equation (13). entry12 := compl( gi*hi*(fk^2*hj^2 + fj*gk^2*hj) ): entry13 := compl( ffi*hi*(fk^2*hj^2 + fj*gj*gk*hk) ): entry14 := compl( ffi*gi*(fk*gj^2*hk + fk^2*hj^2) ): # These will be the [1,2],[1,3],[1,4] entries for the left # hand matrix in equation (14). # Note: the following entry gives one of the mistakes in the article; # The article had: 4*ffi*fk*gk*hi*hk^2 + 2*ffi^2*gj*hj*hk^2 # which should have been: 4*ffi*fk*gk*hi*hj^2 + 2*ffi^2*gj*hj*hk^2 # (that is, the first instance of hk^2 should have been hj^2). Entry12 := compl( 4*ffi*fk*gk*hi*hj^2 + 2*ffi^2*gj*hj*hk^2): Entry13 := compl( 2*ffi*fk^2*hi*hj^2 ): Entry14 := compl( 4*ffi*fk^2*gj*hi*hj + 2*ffi*fk^2*gi*hj^2 ): # We shall also later want to refer to these resultants. # Note that it is better to find here the general expressions # for the resultants, and specialise afterwards (rather than computing # the resultant after specialising) to avoid errors when some f_i=0. res12 := resultant(f1*x^2 + g1*x + h1, f2*x^2 + g2*x + h2, x): res13 := resultant(f1*x^2 + g1*x + h1, f3*x^2 + g3*x + h3, x): res23 := resultant(f2*x^2 + g2*x + h2, f3*x^2 + g3*x + h3, x): # The following give the coefficients for the curve: # y^2 = (f1*x^2 + g1*x + h1)*(f2*x^2 + g2*x + h2)*(f3*x^2 + g3*x + h3) # These numerical coefficients can be changed as we please, and we # can check each time that check0,check1,check2,check3 (later in # this file) are all constant, which confirms consistenct with duplication. # x*(x-1)*(x-2)*(x+2)*(x-4)*(x-5) f1 := 1: g1 := -1: h1 := 0: f2 := 1: g2 := 0: h2 := -4: f3 := 1: g3 := -9: h3 := 20: # The following are the 3 quadratics. q1 := f1*x^2 + g1*x + h1: q2 := f2*x^2 + g2*x + h2: q3 := f3*x^2 + g3*x + h3: sext := expand(q1*q2*q3): # The following give the coefficients of the sectic. F6 := coeff(sext,x^6): F5 := coeff(sext,x^5): F4 := coeff(sext,x^4): F3 := coeff(sext,x^3): F2 := coeff(sext,x^2): F1 := coeff(sext,x^1): F0 := subs(x=0,sext): # The following will be used in a moment for the defining equation. jj := 2*v1^3*F0 + v1^2*v2*F1 + 2*v1^2*v3*F2 + v1*v2*v3*F3 + 2*v1*v3^2*F4 + v2*v3^2*F5 + 2*v3^3*F6: kk := 4*v1^4*F0*F2 - v1^4*F1^2 + 4*v1^3*v2*F0*F3 + 2*v1^3*v3*F1*F3 + 4*v1^2*v2^2*F0*F4 - 4*v1^2*v2*v3*F0*F5 + 4*v1^2*v2*v3*F1*F4 + 4*v1^2*v3^2*F0*F6 - 2*v1^2*v3^2*F1*F5 + 4*v1^2*v3^2*F2*F4 - v1^2*v3^2*F3^2 + 4*v1*v2^3*F0*F5 - 8*v1*v2^2*v3*F0*F6 + 4*v1*v2^2*v3*F1*F5 - 4*v1*v2*v3^2*F1*F6 + 4*v1*v2*v3^2*F2*F5 + 2*v1*v3^3*F3*F5 + 4*v2^4*F0*F6 + 4*v2^3*v3*F1*F6 + 4*v2^2*v3^2*F2*F6 + 4*v2*v3^3*F3*F6 + 4*v3^4*F4*F6 - v3^4*F5^2: # The following is the defining equation of the Kummer surface. # Note: v0,v1,v2,v3 are as in the article; they correspond # to the more usual k4,k1,k2,k3. quart1 := ( v2^2 - 4*v1*v3 )*v0^2 - 2*jj*v0 - kk: quart1 := expand(quart1): k1k4 := -F2*k1^2-F3*k1*k2-F4*k2^2-3*F5*k2*k3-F5*k2^3+4*F5*k2*k3+a9^2; # The following gives the duplication law on the Kummer surface. # Here, C0,C1,C2,C3 give the coordinates of the doubled point. C0 := 16*v1^4*F0^2*F2*F6-16*v1^4*F0^2*F3*F5-4*v1^4*F0*F1^2*F6+16*v1^4 *F0*F2^2*F4-4*v1^4*F0*F2*F3^2-4*v1^4*F1^2*F2*F4-8*v1^3*v0*F0*F3 ^2-8*v1^3*v0*F1^2*F4+8*v1^2*v0^2*F0*F4-2*v1^2*v0^2*F1*F3-4*v2^4 *F0*F2*F5^2-4*v2^4*F1^2*F4*F6+8*v2^2*v0^2*F0*F6-8*v1^3*v2*F1^3* F6+16*v1^2*v2^2*F0^2*F5^2+16*v3^4*F0*F4*F6^2-4*v3^4*F0*F5^2*F6- 16*v3^4*F1*F3*F6^2+16*v3^4*F2*F4^2*F6-4*v3^4*F2*F4*F5^2-4*v3^4* F3^2*F4*F6+8*v0^2*v3^2*F2*F6-2*v0^2*v3^2*F3*F5-8*v0*v3^3*F2*F5^ 2-8*v0*v3^3*F3^2*F6+32*v1^3*v3*F0^2*F5^2+64*v1^2*v3^2*F0^2*F6^2 +12*v1^2*v3^2*F1^2*F5^2+32*v1*v3^3*F1^2*F6^2+16*v2^2*v3^2*F1^2* F6^2-8*v2*v3^3*F0*F5^3+v0^4+v1^4*F1^2*F3^2+16*v1^4*F0^2*F4^2-2* v1^4*F1^3*F5+v2^4*F1^2*F5^2+16*v2^4*F0^2*F6^2+8*v1^4*F0*F1*F2* F5-8*v1^4*F0*F1*F3*F4+32*v1^3*v0*F0*F2*F4+16*v2^4*F0*F2*F4*F6+ v3^4*F3^2*F5^2-2*v3^4*F1*F5^3+16*v3^4*F2^2*F6^2+16*v2^3*v0*F0* F3*F6-32*v1^3*v2*F0^2*F3*F6+32*v1^3*v2*F0^2*F4*F5+32*v1^3*v2*F0 *F1*F2*F6-16*v1^3*v2*F0*F1*F3*F5+32*v1^3*v2*F0*F2^2*F5-8*v1^3* v2*F1^2*F2*F5+32*v1^2*v2^2*F0^2*F4*F6-24*v1^2*v2^2*F0*F1*F3*F6+ 64*v1^2*v2^2*F0*F2^2*F6+8*v1^2*v2^2*F0*F2*F3*F5-16*v1^2*v2^2*F1 ^2*F2*F6-2*v1^2*v2^2*F1^2*F3*F5+32*v1*v2^3*F0^2*F5*F6+32*v1*v2^ 3*F0*F2*F3*F6-8*v1*v2^3*F1^2*F3*F6+48*v1^2*v2*v0*F0*F2*F5-12*v1 ^2*v2*v0*F1^2*F5+64*v1*v2^2*v0*F0*F2*F6+8*v1*v2^2*v0*F0*F3*F5- 16*v1*v2^2*v0*F1^2*F6+8*v1*v2*v0^2*F0*F5+8*v3^4*F1*F4*F5*F6-8* v3^4*F2*F3*F5*F6+32*v0*v3^3*F2*F4*F6-64*v1^3*v3*F0^2*F4*F6+16* v1^3*v3*F0*F1*F3*F6+16*v1^3*v3*F0*F2*F3*F5-4*v1^3*v3*F1^2*F3*F5 +96*v1^2*v3^2*F0*F2*F4*F6-32*v1^2*v3^2*F0*F2*F5^2-16*v1^2*v3^2* F0*F3^2*F6+8*v1^2*v3^2*F0*F3*F4*F5-32*v1^2*v3^2*F1^2*F4*F6+8*v1 ^2*v3^2*F1*F2*F3*F6-64*v1*v3^3*F0*F2*F6^2+16*v1*v3^3*F0*F3*F5* F6+16*v1*v3^3*F1*F3*F4*F6-4*v1*v3^3*F1*F3*F5^2+32*v1^2*v0*v3*F0 *F2*F6+16*v1^2*v0*v3*F0*F3*F5-8*v1^2*v0*v3*F1^2*F6+16*v1*v0^2* v3*F0*F6+32*v1*v0*v3^2*F0*F4*F6-8*v1*v0*v3^2*F0*F5^2+16*v1*v0* v3^2*F1*F3*F6+32*v2^3*v3*F0*F1*F6^2+32*v2^3*v3*F0*F3*F4*F6-8*v2 ^3*v3*F0*F3*F5^2+32*v2^2*v3^2*F0*F2*F6^2-24*v2^2*v3^2*F0*F3*F5* F6+64*v2^2*v3^2*F0*F4^2*F6-16*v2^2*v3^2*F0*F4*F5^2+8*v2^2*v3^2* F1*F3*F4*F6-2*v2^2*v3^2*F1*F3*F5^2-32*v2*v3^3*F0*F3*F6^2+32*v2* v3^3*F0*F4*F5*F6+32*v2*v3^3*F1*F2*F6^2-16*v2*v3^3*F1*F3*F5*F6+ 32*v2*v3^3*F1*F4^2*F6-8*v2*v3^3*F1*F4*F5^2+64*v2^2*v0*v3*F0*F4* F6-16*v2^2*v0*v3*F0*F5^2+8*v2^2*v0*v3*F1*F3*F6+8*v2*v0^2*v3*F1* F6+48*v2*v0*v3^2*F1*F4*F6-12*v2*v0*v3^2*F1*F5^2+64*v1^2*v2*v3* F0^2*F5*F6-32*v1^2*v2*v3*F0*F1*F4*F6+16*v1^2*v2*v3*F0*F1*F5^2+ 64*v1^2*v2*v3*F0*F2*F3*F6+8*v1^2*v2*v3*F0*F3^2*F5-8*v1^2*v2*v3* F1^2*F3*F6+64*v1*v2^2*v3*F0^2*F6^2+32*v1*v2^2*v3*F0*F1*F5*F6+48 *v1*v2^2*v3*F0*F3^2*F6+64*v1*v2*v3^2*F0*F1*F6^2-32*v1*v2*v3^2* F0*F2*F5*F6+64*v1*v2*v3^2*F0*F3*F4*F6-8*v1*v2*v3^2*F0*F3*F5^2+ 16*v1*v2*v3^2*F1^2*F5*F6+8*v1*v2*v3^2*F1*F3^2*F6+80*v1*v2*v0*v3 *F0*F3*F6+4*v1*v2*v0*v3*F1*F3*F5: C1 := 4*v1*v0^3-16*v1^4*F0*F2*F4+4*v1^3*v0*F1*F3-16*v1^3*v0*F0*F4-16* v2^4*F0*F4*F6-8*v2^3*v0*F1*F6+4*v1^4*F0*F3^2+4*v1^4*F1^2*F4-16* v1^4*F0^2*F6+4*v1^2*v0^2*F2+4*v2^4*F0*F5^2+4*v3^4*F4*F5^2-16*v3 ^4*F2*F6^2-16*v3^4*F4^2*F6-12*v0^2*v3^2*F6+8*v0*v3^3*F5^2+8*v1^ 3*v2*F1^2*F5+12*v1^2*v2^2*F1^2*F6+8*v3^4*F3*F5*F6-32*v0*v3^3*F4 *F6-16*v1^3*v3*F1^2*F6+16*v1^2*v3^2*F0*F5^2-16*v1^2*v3^2*F2^2* F6+32*v1*v3^3*F0*F6^2-8*v1*v3^3*F3^2*F6+4*v2^3*v3*F1*F5^2+4*v2^ 2*v3^2*F2*F5^2+4*v2*v3^3*F3*F5^2-48*v2^2*v3^2*F0*F6^2-32*v2*v3^ 3*F1*F6^2-4*v2*v0^2*v3*F5-16*v1^3*v2*F0*F1*F6-32*v1^3*v2*F0*F2* F5-64*v1^2*v2^2*F0*F2*F6-8*v1^2*v2^2*F0*F3*F5-32*v1*v2^3*F0*F3* F6-4*v1*v2^2*v0*F1*F5-32*v1^2*v2*v0*F0*F5-48*v1*v2^2*v0*F0*F6+ 32*v1^3*v3*F0*F2*F6-16*v1^3*v3*F0*F3*F5-48*v1^2*v3^2*F0*F4*F6+ 24*v1^2*v3^2*F1*F3*F6-8*v1^2*v3^2*F1*F4*F5-16*v1*v3^3*F1*F5*F6- 4*v1*v0*v3^2*F3*F5-8*v1^2*v0*v3*F1*F5-16*v1*v0*v3^2*F2*F6-16*v2 ^3*v3*F0*F5*F6-16*v2^3*v3*F1*F4*F6-8*v2^2*v3^2*F1*F5*F6-16*v2^2 *v3^2*F2*F4*F6-16*v2*v3^3*F3*F4*F6-16*v2^2*v0*v3*F2*F6-24*v2*v0 *v3^2*F3*F6-4*v1^2*v2*v3*F1*F3*F5-16*v1^2*v2*v3*F0*F4*F5-16*v1^ 2*v2*v3*F1*F2*F6-16*v1*v2^2*v3*F0*F5^2-24*v1*v2^2*v3*F1*F3*F6- 16*v1*v2*v3^2*F0*F5*F6-8*v1*v2*v3^2*F1*F5^2-16*v1*v2*v3^2*F2*F3 *F6-24*v1*v2*v0*v3*F1*F6-8*v1*v2*v0*v3*F2*F5: C2 := 4*v2*v0^3-4*v1^4*F0*F2*F3+4*v1^3*v0*F0*F3-4*v2^4*F0*F3*F6+4*v2^ 3*v0*F1*F5+32*v1^3*v2*F0^2*F6-4*v1^3*v2*F0*F3^2+4*v1^2*v2^2*F1^ 2*F5+8*v1*v2^3*F1^2*F6+8*v1*v2*v0^2*F2-4*v3^4*F3*F4*F6+4*v0*v3^ 3*F3*F6+16*v1^3*v3*F1^2*F5-6*v1^3*v3*F1*F3^2+16*v1^2*v3^2*F1*F4 ^2+16*v1^2*v3^2*F2^2*F5+16*v1*v3^3*F1*F5^2-6*v1*v3^3*F3^2*F5-8* v1*v0^2*v3*F3+8*v2^3*v3*F0*F5^2+4*v2^2*v3^2*F1*F5^2+32*v2*v3^3* F0*F6^2-4*v2*v3^3*F3^2*F6+8*v2*v0^2*v3*F4+v1^4*F1^2*F3+16*v1^4* F0^2*F5+4*v1^2*v0^2*F1+5*v2^2*v0^2*F3+v3^4*F3*F5^2+16*v3^4*F1* F6^2+4*v0^2*v3^2*F5+5*v1^2*v3^2*F3^3+16*v1^3*v2*F0*F1*F5+32*v1^ 2*v2^2*F0*F1*F6-4*v1^2*v2^2*F0*F3*F4-4*v1*v2^3*F0*F3*F5+16*v1^2 *v2*v0*F0*F4+2*v1^2*v2*v0*F1*F3+8*v1*v2^2*v0*F0*F5+8*v1*v2^2*v0 *F1*F4-32*v1^3*v3*F0*F2*F5+16*v1^3*v3*F0*F3*F4-20*v1^2*v3^2*F0* F3*F6-14*v1^2*v3^2*F1*F3*F5-20*v1^2*v3^2*F2*F3*F4-32*v1*v3^3*F1 *F4*F6+16*v1*v3^3*F2*F3*F6-16*v1^2*v0*v3*F0*F5+16*v1^2*v0*v3*F1 *F4-12*v1^2*v0*v3*F2*F3-16*v1*v0*v3^2*F1*F6+16*v1*v0*v3^2*F2*F5 -12*v1*v0*v3^2*F3*F4-4*v2^3*v3*F1*F3*F6+32*v2^2*v3^2*F0*F5*F6-4 *v2^2*v3^2*F2*F3*F6+16*v2*v3^3*F1*F5*F6+8*v2^2*v0*v3*F1*F6+8*v2 ^2*v0*v3*F2*F5+16*v2*v0*v3^2*F2*F6+2*v2*v0*v3^2*F3*F5-64*v1^2* v2*v3*F0*F2*F6-20*v1^2*v2*v3*F0*F3*F5+32*v1^2*v2*v3*F0*F4^2+32* v1^2*v2*v3*F1^2*F6+16*v1^2*v2*v3*F1*F2*F5-12*v1^2*v2*v3*F1*F3* F4-56*v1*v2^2*v3*F0*F3*F6+32*v1*v2^2*v3*F0*F4*F5+32*v1*v2^2*v3* F1*F2*F6-8*v1*v2^2*v3*F1*F3*F5-64*v1*v2*v3^2*F0*F4*F6+32*v1*v2* v3^2*F0*F5^2-20*v1*v2*v3^2*F1*F3*F6+16*v1*v2*v3^2*F1*F4*F5+32* v1*v2*v3^2*F2^2*F6-12*v1*v2*v3^2*F2*F3*F5-48*v1*v2*v0*v3*F0*F6+ 16*v1*v2*v0*v3*F1*F5+16*v1*v2*v0*v3*F2*F4-10*v1*v2*v0*v3*F3^2: C3 := 4*v0^3*v3+4*v3^4*F2*F5^2+8*v1^4*F0*F1*F3-32*v1^3*v0*F0*F2-16*v2 ^4*F0*F2*F6+4*v1^4*F1^2*F2-16*v1^4*F0^2*F4-16*v1^4*F0*F2^2+8*v1 ^3*v0*F1^2-12*v1^2*v0^2*F0+4*v2^4*F1^2*F6+4*v3^4*F3^2*F6-16*v3^ 4*F0*F6^2+4*v0^2*v3^2*F4-8*v2^3*v0*F0*F5+4*v1^3*v2*F1^2*F3+4*v1 ^2*v2^2*F1^2*F4+4*v1*v2^3*F1^2*F5-32*v1^3*v2*F0^2*F5-48*v1^2*v2 ^2*F0^2*F6-4*v1*v2*v0^2*F1-16*v3^4*F2*F4*F6+4*v0*v3^3*F3*F5-16* v0*v3^3*F2*F6+32*v1^3*v3*F0^2*F6-8*v1^3*v3*F0*F3^2-16*v1^2*v3^2 *F0*F4^2+16*v1^2*v3^2*F1^2*F6-16*v1*v3^3*F0*F5^2+12*v2^2*v3^2* F0*F5^2+8*v2*v3^3*F1*F5^2-16*v1^3*v2*F0*F2*F3-8*v1^2*v2^2*F0*F1 *F5-16*v1^2*v2^2*F0*F2*F4-16*v1*v2^3*F0*F1*F6-16*v1*v2^3*F0*F2* F5-24*v1^2*v2*v0*F0*F3-16*v1*v2^2*v0*F0*F4-16*v1^3*v3*F0*F1*F5- 48*v1^2*v3^2*F0*F2*F6+24*v1^2*v3^2*F0*F3*F5-8*v1^2*v3^2*F1*F2* F5+32*v1*v3^3*F0*F4*F6-16*v1*v3^3*F1*F3*F6-4*v1^2*v0*v3*F1*F3- 16*v1^2*v0*v3*F0*F4-8*v1*v0*v3^2*F1*F5-32*v2^3*v3*F0*F3*F6-64* v2^2*v3^2*F0*F4*F6-8*v2^2*v3^2*F1*F3*F6-16*v2*v3^3*F0*F5*F6-32* v2*v3^3*F1*F4*F6-4*v2^2*v0*v3*F1*F5-48*v2^2*v0*v3*F0*F6-32*v2* v0*v3^2*F1*F6-4*v1*v2*v3^2*F1*F3*F5-16*v1^2*v2*v3*F0*F1*F6-16* v1^2*v2*v3*F0*F3*F4-8*v1^2*v2*v3*F1^2*F5-24*v1*v2^2*v3*F0*F3*F5 -16*v1*v2^2*v3*F1^2*F6-16*v1*v2*v3^2*F0*F4*F5-16*v1*v2*v3^2*F1* F2*F6-24*v1*v2*v0*v3*F0*F5-8*v1*v2*v0*v3*F1*F4: Tau := proc(ztvect) # squares each coord of a 4 x 1 matrix. matrix([ [expand(ztvect[1,1]^2)], [expand(ztvect[2,1]^2)], [expand(ztvect[3,1]^2)], [expand(ztvect[4,1]^2)] ]): end: # We now get the matrices W3 and V. Delta := det( matrix([ [h1,g1,f1],[h2,g2,f2],[h3,g3,f3] ]) ): OriginalDelta := Delta: b12 := res12: # resultant of q1,q2. b13 := res13: # resultant of q1,q3. b23 := res23: # resultant of q2,q3. b1 := b12*b13: b2 := b12*b23: b3 := b13*b23: # Note that sqrt(b1)*sqrt(b2)/b12 is the same as sqrt(b3), # so that the entries of the below right hand column are # the same as: sqrt(b3), -sqrt(b3), -sqrt(b3), sqrt(b3). W3 := multiply( matrix([ [1, sqrt(b1) , sqrt(b2) , sqrt(b1)*sqrt(b2)/b12 ], [1, sqrt(b1) , -sqrt(b2) , -sqrt(b1)*sqrt(b2)/b12 ], [1, -sqrt(b1) , sqrt(b2) , -sqrt(b1)*sqrt(b2)/b12 ], [1, -sqrt(b1) , -sqrt(b2) , sqrt(b1)*sqrt(b2)/b12 ] ]), # Note: the following [1,1] entry was incorrectly Delta in the article. matrix([[-Delta,entry12,entry13,entry14], [0, g3*h2-g2*h3, f3*h2-f2*h3, f3*g2-f2*g3], [0, g1*h3-g3*h1, f1*h3-f3*h1, f1*g3-f3*g1], [0, g2*h1-g1*h2, f2*h1-f1*h2, f2*g1-f1*g2]]) ): V := multiply( multiply( matrix( [ [2*Delta , Entry12, Entry13, Entry14], [ 0,Delta,0,0 ], [0,0,Delta,0] , [0,0,0,Delta] ]), matrix( [ [1,0,0,0], [0,-f1,-f2,-f3], [0,g1,g2,g3], [0,-h1,-h2,-h3] ]) ), matrix([ [ 1, 1, 1, 1 ], [ 1/sqrt(b1), 1/sqrt(b1),- 1/sqrt(b1),- 1/sqrt(b1) ], [ 1/sqrt(b2), -1/sqrt(b2), 1/sqrt(b2), -1/sqrt(b2) ], [ b12/(sqrt(b1)*sqrt(b2)), -b12/(sqrt(b1)*sqrt(b2)), -b12/(sqrt(b1)*sqrt(b2)), b12/(sqrt(b1)*sqrt(b2)) ] ])): vvect := matrix( [ [v0],[v1],[v2],[v3] ]): # The following gives the Richelot isogeny phi. Phi := simplify( multiply(V, Tau( multiply( W3, vvect ) ) ) ): ####### # Now do same for Delta*y^2 = (q2'*q3-q2*q3')*(q3'*q1-q3*q1')*(q1'*q2-q1*q2') # which is: y^2 = Q1*Q2*Q3, where Q1 = (q2'*q3-q2*q3')/Delta, # Q2 = q3'*q1-q3*q1' and Q3 = q1'*q2-q1*q2'. Q1 := expand( diff(q2,x)*q3 - q2*diff(q3,x) )/Delta: Q2 := expand( diff(q3,x)*q1 - q3*diff(q1,x) ): Q3 := expand( diff(q1,x)*q2 - q1*diff(q2,x) ): # We now relabel f1,f2,f3,g1,g2,g3,h1,h2,h3,Delta for isogenous curve. f1 := coeff(Q1,x,2): g1 := coeff(Q1,x,1): h1 := coeff(Q1,x,0): f2 := coeff(Q2,x,2): g2 := coeff(Q2,x,1): h2 := coeff(Q2,x,0): f3 := coeff(Q3,x,2): g3 := coeff(Q3,x,1): h3 := coeff(Q3,x,0): Delta := det( matrix([ [h1,g1,f1],[h2,g2,f2],[h3,g3,f3] ]) ): b12 := res12: # resultant of Q1,Q2. b13 := res13: # resultant of Q1,Q3. b23 := res23: # resultant of Q2,Q3. b1 := b12*b13: b2 := b12*b23: b3 := b13*b23: # Note that sqrt(b1)*sqrt(b2)/b12 is the same as sqrt(b3), # so that the entries of the below right hand column are # the same as: sqrt(b3), -sqrt(b3), -sqrt(b3), sqrt(b3). W3hat := multiply( matrix([ [1, sqrt(b1) , sqrt(b2) , sqrt(b1)*sqrt(b2)/b12 ], [1, sqrt(b1) , -sqrt(b2) , -sqrt(b1)*sqrt(b2)/b12 ], [1, -sqrt(b1) , sqrt(b2) , -sqrt(b1)*sqrt(b2)/b12 ], [1, -sqrt(b1) , -sqrt(b2) , sqrt(b1)*sqrt(b2)/b12 ] ]), matrix([[-Delta,entry12,entry13,entry14], [0, g3*h2-g2*h3, f3*h2-f2*h3, f3*g2-f2*g3], [0, g1*h3-g3*h1, f1*h3-f3*h1, f1*g3-f3*g1], [0, g2*h1-g1*h2, f2*h1-f1*h2, f2*g1-f1*g2]]) ): Vhat := multiply( multiply( matrix( [ [2*Delta , Entry12, Entry13, Entry14], [ 0,Delta,0,0 ], [0,0,Delta,0] , [0,0,0,Delta] ]), matrix( [ [1,0,0,0], [0,-f1,-f2,-f3], [0,g1,g2,g3], [0,-h1,-h2,-h3] ]) ), matrix([ [ 1, 1, 1, 1 ], [ 1/sqrt(b1), 1/sqrt(b1),- 1/sqrt(b1),- 1/sqrt(b1) ], [ 1/sqrt(b2), -1/sqrt(b2), 1/sqrt(b2), -1/sqrt(b2) ], [ b12/(sqrt(b1)*sqrt(b2)), -b12/(sqrt(b1)*sqrt(b2)), -b12/(sqrt(b1)*sqrt(b2)), b12/(sqrt(b1)*sqrt(b2)) ] ])): vvect := matrix( [ [v0],[v1],[v2],[v3] ]): # The following gives the dual Richelot isogeny Phihat. U := matrix( [ [1,0,0,0], [0,4,0,0], [0,0,4,0], [0,0,0,4] ] ): Phihat := simplify(multiply(U,multiply(Vhat,Tau(multiply(W3hat,vvect))))): ##### # Now compose Phi followed by Phihat. Phihat := matrix([ [subs(v0=m0,v1=m1,v2=m2,v3=m3, Phihat[1,1])], [subs(v0=m0,v1=m1,v2=m2,v3=m3, Phihat[2,1])], [subs(v0=m0,v1=m1,v2=m2,v3=m3, Phihat[3,1])], [subs(v0=m0,v1=m1,v2=m2,v3=m3, Phihat[4,1])] ]): PhihatPhi := matrix([ [expand(subs(m0=Phi[1,1],m1=Phi[2,1],m2=Phi[3,1],m3=Phi[4,1],Phihat[1,1]))], [expand(subs(m0=Phi[1,1],m1=Phi[2,1],m2=Phi[3,1],m3=Phi[4,1],Phihat[2,1]))], [expand(subs(m0=Phi[1,1],m1=Phi[2,1],m2=Phi[3,1],m3=Phi[4,1],Phihat[3,1]))], [expand(subs(m0=Phi[1,1],m1=Phi[2,1],m2=Phi[3,1],m3=Phi[4,1],Phihat[4,1]))] ]): const := -2^12*OriginalDelta^9: # The following multiplies each entry of PhihatPhi by const # (which of course does not change PhihatPhi projectively). for i from 1 to 4 do PhihatPhi[i,1] := PhihatPhi[i,1]/const od: # The following checks that PhihatPhi equals duplication [C0,C1,C2,C3] # noting that each of the following is constant (so that each # numerator is zero, modulo the Kummer defining equation quart1). check1 := simplify((PhihatPhi[1,1] - C0)/quart1); check2 := simplify((PhihatPhi[2,1] - C1)/quart1); check3 := simplify((PhihatPhi[3,1] - C2)/quart1); check4 := simplify((PhihatPhi[4,1] - C3)/quart1); final1 := quart1; final2 := subs( v0 = 1, quart1); eqn(33) := -a5*a14-f2*a14**2-f3*a14*a13-f4*a13**2-3*f5*a13*a12-f5*a13* a15-f6*a14*a10-6*f6*a12*a15-8*f6*a12**2-f6*a15**2+a9**2; interface(quiet,quiet=false):