# Lines of intersections in a parabola

To test the parabolic sieve, my intention was for the graph to show the coordinates of two points on the parabola and the value of the intersection on the y-axis. A table with this information would also be useful. For example: for the pairs (-3, 9) and (2,4) the value of the intersection on the y-axis is y= 6. For (-4,16) and (5,25) we have y=12, and so on. I appreciate any help.

parabola = Plot[x^2, {x, -10, 10}, PlotRange -> {0, 100}];

intersectionPoint[a_, b_] := Module[{p1, p2, line, intersection},
p1 = {-a, a^2};
p2 = {b, b^2};
line = InfiniteLine[{p1, p2}];
intersection = RegionIntersection[line, Line[{{0, 0}, {0, 100}}]];
If[intersection =!= EmptyRegion[2], First[intersection], {}] ];

animation = Animate[Show[ parabola, Graphics[{ Red, PointSize[Large], Point[{-a, a^2}], Point[{b, b^2}], Blue, Line[{{-a, a^2}, {b, b^2}}], Green, PointSize[Large], intersectionPoint[a, b] }] ], {a, 1, 10, 1}, {b, 1, 10, 1} ];

animation


\$Version

(* "14.0.0 for Mac OS X ARM (64-bit) (December 13, 2023)" *)

Clear["Global*"]


The intercepts are

