Plotting the sum of two points on an elliptic curve

Here's a starting point:

ecp = ContourPlot[y^2 == x (x - 1) (x + 1), {x, -2, 2}, {y, -2, 2}];
ec = RegionNearest[ImplicitRegion[y^2 == x (x - 1) (x + 1), {{x, -2, 2}, {y, -2, 2}}]];

DynamicModule[{pts = {{-1, 0}, {1, 0}, {0, 0}}}, 
              Panel[Row[{LocatorPane[Dynamic[pts, (pts = 
                         Block[{ip = ec /@ Most[#], sol}, 
                               sol = {\[FormalX], \[FormalY]} /. 
                               NSolve[{\[FormalY]^2 == \[FormalX]
                                                       (\[FormalX] - 1) (\[FormalX] + 1),
                                       \[FormalY] == 
                                       InterpolatingPolynomial[ip, \[FormalX]]},
                                      {\[FormalX], \[FormalY]}]; 
                               Append[ip, First[Pick[sol, Normalize[Chop[Min /@
                                      DistanceMatrix[sol, ip], 1.*^-6], Max], 1.]]]];) &], 
               Show[ecp, 
                    Graphics[{{Yellow, Thick, Dynamic[InfiniteLine[Most[pts]]]},
                              {PointSize[Large],
                               {Red, Dynamic[Point[pts[[1]]]]},
                               {Green, Dynamic[Point[pts[[2]]]]}},
                              {PointSize[Medium], Brown, Dynamic[Point[pts[[3]]]]}}],
                    ImageSize -> Medium], Appearance -> None], 
               Pane[Dynamic[Grid[Transpose[{{Style["Point 1:", Red, Large], 
                                             Style["Point 2:", Green, Large], 
                                             Style["Point 3:", Brown, Large]}, 
                                            Style[#, Large] & /@ pts}]]]]}]]]

elliptic curve addition demo


Extra Credit

Mathematica has the functions EllipticExp[] and EllipticLog[] that facilitate the study of the elliptic curve given in the general form $y^2=x^3+ax^2+bx$. (These functions are of course related to the more conventional Weierstrass elliptic functions through a simple change of coordinates.) In particular, these functions make it much easier to show the addition of points. The following will be a manual demonstration; bundling this into a Dynamic[] demo like the one above is left as an exercise.

Let us again take the elliptic curve $y^2=x(x-1)(x+1)$, corresponding to the parameters $a=0,b=-1$. Generate two random points in the elliptic curve, like so:

ecr = ImplicitRegion[y^2 == x (x - 1) (x + 1), {{x, -2, 2}, {y, -2, 2}}];
BlockRandom[SeedRandom["elliptic"]; (* for reproducibility *)
            (* Quiet suppresses a few harmless error messages *)
            {p1, p2} = Quiet[RandomPoint[ecr, 2]];]

To add p1 and p2 over the given elliptic curve, do this:

p3 = Chop[EllipticExp[EllipticLog[p1, {0, -1}] + EllipticLog[p2, {0, -1}], {0, -1}]];

Show the addition graphically:

ContourPlot[y^2 == x (x - 1) (x + 1), {x, -2, 2}, {y, -2, 2}, 
            Epilog -> {{Orange, {Thick, InfiniteLine[{p1, p2}]},
                                {Dashed, Line[{{1, -1} p3, p3}]}},
                       {PointSize[Large], {Red, Point[p1]}, {Green, Point[p2]}},
                       {PointSize[Medium], Brown, Point[p3]}}]

elliptic curve addition via elliptic functions

Check the collinearity of the two points and the reflection of the addition point:

Chop[Det[PadRight[{p1, p2, {1, -1} p3}, {3, 3}, 1]]]
   0

The fine solution offered by J. M. above works in Mma version 11, but not in 10.1 -- it uses the newer semantics for DistanceMatrix. To also work in an earlier version, you can use the following solution, using Complement[] instead of DistanceMatrix[]. (My newbie (low) reputation won't let me post comments, hence this fresh answer.)

ecp = ContourPlot[y^2 == x (x - 1) (x + 1), {x, -2, 2}, {y, -2, 2}];
ec = RegionNearest[ImplicitRegion[y^2 == x (x - 1) (x + 1), {{x, -2, 2}, {y, -2, 2}}]];

DynamicModule[{pts = {{-1, 0}, {1, 0}, {0, 0}}}, 
              Panel[Row[{LocatorPane[Dynamic[pts, (pts = 
                         Block[{ip = ec /@ Most[#], sol}, 
                               sol = {\[FormalX], \[FormalY]} /. 
                               NSolve[{\[FormalY]^2 == \[FormalX]
                                                       (\[FormalX] - 1) (\[FormalX] + 1),
                                       \[FormalY] == 
                                       InterpolatingPolynomial[ip, \[FormalX]]},
                                      {\[FormalX], \[FormalY]}]; 
                               Append[ip, First[Complement[sol, ip, SameTest->(Norm[#1-#2]<1*^-5&)]]]];) &], 
               Show[ecp, 
                    Graphics[{{Yellow, Thick, Dynamic[InfiniteLine[Most[pts]]]},
                              {PointSize[Large],
                               {Red, Dynamic[Point[pts[[1]]]]},
                               {Green, Dynamic[Point[pts[[2]]]]}},
                              {PointSize[Medium], Brown, Dynamic[Point[pts[[3]]]]}}],
                    ImageSize -> Medium], Appearance -> None], 
               Pane[Dynamic[Grid[Transpose[{{Style["Point 1:", Red, Large], 
                                             Style["Point 2:", Green, Large], 
                                             Style["Point 3:", Brown, Large]}, 
                                            Style[#, Large] & /@ pts}]]]]}]]]