# Label intersection points of several curves

I'm trying to label all intersection points between 2 functions and a 3rd one in a Plot by using Kuba's second solution from here , but I'm not getting the expected result: there are additional, wrong intersection points and the label letters are not correct positioned. What I'm doing wrong?

opts = {ImageSize -> Large, PlotRange -> {{-3, 3}, {-3, 5}},
PlotPoints -> 84, MaxRecursion -> 9,
MeshFunctions -> {f1[#1] - f3[#1] &, f2[#1] - f3[#1] &},
Mesh -> {{0.}}, MeshStyle -> {Directive[Red, PointSize[Medium]]}};
points = Join[{x, f1[x]} /.
NSolve[f1[x] == f3[x] && -3 < x < 3, x, Reals], {x, f2[x]} /.
NSolve[f2[x] == f3[x] && -3 < x < 3, x, Reals]];
names = FromCharacterCode /@ (Range[Length@points] +
96);
Row[{Plot[{f1[p], f2[p], f3[p]}, {p, -3, 3}, Evaluate@opts,
Epilog -> (Text[Style[#, 15], #2 + {.5, 0}] & @@@
Transpose[{names, points}])],


What I'm getting:

Generalizing to a variable number of functions

n = 3; (* number of functions *)

f[1][x_] := 1/2 x;
f[2][x_] := Cos[5 x];
f[3][x_] := x^2 - 2;

points =
SortBy[
Flatten[
({x, #[[1]]} /.
NSolve[#, x, Reals]) & /@
(Equal @@@
Subsets[f[#][x] & /@ Range[n], {2}])
, 1]
, First];

opts = {
Frame -> True
, FrameLabel ->
((Style[#, Blue, 15, Bold] // TraditionalForm) & /@
{x,
f[x]})
, Axes -> False
, ImageSize -> 432
, PlotRange -> {{-3, 3}, {-2.5, 2}}
, PlotLegends ->
Placed[f[#][x] & /@ Range[n], Above]};

names = FromCharacterCode /@ (Range[
Length@points] + ToCharacterCode["a"][[1]] - 1);

Column[{
Plot[
Evaluate[f[#][x] & /@ Range[n]]
, {x, -3, 3},
Evaluate@opts
, Epilog -> ({Black
, Text[Style[#, 15, Bold], #2, {-1, -1}]
, Red
, AbsolutePointSize[4]
, Point[#2]} & @@@
Transpose[{names, points}])]
, Grid[
Prepend[
Flatten /@ Transpose@{names, points},
{"Label", "x", "y"}]
, Frame -> All]}
, Alignment -> Center]


Well, the answer of cuba is not directly applicable for 3 functions. That is the reason. When you want to draw points, why don't you do it directly in Epilog where you create the positions of the labels anyway. No need to give you a hard time with Mesh:

f1[x_] := 1/2 x;
f2[x_] := Cos[5 x];
f3[x_] := x^2 - 2;

opts = {ImageSize -> Large, PlotRange -> {{-3, 3}, {-3, 5}}};

names = FromCharacterCode /@ (Range[Length@points] + 96);
Plot[{f1[p], f2[p], f3[p]}, {p, -3, 3}, Evaluate@opts,
Epilog -> ({Black, Text[Style[#, 15], #2 + {0.05, 0.2}], Red,
Point[#2]} & @@@ Transpose[{names, points}])]


• harlirutan gave you the primary answer where you need to add {x, f1[x]} /. NSolve[f1[x] == f2[x] && -3 < x < 3, x, Reals] to your computation of points and then remove the complex Mesh from the graphics. Epilog works fine. Another approach is to use Show to join graphics. Show[ Plot[{f1[p], f2[p], f3[p]}, {p, -3, 3}, Evaluate@opts], ListPlot[points, PlotStyle -> {Red, PointSize[Large]}], Graphics[ Text[Style[#, 15], #2 + {.5, 0}] & @@@ Transpose[{names, points}] ] ] Sep 10, 2015 at 15:49
• @JackLaVigne Just post your comment as separate answer. Everyone would welcome some diversity! Sep 10, 2015 at 15:53