# Updated on 15 June 1999, to be compatable with Maple V.5 interface(prettyprint,prettyprint=false): # The following procedures, culminating in addd, # gives the group law on divisors in the Jacobian # of a curve of genus 2. I admit the code's a bit of # a mess, but it works! Any questions, e-mail: flynn@maths.ox.ac.uk # To use it, first assign: # sex := # div1 := [[x1,y1],[x2,y2]]: div2 := [[x3,y3],[x4,y4]]: # where each [xi,yi] is a point on the curve: # y^2 = sextic in x = f6*x^6 + ... + f0. # Here, div1 represents the divisor: # [x1,y1] + [x2,y2] - infty+ - infty- # Then the call: # addd(div1,div2,sex): # will produce the divisor which is the sum of # div1 and div1 on the Jacobian on the curve y^2 = sextic in x. # If f6, the coefficient of x^6 in your sextic, is a rational # square, then there are 2 branches at the point # at infinity: infty^+ , infty^- # To represent these as points, please use: # [infty, sqrt(f6)*infty**3] to represent infty^+ # [infty, -sqrt(f6)*infty**3] to represent infty^- # Of course, as a special case, when f6 = 0, there is only # one branch at infinity, which is represented as [infty, 0]. # # Example 1. # First assign: # sex := x^6+8*x^5+22*x^4+22*x^3+5*x^2+6*x+1: # divv1 := [[infty,infty**3],[infty,infty**3]]: # divv2 := [[-3,1],[0,1]]: # divv3 := [[0,1],[0,1]]: # Then applying: # addd(divv1,divv1,sex); # gives the result: # [[-3,1],[0,1]] # This corresponds to the fact that: divv1 + divv1 = divv2 # Or (to express this in terms of divisors): # [(infty^+ + infty^+) - (infty^+ + infty^-)] # + [(infty^+ + infty^+) - (infty^+ + infty^-)] # = [ (-3,1) + (0,1) - (infty^+ + infty^-)] # That is to say: # [infty^+ - infty^-] # + [infty^+ - infty^-] # = [ (-3,1) + (0,1) - (infty^+ + infty^-)] # Similarly applying: # addd( divv2,divv3,sex); # gives the result: # [[-3,1],[infty,infty**3]] # This corresponds to: div2 + div3 = [[-3,1],[infty,infty**3]] # # Example 2. # First assign: # sex := (x^2 - 2*x - 2)*(-x^2 + 1)*(2*x): # divv1 := [ [0,0],[-1/2 , 3/4] ]: # divv2 := [[infty,0],[-1,0]]: # Then applying: # divv3 := addd( divv1, divv2, sex); # gives the result: # divv3 := [[-1/2+1/2*I*15^(1/2), -12], [-1/2-1/2*I*15^(1/2), -12]] # Applying: # divv4 := addd( divv3, divv3, sex); # gives the result: # divv4 := [[-1/2, 3/4], [-1/2, 3/4]] # Applying: # divv5 := addd( divv3, divv4, sex); # gives the result: # divv5 := [[-197/10+1/10*34185^(1/2), # 32652/5-4416/125*3^(1/2)*5^(1/2)*43^(1/2)*53^(1/2)], # [-197/10-1/10*34185^(1/2), # 32652/5+4416/125*3^(1/2)*5^(1/2)*43^(1/2)*53^(1/2)]] ################################################################### dofirst := proc(arr) local arr1,arr2,narr1,narr2,M,pt1,x1,y1,found,WP, i,pt,count: # The following takes a pair of arrays of points: # [arr1,arr2] = # [ [[x1,y2],[x2,y2],..,[xn,yn]], [ whatever ] ] # and looks to see if any of x2,..,xn are = x1. # If so, and if any point has x1=xi and y1=-yi # then these 2 points are removed from arr1 and [[OO,OO],2] # is put at the beginning of arr2. # Otherwise, all [xi,yi] are found s.t. [x1,y1]=[xi,yi] and # all of these are removed from arr1 and [[x1,y1],N] is # added at the end of arr2, where N is the multiplicity. # N.B. pts. at infty are in the form: [infty,sqrt(f6)*infty**3] # and [infty,-sqrt(f6)*infty**3] for even degree and # [infty,0] for the odd degree situation. arr1 := arr[1]: arr2 := arr[2]: narr1 := arr1: narr2 := arr2: M := nops(arr1): if M = 0 then M := M else pt1 := arr1[1]: x1 := pt1[1]: y1 := pt1[2]: found := false: WP := false: i := 1: while (i0 then diff(ffnxy,x$i) else ffnxy fi; if i>0 then solve(%,diff(y(x),x$i)) else y(x) fi; if i>0 then subs(op(arr1),%) else % fi; if i>0 then arr1 := [diff(y(x),x$i)=% , op(arr1)] else arr1 := [y(x)=y(x)] fi; arr2 := [%%,op(arr2)]; od; arr2[1]; normal(subs(y(x)=y,%),expanded); end; readlib(unassign): geteqn := proc(ptm,sextic) local pt,mult,x1,y1,cub,vsextic, lhs,rhs,vcub,vx1,vy1,eqnset,i; # The input is ptm = [[x1,y1],mult] and sextic (in x) # The output is the set of linear eqns in a,b,c,d # induced by the condition that the curve y**2 = sextic # meets y = a*x**3 + b*x**2 + c*x + d at [x1,y1] # with multiplicity mult. pt := ptm[1]: mult := ptm[2]: x1 := pt[1]: y1 := pt[2]: cub := a*x**3 + b*x**2 + c*x + d: if x1=infty then vsextic := expand(x**6*subs(x=1/x,sextic)): vcub := expand(x**3*subs(x=1/x,cub)): vx1 := 0: vy1 := y1/(infty**3): else vsextic := sextic: vcub := cub: vx1 := x1: vy1 := y1: fi: eqnset := { subs(x=vx1,y=vy1,vcub) = vy1 }: for i from 1 to (mult-1) do lhs := expand( subs(x=vx1,diff(vcub,x$i)) ): rhs := subs(x=vx1,y=vy1, deriv(y**2 - vsextic,i) ): radsimp(rhs,'ratdenom'): rhs := expand(%): eqnset := eqnset union {lhs=rhs}: od: eqnset: end: geteqns := proc(ptms,sextic) local i,eqnset: # The input is ptms = [ptms[1],..,ptms[k]] and sextic (in x) # where each ptms[i] = [[xi,yi],mult_i]. # The output is the set of linear eqns in a,b,c,d # induced by the condition that the curve y**2 = sextic # meets y = a*x**3 + b*x**2 + c*x + d at all of the # [xi,yi] with multiplicity mult_i. eqnset := {}: for i from 1 to nops(ptms) do eqnset := eqnset union geteqn(ptms[i] ,sextic) od: eqnset: end: getcub := proc(ptms,sextic) global aa,bb,cc,dd,cubb; # The input is ptms = [ptms[1],..,ptms[k]] and sextic (in x) # where each ptms[i] = [[xi,yi],mult_i]. # The output is the cubic: # y = a*x**3 + b*x**2 + c*x + d # which meets the curve y**2 = sextic at all the # [xi,yi] with multiplicity mult_i. cubb := aa*x**3 + bb*x**2 + cc*x + dd; geteqns(ptms,sextic): solve(%,{a,b,c,d}): subs(a=aa,b=bb,c=cc,d=dd,%); assign(%): radsimp(aa,'ratdenom'): aa := expand(%): bb := radsimp(bb,'ratdenom'): bb := expand(%): cc := radsimp(cc,'ratdenom'): cc := expand(%): dd := radsimp(dd,'ratdenom'): dd := expand(%): cubb := cubb; unassign('aa'): unassign('bb'): unassign('cc'): unassign('dd'): cubb: end; deconv := proc(arrr,sextic) local ff6, arrrr; # The following "deconverts" an array # [ [[OO,OO],2],[[x1,y1],1],[[x2,y2],1] ] # into: [ [x1,y1],[x2,y2] ] # and "deconverts" an array # [ [[OO,OO],2],[[x1,y1],2] ] # into: [ [x1,y1],[x1,y1] ]. ff6 := sqrt(coeff(sextic,x,6)): if arrr[2][2] = 1 then arrrr := [ arrr[2][1] , arrr[3][1] ] elif arrr[2][1] = [OO,OO] then arrrr := [ [infty, ff6*infty**3] , [infty,-ff6*infty**3] ]: else arrrr := [ arrr[2][1] , arrr[2][1] ] fi: arrrr: end: addd := proc(arr1,arr2,sext) local cub,varsextic,deg,i,varquartic, sextic,varquad,x1,y1,x2,y2,summ,arr,arrr; global a,b,c,d,t; # N.B. Global: a,b,c,d,t. # The following inputs: arr1 = [ pt1 , pt2 ] , arr2 = [ pt3 , pt4 ] # where each pt is of the form [x,y], with a pt. at # infinity represented by: [infty,sqrtf6*infty**3] # or [infty,-sqrtf6*infty**3]. The other input is a sextic in x. # The output is the divisor: [[x1,y1],[x2,y2]] giving # the sum of arr1 + arr2 on the Jacobian of the # curve: y**2 = sextic. sextic := expand(sext): arr := [op(arr1),op(arr2)]; arrr := convertt(arr): if arrr[1] = [[OO,OO],2] then summ := deconv(arrr,sextic) else cub := getcub(arrr,sextic): varsextic := expand((cub**2 - sextic)): radsimp(%,'ratdenom'): varsextic := expand(%): deg := degree(varsextic): if (not deg = 6) then varsextic := varsextic*(x-infty)**(6-deg) fi: varsextic := expand(varsextic); varquartic := 1; for i from 1 to nops(arr) do varquartic := varquartic*(x-arr[i][1]) od: varquartic := expand(varquartic): radsimp(varquartic,'ratdenom'): varquartic := expand(%): varquad := simplify(varsextic/varquartic); [solve(%,x)]: x1 := %[1]: x2 := %%[2]: if x1 = infty then y1 := -coeff(cub,x,3)*infty**3 else y1 := -subs(x=x1,cub): radsimp(%,'ratdenom'): y1 := expand(%): fi: if x2 = infty then y2 := -coeff(cub,x,3)*infty**3 else y2 := -subs(x=x2,cub): radsimp(%,'ratdenom'): y2 := expand(%): fi: summ := [[x1,y1],[x2,y2]]: fi: summ: end: sex := -x^6-2*x^5-x^4-x^3-2*x^2+2*x+2: div1 := [[-13/34+1/34*101^(1/2), 7207/9826+599/9826*101^(1/2)], [-13/34-1/34*101^(1/2), 7207/9826-599/9826*101^(1/2)]]: addd(div1,div1,sex): addd(div1,%,sex): summ := addd(div1,%,sex):