Re: Elliptic Curves and Mathematica
- To: mathgroup at smc.vnet.net
- Subject: [mg40836] Re: Elliptic Curves and Mathematica
- From: "Richard I. Pelletier" <bitbucket at attbi.com>
- Date: Mon, 21 Apr 2003 06:58:36 -0400 (EDT)
- References: <b7qolq$3ij$1@smc.vnet.net>
- Sender: owner-wri-mathgroup at wolfram.com
[[ This message was both posted and mailed: see the "To," "Cc," and "Newsgroups" headers for details. ]] In article <b7qolq$3ij$1 at smc.vnet.net>, "flip" <flip_alpha at safebunch.com> wrote: > Hello, > > I am working on Elliptic Curves and was wondering if these are doable in > Mathematica? I can do them manually, but was wondering if it is possible to > show in > Mathematica). [posted and emailed] hi flip, the nb pasted at the end shows 1 problem i worked when i took a class in elliptic curves. the problem was (in case i mistype and this does not match the nb, use the nb): given the points A = (0,2) and B=(-2,0) on the elliptic curve y^2 - (x-1)(x^2-4) = 0. compute 2A, 3A, A+B, 2A+B, and 3A+B. the nb uses david park's drawgraphics package at his site http://home.earthlink.net/~djmp/ which makes it very easy to add lines, points, and text to a graph of an elliptic curve. there is a drawing at the beginning showing the curve and points A,B; and a drawing at the end showing the curve, all the points i computed, and the lines that determined them. hope this helps. rip Notebook[{ Cell[BoxData[ \(Needs["\<DrawGraphics`DrawingMaster`\>"]\)], "Input", InitializationCell->True], Cell[CellGroupData[{ Cell["\<\ A. Given the points A,B on the elliptic curve C, compute: 2A, 3A, \ A+B, 2A+B, 3A+B.\ \>", "Subsection"], Cell[BoxData[{ \(\(A = {0, 2};\)\), "\[IndentingNewLine]", \(\(B = {\(-2\), 0};\)\), "\[IndentingNewLine]", \(f[x_, y_] := y^2 - \((x - 1)\) \((x^2 - 4)\)\), "\[IndentingNewLine]", \(c = f[x, y] == 0\)}], "Input"], Cell["let's check that the points are on the curve:", "Text"], Cell[BoxData[{ \(c /. Thread[{x, y} -> A]\), "\[IndentingNewLine]", \(c /. Thread[{x, y} -> B]\)}], "Input"], Cell["here are my functions for finding tangent lines and chords:", "Text"], Cell[BoxData[ \(\(tanLine[p_, f_]\)[x_, y_] := \((D[f[x, y], x] /. Thread[{x, y} -> p])\) \((x - p[\([1]\)])\) + \((D[f[x, y], y] /. Thread[{x, y} -> p])\) \((y - p[\([2]\)])\) == 0\)], "Input"], Cell[BoxData[ \(twoPtLine[A_List, B_List] := y - B[\([2]\)] == \((x - B[\([1]\)])\)*\((A[\([2]\)] - B[\([2]\)])\)/\((A[\([1]\)] - B[\([1]\)])\)\)], "Input"], Cell[BoxData[ \(With[{a = 4}, \(Show[ Graphics[\n\t\t{\[IndentingNewLine]ImplicitDraw[ c, {x, \(-a\), a}, {y, \(-a\), a}], \[IndentingNewLine]Text["\<A\>", A, {\(-2\), 0}], \[IndentingNewLine]Text["\<B\>", B, {\(-2\), 0}], \[IndentingNewLine]AbsolutePointSize[ 8], \[IndentingNewLine]Red, \ Point[A], \[IndentingNewLine]Green, \ Point[B]\[IndentingNewLine]}], \n\nAspectRatio \[Rule] 1, PlotRange \[Rule] {{\(-a\), a}, {\(-a\), a}}, Background \[Rule] None, \n{}];\)]\)], "Input", CellOpen->False, GeneratedCell->False], Cell["\<\ let's get 2A. we get the tangent line at A, and we get the \ intersections:\ \>", "Text"], Cell[BoxData[{ \(line2A = \(tanLine[A, f]\)[x, y]\), "\[IndentingNewLine]", \(soln = Solve[{line2A, c}]\)}], "Input"], Cell["\<\ we see the double intersection at A, and the new one is the 1st. \ write it to change the sign of the y-component, though in this case it's 0:\ \ \>", "Text"], Cell[BoxData[ \(twoA = \({x, \(-y\)} /. y -> \(-y\)\) /. soln[\([1]\)]\)], "Input"], Cell["\<\ but that's interesting. because 2A is the intersection, we don't \ get a third point: the line thru 2A and A is the tangent line at A.\ \>", \ "Text"], Cell[BoxData[{ \(line3A = twoPtLine[twoA, A]\), "\[IndentingNewLine]", \(soln = Solve[{line3A, c}]\)}], "Input"], Cell["\<\ the first point is 2A, the other two are A. i really don't like 3A \ = 2A, so i guess that A is the intersection, so i change the sign:\ \>", \ "Text"], Cell[BoxData[ \(threeA = {x, \(-y\)} /. soln[\([2]\)]\)], "Input"], Cell["\<\ let's go for A+B. here's the line thru the two points, and the \ three intersections:\ \>", "Text"], Cell[BoxData[{ \(lineAB = twoPtLine[A, B]\), "\[IndentingNewLine]", \(soln = Solve[{lineAB, c}]\)}], "Input"], Cell["the new point is the 3rd, so", "Text"], Cell[BoxData[ \(AandB = {x, \(-y\)} /. soln[\([3]\)]\)], "Input"], Cell["ok, 2A+B:", "Text"], Cell[BoxData[{ \(line2AB = twoPtLine[twoA, B]\), "\[IndentingNewLine]", \(soln = Solve[{line2AB, c}]\)}], "Input"], Cell[BoxData[ \(twoAandB = {x, \(-y\)} /. soln[\([2]\)]\)], "Input"], Cell["i want to confirm that i get the same answer from A+(A+B):", "Text"], Cell[BoxData[{ \(line2AB = twoPtLine[A, AandB]\), "\[IndentingNewLine]", \(soln = Solve[{line2AB, c}]\)}], "Input"], Cell["yes, soln[[2]] is the same point we found from 2A+B:", "Text"], Cell[BoxData[ \(twoAandB == {x, \(-y\)} /. soln[\([2]\)]\)], "Input"], Cell["finally, 3A+B = 2A+(A+B):", "Text"], Cell[BoxData[{ \(line3AB = twoPtLine[twoA, AandB]\), "\[IndentingNewLine]", \(soln = Solve[{line3AB, c}]\)}], "Input"], Cell["refresh memory: the two i started with were", "Text"], Cell[BoxData[ \({twoA, AandB}\)], "Input"], Cell["\<\ i.e. it looks like we have a tangent at A+B. i have to remind \ myself to flip the sign:\ \>", "Text"], Cell[BoxData[ \(threeAandB = {x, \(-y\)} /. soln[\([2]\)]\)], "Input"], Cell["try that the other way: 3A+B:", "Text"], Cell[BoxData[{ \(line3AB = twoPtLine[threeA, B]\), "\[IndentingNewLine]", \(soln = Solve[{line3AB, c}]\)}], "Input"], Cell["this time it's soln[[1]] that is the intersection:", "Text"], Cell[BoxData[ \({threeA, B}\)], "Input"], Cell["let's take a look:", "Text"], Cell[BoxData[ \(With[{a = 8}, \(Show[ Graphics[\n\t\t{\[IndentingNewLine]ImplicitDraw[ c, {x, \(-a\), a}, {y, \(-a\), a}], \[IndentingNewLine]Text["\<A\>", A, {\(-2\), 0}], \[IndentingNewLine]Text["\<B\>", B, {\(-2\), 0}], \[IndentingNewLine]Text["\<A+B\>", AandB, {\(-2\), 0}], \[IndentingNewLine]Text["\<2A\>", twoA, {\(-2\), 0}], \[IndentingNewLine]Text["\<3A\>", threeA, {\(-2\), 0}], \[IndentingNewLine]Text["\<2A+B\>", twoAandB, {1, \(-1\)}], \[IndentingNewLine]Text["\<3A+B\>", threeAandB, {1, \(-1\)}], \[IndentingNewLine]ImplicitDraw[ line2A, {x, \(-a\), a}], \[IndentingNewLine]ImplicitDraw[ line3A, {x, \(-a\), a}], \[IndentingNewLine]ImplicitDraw[ lineAB, {x, \(-a\), a}], \[IndentingNewLine]ImplicitDraw[ line2AB, {x, \(-a\), a}], \[IndentingNewLine]ImplicitDraw[ line3AB, {x, \(-a\), a}], \[IndentingNewLine]AbsolutePointSize[ 8], \[IndentingNewLine]Red, \ Point[A], \[IndentingNewLine]Point[ B], \[IndentingNewLine]Green, Point[twoA], \[IndentingNewLine]Point[ threeA], \[IndentingNewLine]Point[ twoAandB], \[IndentingNewLine]Point[ threeAandB], \[IndentingNewLine]Point[ AandB]\[IndentingNewLine]}], \n\nAspectRatio \[Rule] 1, PlotRange \[Rule] {{\(-a\), a}, {\(-a\), a}}, Background \[Rule] None, \n{}];\)]\)], "Input", GeneratedCell->False], Cell[TextData[{ "we see 7 distinct points, and add the point at \[Infinity], 0. can i build \ the group table?\ni think 2B = 0 (vertical tangent at B), 4A=0 (vertical \ tangent at 2A). then A+3A=0 (follows, but also they lie on vertical line), \ and (2A+B)+(2A+B)=0 (follows, but also vertical tangent at 2A+B), and finally \ (3A+B)+(A+B) = 0 (follows, but also they lie on vertical line.\nso, we have \ an element of order 4, and an element of order 2. this is an abelian group, \ so it's ", Cell[BoxData[ \(TraditionalForm\`\[DoubleStruckCapitalZ]\_2\)]], "\[Cross] ", Cell[BoxData[ \(TraditionalForm\`\[DoubleStruckCapitalZ]\_4\)]], "." }], "Text"] }, Open ]] }, FrontEndVersion->"4.1 for Macintosh", ScreenRectangle->{{0, 1024}, {0, 746}}, AutoGeneratedPackage->None, WindowSize->{520, 624}, WindowMargins->{{1, Automatic}, {Automatic, 1}}, MacintoshSystemPageSetup->"\<\ -- NOTE: email address is rip1 AT attbi DOT com
- Follow-Ups:
- Re: Re: Elliptic Curves and Mathematica
- From: Murray Eisenberg <murraye@attbi.com>
- Re: Re: Elliptic Curves and Mathematica