pts[a_, b_?NonNegative] = Assuming[b >= 0, Piecewise[{
{SolveValues[{y == x^2, y == b}, {x, y}, Reals], a == 0}},
SolveValues[{y == x^2, y == a*x + b}, {x, y}, Reals] // Simplify]]


Manipulate[
Column@{
StringForm["intercepts = ", N@Sort@pts[a, b]],
Plot[{x^2, a*x + b}, {x, -5, 5},
PlotRange -> {-1, 26},
AxesLabel -> (Style[#, 14] & /@ {x, y}),
ImageSize -> Medium,
Epilog -> {
AbsolutePointSize[6],
Red, Point[pts[a, b]], ,
AbsolutePointSize[4],
Green, Point[{0, b}]},
PlotLegends -> "Expressions"]},
{{a, 2}, -5, 5, 0.1, Appearance -> "Labeled"},
{{b, 5}, 0, 25, 0.05, Appearance -> "Labeled"},
SynchronousUpdating -> False,
TrackedSymbols :> {a, b}]


Manipulate[
f = If[exact, Identity, N];
ds = Dataset[Flatten[Table[
<|"a" -> a, "b" -> b,
"intercept 1" -> Simplify@f[MinimalBy[First][pts[a, b]][[1]]],
"axis pt" -> {0, b},
"intercept 2" -> Simplify@f[MaximalBy[First][pts[a, b]][[1]]]|>,
{a, -5, 5}, {b, 0, 25}], 1]],
{{exact, True}, {True, False}},
TrackedSymbols :> {exact}]


The current output of intersectionPoint is just a number, which does not work as a Graphics primitive. Instead, change the function's definition to directly return the output of RegionIntersection, which is already a Point object, and that will show up in the plot:

ClearAll[intersectionPoint]
intersectionPoint[a_, b_] :=
Module[
{p1, p2, line, intersection},
p1 = {-a, a^2};
p2 = {b, b^2};
line = InfiniteLine[{p1, p2}];
intersection = RegionIntersection[line, Line[{{0, 0}, {0, 100}}]];
If[intersection =!= EmptyRegion[2], intersection, {}]
]


You can show the multiplicative property, e.g.:

sol[a_, b_] := Module[{p1 = {-a, a^2}, p2 = {b, b^2}, ln, int},
ln = t  p1 + (1 - t) p2;
int = ln /. Solve[ ln == {0, x}, {t, x}][[1]]]
sol[a, b] // FullSimplify


->{0,ab}

Just to illustrate:

f[a_, b_] := Module[{p1 = {-a, a^2}, p2 = {b, b^2}, ln, int},
ln = t  p1 + (1 - t) p2;
int = ln /. Solve[ ln == {0, x}, {t, x}][[1]];
ParametricPlot[{{t, t^2}, ln}, {t, -10, 10},
Epilog -> {Point[{p1, p2}],
Text[Framed[-p1[[1]], RoundingRadius -> 10], p1, {1.5, 0},
Background -> White],
Text[Framed[p2[[1]], RoundingRadius -> 10], p2, {-1.5, -1},
Background -> White],
Red, Point[int],
Text[Framed[int[[2]], RoundingRadius -> 10, Background -> White],
int, {-2, 0}]}, PlotRange -> {{-40, 40}, {-5, 120}},
Frame -> True, Axes -> True]
]


Applying to 100 pairs integers 1 to 10:

I think to achieve the desired result, where the graph shows the coordinates of two points on the parabola and the value of the intersection on the y-axis, as well as a table with this information, you may need to use the following approach:

(* Define the parabola *)
parabola = Plot[x^2, {x, -10, 10}, PlotRange -> {0, 100}];

(* Function to calculate intersection point with y-axis *)
intersectionPoint[a_, b_] := Module[{p1, p2, slope, intercept, intersection},
p1 = {-a, a^2};
p2 = {b, b^2};
slope = (p2[[2]] - p1[[2]]) / (p2[[1]] - p1[[1]]);
intercept = p1[[2]] - slope * p1[[1]];
intersection = {0, intercept};
intersection
];

(* Create the animation *)
animation = Animate[
Module[{p1, p2, intersection},
p1 = {-a, a^2};
p2 = {b, b^2};
intersection = intersectionPoint[a, b];
Show[
parabola,
Graphics[{
Red, PointSize[Large], Point[p1], Point[p2],
Blue, Line[{p1, p2}],
Green, PointSize[Large], Point[intersection]
}]
]
],
{a, 1, 10, 1}, {b, 1, 10, 1}
];

(* Display the animation *)
animation

(* Generate a table with intersection values *)
intersectionTable = Table[
{a, b, intersectionPoint[a, b][[2]]},
{a, 1, 10, 1}, {b, 1, 10, 1}
];

(* Display the table *)
Grid[Prepend[Flatten[intersectionTable, 1], {"a", "b", "y-intersection"}], Frame -> All]
`

$$\begin{array}{ccc} \text{a} & \text{b} & \text{y-intersection} \\ 1 & 1 & 1 \\ 1 & 2 & 2 \\ 1 & 3 & 3 \\ 1 & 4 & 4 \\ 1 & 5 & 5 \\ 1 & 6 & 6 \\ 1 & 7 & 7 \\ 1 & 8 & 8 \\ 1 & 9 & 9 \\ 1 & 10 & 10 \\ 2 & 1 & 2 \\ 2 & 2 & 4 \\ 2 & 3 & 6 \\ 2 & 4 & 8 \\ 2 & 5 & 10 \\ 2 & 6 & 12 \\ 2 & 7 & 14 \\ 2 & 8 & 16 \\ 2 & 9 & 18 \\ 2 & 10 & 20 \\ 3 & 1 & 3 \\ 3 & 2 & 6 \\ 3 & 3 & 9 \\ 3 & 4 & 12 \\ 3 & 5 & 15 \\ 3 & 6 & 18 \\ 3 & 7 & 21 \\ 3 & 8 & 24 \\ 3 & 9 & 27 \\ 3 & 10 & 30 \\ 4 & 1 & 4 \\ 4 & 2 & 8 \\ 4 & 3 & 12 \\ 4 & 4 & 16 \\ 4 & 5 & 20 \\ 4 & 6 & 24 \\ 4 & 7 & 28 \\ 4 & 8 & 32 \\ 4 & 9 & 36 \\ 4 & 10 & 40 \\ 5 & 1 & 5 \\ 5 & 2 & 10 \\ 5 & 3 & 15 \\ 5 & 4 & 20 \\ 5 & 5 & 25 \\ 5 & 6 & 30 \\ 5 & 7 & 35 \\ 5 & 8 & 40 \\ 5 & 9 & 45 \\ 5 & 10 & 50 \\ 6 & 1 & 6 \\ 6 & 2 & 12 \\ 6 & 3 & 18 \\ 6 & 4 & 24 \\ 6 & 5 & 30 \\ 6 & 6 & 36 \\ 6 & 7 & 42 \\ 6 & 8 & 48 \\ 6 & 9 & 54 \\ 6 & 10 & 60 \\ 7 & 1 & 7 \\ 7 & 2 & 14 \\ 7 & 3 & 21 \\ 7 & 4 & 28 \\ 7 & 5 & 35 \\ 7 & 6 & 42 \\ 7 & 7 & 49 \\ 7 & 8 & 56 \\ 7 & 9 & 63 \\ 7 & 10 & 70 \\ 8 & 1 & 8 \\ 8 & 2 & 16 \\ 8 & 3 & 24 \\ 8 & 4 & 32 \\ 8 & 5 & 40 \\ 8 & 6 & 48 \\ 8 & 7 & 56 \\ 8 & 8 & 64 \\ 8 & 9 & 72 \\ 8 & 10 & 80 \\ 9 & 1 & 9 \\ 9 & 2 & 18 \\ 9 & 3 & 27 \\ 9 & 4 & 36 \\ 9 & 5 & 45 \\ 9 & 6 & 54 \\ 9 & 7 & 63 \\ 9 & 8 & 72 \\ 9 & 9 & 81 \\ 9 & 10 & 90 \\ 10 & 1 & 10 \\ 10 & 2 & 20 \\ 10 & 3 & 30 \\ 10 & 4 & 40 \\ 10 & 5 & 50 \\ 10 & 6 & 60 \\ 10 & 7 & 70 \\ 10 & 8 & 80 \\ 10 & 9 & 90 \\ 10 & 10 & 100 \\ \end{array}$$