# How can I mark the intersection of lines and curves with letters and coordinate values?

Consider:

ClearAll["*"]
eqs = {x^2/16 + y^2/9 == 1, x == 2 y + 1};
line = eqs[[2]]
ell = eqs[[1]]
pts = SolveValues[{line, ell}, {x, y}];
normalized = First[ell] - Last[ell];
ax = Sqrt[Denominator[Coefficient[normalized, x^2]]]
bx = Sqrt[Denominator[Coefficient[normalized, y^2]]]
(*ass=ResourceFunction["EllipseProperties"][ell,{x,y}];
params={a->ass["SemimajorAxisLength"],b->ass["SemiminorAxisLength"]}*)\
params = {a -> Sqrt[Denominator[Coefficient[normalized, x^2]]],
b -> Sqrt[Denominator[Coefficient[normalized, y^2]]]}
glin = line[[2]] /. params
gell = b {-1, 1} Sqrt[1 - x^2/a^2] /. params;
gpts = pts /. params;
(*Hold@ContourPlot[Evaluate@{eqs},{x,-a-1,a+1},{y,-b-0.5,b+0.5},\
PlotLegends->Placed[eqs,{0.8,0.15}],AspectRatio->Automatic,Frame->\
params//ReleaseHold*)
ContourPlot[
Evaluate@{eqs}, {x, -ax - 1, ax + 1}, {y, -bx - 0.5, bx + 0.5},
Epilog -> {Red, PointSize[0.02], Point[gpts]},
PlotLegends -> Placed[eqs, {0.8, 0.15}], AspectRatio -> Automatic,
Frame -> False, Axes -> True, AxesStyle -> Arrowheads[{0.0, 0.04}],
AxesLabel -> {x, y}]


How can I mark letters (A and B) on the intersection points of lines and curves in the diagram and the coordinate values of the intersection points in the diagram?

Update 1:

Clear["Global*"]
eqs = {x^2/4 + y^2/3 == 1, y == 2 x + 1};
line = eqs[[2]]
ell = eqs[[1]]
pts = SolveValues[{line, ell}, {x, y}];
normalized = First[ell] - Last[ell];
ax = Sqrt[Denominator[Coefficient[normalized, x^2]]]
bx = Sqrt[Denominator[Coefficient[normalized, y^2]]]
p = Plot[y /. Solve[line, y], {x, -ax - 0.5, ax + 0.5}];
pts = SolveValues[{line, ell}, {x, y}]
(*Graphics[{{First@p},{Red,Circle[{0,0},{ax,bx}],Point[{0,0}]},{Blue,\
PointSize[.03],Point[pts]}},Axes->True,AxesLabel->{x,y},AxesStyle->\
(*ContourPlot[Evaluate@{eqs},{x,-ax-1,ax+1},{y,-bx-0.5,bx+0.5},Epilog->\
{Red,PointSize[0.02],Point[pts]},PlotLegends->Placed[eqs,{0.8,0.15}],\
0.0,0.04}],AxesLabel->{x,y}]*)
plx = Apply[Subtract, eqs, {1}];
pls = Numerator[Together[Apply[Subtract, eqs, {1}]]];
xpl = Collect[Resultant[pls[[1]], pls[[2]], y], x];
Collect[Coefficient[xpl, x^2] x^2 +
Factor@FactorTerms[Coefficient[xpl, x], x] x +
Select[xpl, FreeQ[x]], x, # &, Defer[+##]~Reverse~2 &] == 0
Collect[xpl, x, Simplify];
pl = {% == 0}
discx = Factor[Discriminant[xpl, x]]   (*discriminant*)
frist = Solve[eqs, {x, y}] // FullSimplify;
{{x1, y1}, {x2, y2}} = {x, y} /. frist;
second = {x1 + x2, x1 x2, y1 + y2, y1 y2,
y1 y2/(x1 x2), (x1 + x2)/2, (y1 + y2)/2} // FullSimplify
thrid = {x1 x2 + y1 y2, x1 y2 + x2 y1} // FullSimplify
slope = CoefficientList[line[[2]], x][[2]];    (*k*)
intercept = CoefficientList[line[[2]], x][[1]];  (*m*)
Chordlength =
FullSimplify[
Sqrt[1 + slope^2] Sqrt[(x1 + x2)^2 - 4 x1 x2]]    (*AbsAB*)
area = 1/2 Chordlength Sqrt[intercept^2]/Sqrt[slope^2 + 1] //
FullSimplify
Legended[
Show[ContourPlot[
Evaluate[eqs], {x, -ax - 0.5, ax + 0.75}, {y, -bx - 0.5,
bx + 0.75},
PlotLegends ->
Placed[LineLegend[eqs, LegendLayout -> "Column"], Below],
AspectRatio -> Automatic, Frame -> False, Axes -> True,
AxesStyle -> Arrowheads[{0.0, 0.04}], AxesLabel -> {x, y}],
ListPlot[{{Tooltip[Callout[pts[[1]], "A", Before]]}, {Tooltip[
Callout[pts[[2]], "B", Above]]}},
PlotStyle -> {{Red, AbsolutePointSize[4]}, {Purple,
AbsolutePointSize[4]}}]],
Placed[PointLegend[{Red, Purple},
Row /@ Thread[{{"A = ", "B = "}, pts}]], Below]]


Update 2:

ClearAll["*"]
eqs = {x^2/16 + y^2/9 == 1, x == 2 y + 1};
line = eqs[[2]]
ell = eqs[[1]]
pts = SolveValues[{line, ell}, {x, y}];
normalized = First[ell] - Last[ell];
ax = Sqrt[Denominator[Coefficient[normalized, x^2]]]
bx = Sqrt[Denominator[Coefficient[normalized, y^2]]]
p = Plot[y /. Solve[line, y], {x, -ax - 0.5, ax + 0.5}];
pts = SolveValues[{line, ell}, {x, y}]
(*Graphics[{{First@p},{Red,Circle[{0,0},{ax,bx}],Point[{0,0}]},{Blue,\
PointSize[.03],Point[pts]}},Axes->True,AxesLabel->{x,y},AxesStyle->\
(*ContourPlot[Evaluate@{eqs},{x,-ax-1,ax+1},{y,-bx-0.5,bx+0.5},Epilog->\
{Red,PointSize[0.02],Point[pts]},PlotLegends->Placed[eqs,{0.8,0.15}],\
0.0,0.04}],AxesLabel->{x,y}]*)
polyex = Apply[Subtract, eqs, {1}];
polys = Numerator[Together[Apply[Subtract, eqs, {1}]]];
xpoly = Collect[Resultant[polys[[1]], polys[[2]], x], y];
ypl = Collect[xpoly, y, Simplify]
Collect[Coefficient[xpoly, y^2] y^2 +
Factor@FactorTerms[Coefficient[xpoly, y], y] y +
Select[xpoly, FreeQ[y]], y, # &, Defer[+##]~Reverse~2 &] == 0
discx = Factor[Discriminant[xpoly, y]]   (*discriminant*)
frist = Solve[eqs, {x, y}] // FullSimplify;
{{x1, y1}, {x2, y2}} = {x, y} /. frist;
second = {x1 + x2, x1 x2, y1 + y2, y1 y2} // FullSimplify
thrid = {x1 x2 + y1 y2, x1 y2 + x2 y1} // FullSimplify
slope = -CoefficientList[polyex[[2]], y][[2]];    (*k*)
intercept = -CoefficientList[CoefficientList[polyex[[2]], y][[1]],
x][[1]] ;  (*m*)
Chordlength =
FullSimplify[
Sqrt[1 + slope^2] Sqrt[(y1 + y2)^2 - 4 y1 y2]]    (*AbsAB*)
Legended[
Show[ContourPlot[
Evaluate[eqs], {x, -ax - 0.5, ax + 0.75}, {y, -bx - 0.5,
bx + 0.75},
PlotLegends ->
Placed[LineLegend[eqs, LegendLayout -> "Column"], Below],
AspectRatio -> Automatic, Frame -> False, Axes -> True,
AxesStyle -> Arrowheads[{0.0, 0.04}], AxesLabel -> {x, y}],
ListPlot[{{Tooltip[Callout[pts[[1]], "A", Before]]}, {Tooltip[
Callout[pts[[2]], "B", Above]]}},
PlotStyle -> {{Red, AbsolutePointSize[4]}, {Purple,
AbsolutePointSize[4]}}]],
Placed[PointLegend[{Red, Purple},
Row /@ Thread[{{"A = ", "B = "}, pts}]], Below]]


Update 3:

Clear["Global*"]
eqs = {x^2/4 + y^2/3 == 1, y == 2 x + 1};
line = eqs[[2]]
ell = eqs[[1]]
pts = SolveValues[{line, ell}, {x, y}];
normalized = First[ell] - Last[ell];
ax = Sqrt[Denominator[Coefficient[normalized, x^2]]]
bx = Sqrt[Denominator[Coefficient[normalized, y^2]]]
p = Plot[y /. Solve[line, y], {x, -ax - 0.5, ax + 0.5}];
pts = SolveValues[{line, ell}, {x, y}]
(*Graphics[{{First@p},{Red,Circle[{0,0},{ax,bx}],Point[{0,0}]},{Blue,\
PointSize[.03],Point[pts]}},Axes->True,AxesLabel->{x,y},AxesStyle->\
(*ContourPlot[Evaluate@{eqs},{x,-ax-1,ax+1},{y,-bx-0.5,bx+0.5},Epilog->\
{Red,PointSize[0.02],Point[pts]},PlotLegends->Placed[eqs,{0.8,0.15}],\
0.0,0.04}],AxesLabel->{x,y}]*)
plx = Apply[Subtract, eqs, {1}];
pls = Numerator[Together[Apply[Subtract, eqs, {1}]]];
xpl = Collect[Resultant[pls[[1]], pls[[2]], y], x];
Collect[Coefficient[xpl, x^2] x^2 +
Factor@FactorTerms[Coefficient[xpl, x], x] x +
Select[xpl, FreeQ[x]], x, # &, Defer[+##]~Reverse~2 &] == 0
Collect[xpl, x, Simplify];
pl = {% == 0}
discx = Factor[Discriminant[xpl, x]]   (*discriminant*)
frist = Solve[eqs, {x, y}] // FullSimplify;
{{x1, y1}, {x2, y2}} = {x, y} /. frist;
second = {x1 + x2, x1 x2, y1 + y2, y1 y2,
y1 y2/(x1 x2), (x1 + x2)/2, (y1 + y2)/2} // FullSimplify
thrid = {x1 x2 + y1 y2, x1 y2 + x2 y1} // FullSimplify
slope = CoefficientList[line[[2]], x][[2]];    (*k*)
intercept = CoefficientList[line[[2]], x][[1]];  (*m*)
Chordlength =
FullSimplify[
Sqrt[1 + slope^2] Sqrt[(x1 + x2)^2 - 4 x1 x2]]    (*AbsAB*)
area = 1/2 Chordlength Sqrt[intercept^2]/Sqrt[slope^2 + 1] //
FullSimplify
Legended[
Show[ContourPlot[
Evaluate[eqs], {x, -ax - 0.5, ax + 0.75}, {y, -bx - 0.5,
bx + 0.75},
PlotLegends ->
Placed[LineLegend[eqs, LegendLayout -> "Column"], Below],
AspectRatio -> Automatic, Frame -> False, Axes -> True,
AxesStyle -> Arrowheads[{0.0, 0.04}], AxesLabel -> {x, y},
ImageSize -> 500],
ListPlot[{{Tooltip[Callout[pts[[1]], "A", Before]]}, {Tooltip[
Callout[pts[[2]], "B", Above]]}},
PlotStyle -> {{Red, AbsolutePointSize[4]}, {Purple,
AbsolutePointSize[4]}}]],
Placed[PointLegend[{Red, Purple},
Row /@ Thread[{{"A = ", "B = "}, pts}]], Below]]


Update 4:

This method only displays the coordinates of the intersection point, and the adaptive size

ContourPlot[
Evaluate@{eqs}, {x, -ax - 1, ax + 1}, {y, -bx - 0.5, bx + 0.5},
Epilog -> {Red, PointSize[0.02], Point[pts], Black,
Text[Framed[Column[{pts[[1, 1]], pts[[1, 2]]}],
Background -> White], {pts[[1, 1]], pts[[1, 2]]}, {.15, 1.1}],
Text[Framed[Column[{pts[[1, 1]], pts[[1, 2]]}],
Background -> White], {pts[[2, 1]],
pts[[2, 2]]}, {-0.01, -1.4}]},
PlotLegends -> Placed[eqs, {0.13, 0.9}], AspectRatio -> Automatic,
Frame -> False, Axes -> True, AxesStyle -> Arrowheads[{0.0, 0.04}],
AxesLabel -> {x, y}, ImageSize -> Full]

• Look at "Text" in the help. Eventually you are also interested in "Style Commented Feb 21, 2023 at 13:17

Clear["Global*"]

line = x == 2 y + 1;
ell = x^2/16 + y^2/9 == 1;
eqs = {ell, line};
pts = SolveValues[{line, ell}, {x, y}];
normalized = First[ell] - Last[ell];
ax = Sqrt[Denominator[Coefficient[normalized, x^2]]];
bx = Sqrt[Denominator[Coefficient[normalized, y^2]]];
params = {a -> Sqrt[Denominator[Coefficient[normalized, x^2]]],
b -> Sqrt[Denominator[Coefficient[normalized, y^2]]]};

Legended[
Show[
ContourPlot[
Evaluate[eqs], {x, -ax - 0.5, ax + 0.75}, {y, -bx - 0.5,
bx + 0.75}, PlotLegends -> Placed[
LineLegend[eqs, LegendLayout -> "Column"],
Below],
AspectRatio -> Automatic, Frame -> False, Axes -> True,
AxesStyle -> Arrowheads[{0.0, 0.04}], AxesLabel -> {x, y}],
ListPlot[{
{Tooltip[Callout[pts[[1]], "A", Before]]},
{Tooltip[Callout[pts[[2]], "B", Above]]}},
PlotStyle -> {{Red, AbsolutePointSize[4]}, {Green,
AbsolutePointSize[4]}}]],
Placed[
PointLegend[{Red, Green}, Row /@ Thread[{{"A = ", "B = "}, N[pts]}]],
Below]]


• Can the coordinate value of the intersection point show the exact value? Displays exact values instead of decimal values. With a root sign or something Commented Feb 21, 2023 at 23:20
• Placed[PointLegend[{Red, Green}, Row /@ Thread[{{"A = ", "B = "}, pts}]], Below]] Commented Feb 21, 2023 at 23:32
• How to adjust the size of A and B in the figure? Commented Feb 22, 2023 at 11:29
• Use Style (see docs) Commented Feb 22, 2023 at 15:52

ContourPlot[
Evaluate@{eqs},
{x, -ax - 1, ax + 1},
{y, -bx - 0.5, bx + 0.5},
Epilog -> {
Red,
PointSize[0.02],
Point[gpts],
Black,
Text[Framed[Column[{gpts[[1, 1]], gpts[[1, 2]]}],
Background -> White], {gpts[[1, 1]], gpts[[1, 2]]}, {2.2, -1.1}],
Text[Framed[Column[{gpts[[1, 1]], gpts[[1, 2]]}],
Background -> White], {gpts[[2, 1]],
gpts[[2, 2]]}, {-0.5, -2.7}]},
PlotLegends -> Placed[eqs, {0.13, 0.9}],
AspectRatio -> 1,
Frame -> False,
Axes -> True,
AxesLabel -> {x, y},
ImageSize -> Full]


Original

Code

ContourPlot[
Evaluate@{eqs},
{x, -ax - 1, ax + 1},
{y, -bx - 0.5, bx + 0.5},
Epilog -> {
Red, PointSize[0.02], Point[gpts],
Black,
Text[Framed[Column[{gpts[[1, 1]], gpts[[1, 2]]}],
Background -> White], {gpts[[1, 1]], gpts[[1, 2]]}, {.15, 1.1}],
Text[Framed[Column[{gpts[[1, 1]], gpts[[1, 2]]}],
Background -> White], {gpts[[2, 1]],
gpts[[2, 2]]}, {-0.01, -1.4}]},
PlotLegends -> Placed[eqs, {0.13, 0.9}],
AspectRatio -> 1,
Frame -> False,
Axes -> True,
AxesLabel -> {x, y},
ImageSize -> 300]

• ContourPlot[ Evaluate@{eqs}, {x, -ax - 3, ax + 3}, {y, -bx - 3, bx + 3}, Epilog -> {Red, PointSize[0.02], Point[pts], Black, Text[Framed[Column[{pts[[1, 1]], pts[[1, 2]]}], Background -> White], {pts[[1, 1]], pts[[1, 2]]}, {.15, 1.1}], Text[Framed[Column[{pts[[1, 1]], pts[[1, 2]]}], Background -> White], {pts[[2, 1]], pts[[2, 2]]}, {-0.01, -1.4}]}, PlotLegends -> Placed[eqs, {0.13, 0.9}], AspectRatio -> Automatic, Frame -> False, Axes -> True, AxesStyle -> Arrowheads[{0.0, 0.04}], AxesLabel -> {x, y}, ImageSize -> 300] Commented Feb 21, 2023 at 23:28
• Can pictures adapt to size? That is to say, the image can be automatically resized so that the coordinate value and image of the point can be displayed completely Commented Feb 21, 2023 at 23:37
• @csn899 have a look at the edit, please. is this what you meant?
– bmf
Commented Feb 22, 2023 at 1:25
• ContourPlot[ Evaluate@{eqs}, {x, -ax - 1, ax + 1}, {y, -bx - 0.5, bx + 0.5}, Epilog -> {Red, PointSize[0.02], Point[pts], Black, Text[Framed[Column[{pts[[1, 1]], pts[[1, 2]]}], Background -> White], {pts[[1, 1]], pts[[1, 2]]}, {.15, 1.1}], Text[Framed[Column[{pts[[1, 1]], pts[[1, 2]]}], Background -> White], {pts[[2, 1]], pts[[2, 2]]}, {-0.01, -1.4}]}, PlotLegends -> Placed[eqs, {0.13, 0.9}], AspectRatio -> Automatic, Frame -> False, Axes -> True, AxesStyle -> Arrowheads[{0.0, 0.04}], AxesLabel -> {x, y}, ImageSize -> 450] Commented Feb 22, 2023 at 8:08
• @csn899 I am sorry, but you are just showing some code and I don't understand what point you're trying to make
– bmf
Commented Feb 22, 2023 at 8:10
Clear["Global*"]
eq1 = x^2/16 + y^2/9 == 1;
eq2 = x == 2 y + 1;
pts = Solve[{eq1, eq2}, {x, y}];
sf = StringForm["(,)", NumberForm[x, {4, 2}],
NumberForm[y, {4, 2}]] /. pts // N;
valp = {x, y} /. pts;
ofs = {{1.2, 0}, {-1.2, 0}};
ContourPlot[{eq1, eq2} // Evaluate
, {x, -5, 5}, {y, -4, 4}
, AspectRatio -> Automatic
, Frame -> False
, Axes -> True
, AxesLabel -> {x, y}
, Ticks -> {Range[-6, 6], Range[-4, 4]}
, {-0.04, 0.04}]
, ImageSize -> 500
, Epilog -> {Red, AbsolutePointSize[6]
, Tooltip[Point[#], #] & /@ valp
, Black,
Text[Style[#1, 12, FontFamily -> "Courier"], #2, #3] &, {sf, valp,
ofs}]
, Black, MapThread[Text[#1, #2, {-0.2, -1.5}] &, {{"A", "B"}, valp}]
}
]


• Can the coordinate value of the intersection point show the exact value? Displays exact values instead of decimal values. With a root sign or something Commented Feb 21, 2023 at 23:23
• NumberForm[y, {4, 2}]] /. pts Commented Feb 21, 2023 at 23:33
• Can pictures adapt to size? That is to say, the image can be automatically resized so that the coordinate value and image of the point can be displayed completely Commented Feb 21, 2023 at 23:47
• Text does not scale as far as I understand it. You can drag and scale the image, but the text size will be constant. You could do additional processing and determine the bounding box, but it will change from function to function.
– Syed
Commented Feb 22, 2023 at 3:24
Clear[f, g, A, B];
g = x - (2 y + 1);
f = x^2/4^2 + y^2/3^2 - 1;
{A, B} = SolveValues[{f == 0, g == 0}, {x, y}, Reals];
Legended[
ContourPlot[{f == 0, g == 0}, {x, -4, 4}, {y, -4, 4},
Epilog -> {{Red, AbsolutePointSize[8], Point[A]},
Arrow[{A + {-.5, -1}, A}],
Text[Style["A", 14], A + {-.5, -1}, {.5, 1}],
Arrow[{A + {-.5, -1}, A}], {Green, AbsolutePointSize[8],
Point[B]}, Arrow[{B + {.5, 1}, B}],
Text[Style["B", 14], B + {.5, 1}, -{.5, 1}]},
PlotRangePadding -> .6, Frame -> False, Axes -> True,

• g = x - (2 y + 1); f = x^2/4^2 + y^2/3^2 - 1;I want to input the equation in the form of complete straight line equation and curve equation at the beginning Commented Feb 22, 2023 at 8:15