MathGroup Archive 2003

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: Elliptic Curves and Mathematica

  • To: mathgroup at smc.vnet.net
  • Subject: [mg40974] Re: Elliptic Curves and Mathematica
  • From: "Richard I. Pelletier" <bitbucket at attbi.com>
  • Date: Sat, 26 Apr 2003 03:25:41 -0400 (EDT)
  • References: <b7qolq$3ij$1@smc.vnet.net> <200304211058.GAA22418@smc.vnet.net> <b8b9o2$9l5$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 <b8b9o2$9l5$1 at smc.vnet.net>, Murray Eisenberg
<murraye at attbi.com> wrote:

> Can you supply the tail-end of the Notebook expression from this 
> notebook?  It was truncated in your message.

sorry about that. i looked at another posting to see what was
customarily kept. since i don't understand exactly what fragments are
essential, i have enclosed the entire nb.

(************** Content-type: application/mathematica **************

                    Mathematica-Compatible Notebook

This notebook can be used with any Mathematica-compatible
application, such as Mathematica, MathReader or Publicon. The data
for the notebook starts with the line containing stars above.

To get the notebook into a Mathematica-compatible application, do
one of the following:

* Save the data starting with the line of stars above into a file
  with a name ending in .nb, then open the file inside the
  application;

* Copy the data starting with the line of stars above to the
  clipboard, then use the Paste menu command inside the application.

Data for notebooks contains only printable 7-bit ASCII and can be
sent directly in email or through ftp in text mode.  Newlines can be
CR, LF or CRLF (Unix, Macintosh or MS-DOS style).

NOTE: If you modify the data for this notebook not in a Mathematica-
compatible application, you must delete the line below containing
the word CacheID, otherwise Mathematica-compatible applications may
try to use invalid cache data.

For more information on notebooks and Mathematica-compatible 
applications, contact Wolfram Research:
  web: http://www.wolfram.com
  email: info at wolfram.com
  phone: +1-217-398-0700 (U.S.)

Notebook reader applications are available free of charge from 
Wolfram Research.
*******************************************************************)

(*CacheID: 232*)


(*NotebookFileLineBreakTest
NotebookFileLineBreakTest*)
(*NotebookOptionsPosition[      8689,        252]*)
(*NotebookOutlinePosition[      9550,        279]*)
(*  CellTagsIndexPosition[      9506,        275]*)
(*WindowFrame->Normal*)



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->"\<\
02P0001804P000000^L2D_ogooL33`9K8085:0?l0000005X0FP000003X<;VP5d
038;VTRX04/00@4100000BL?00400@000000000000000000000000000040I040
000000000P4@/@D04@00P4D0@00fA4TP\>"
]

(*******************************************************************
Cached data follows.  If you edit this Notebook file directly, not
using Mathematica, you must remove the line containing CacheID at
the top of  the file.  The cache data will then be recreated when
you save this file from within Mathematica.
*******************************************************************)

(*CellTagsOutline
CellTagsIndex->{}
*)

(*CellTagsIndex
CellTagsIndex->{}
*)

(*NotebookFileOutline
Notebook[{
Cell[1705, 50, 101, 2, 27, "Input",
  InitializationCell->True],

Cell[CellGroupData[{
Cell[1831, 56, 114, 3, 64, "Subsection"],
Cell[1948, 61, 232, 4, 75, "Input"],
Cell[2183, 67, 61, 0, 30, "Text"],
Cell[2247, 69, 117, 2, 43, "Input"],
Cell[2367, 73, 75, 0, 30, "Text"],
Cell[2445, 75, 241, 4, 59, "Input"],
Cell[2689, 81, 199, 4, 43, "Input"],
Cell[2891, 87, 674, 13, 19, "Input",
  CellOpen->False],
Cell[3568, 102, 99, 3, 30, "Text"],
Cell[3670, 107, 126, 2, 43, "Input"],
Cell[3799, 111, 168, 4, 46, "Text"],
Cell[3970, 117, 87, 1, 27, "Input"],
Cell[4060, 120, 160, 4, 46, "Text"],
Cell[4223, 126, 121, 2, 43, "Input"],
Cell[4347, 130, 161, 4, 46, "Text"],
Cell[4511, 136, 70, 1, 27, "Input"],
Cell[4584, 139, 109, 3, 30, "Text"],
Cell[4696, 144, 118, 2, 43, "Input"],
Cell[4817, 148, 44, 0, 30, "Text"],
Cell[4864, 150, 69, 1, 27, "Input"],
Cell[4936, 153, 25, 0, 30, "Text"],
Cell[4964, 155, 123, 2, 43, "Input"],
Cell[5090, 159, 72, 1, 27, "Input"],
Cell[5165, 162, 74, 0, 30, "Text"],
Cell[5242, 164, 124, 2, 43, "Input"],
Cell[5369, 168, 68, 0, 30, "Text"],
Cell[5440, 170, 73, 1, 27, "Input"],
Cell[5516, 173, 41, 0, 30, "Text"],
Cell[5560, 175, 127, 2, 43, "Input"],
Cell[5690, 179, 59, 0, 30, "Text"],
Cell[5752, 181, 46, 1, 27, "Input"],
Cell[5801, 184, 112, 3, 30, "Text"],
Cell[5916, 189, 74, 1, 27, "Input"],
Cell[5993, 192, 45, 0, 30, "Text"],
Cell[6041, 194, 125, 2, 43, "Input"],
Cell[6169, 198, 66, 0, 30, "Text"],
Cell[6238, 200, 44, 1, 27, "Input"],
Cell[6285, 203, 34, 0, 30, "Text"],
Cell[6322, 205, 1675, 28, 459, "Input"],
Cell[8000, 235, 673, 14, 110, "Text"]
}, Open  ]]
}
]
*)



(*******************************************************************
End of Mathematica Notebook file.
*******************************************************************)



-- 
NOTE: email address is rip1 AT attbi DOT com


  • Prev by Date: RE: Multiple graphs with same x-axis but separate y-axis and space
  • Next by Date: Re: Please Help With a Module
  • Previous by thread: Re: Re: Elliptic Curves and Mathematica
  • Next by thread: Loading Packages On Startup