# How to plot a point in the intersection of two functions?

I'm trying to plot the intersection of a Sum function with a horizontal line and automatically highlight the intersection points. The code below shows my knowledge of Mathematica and for different values of "d" I am calculating with Solve the intersection points (ex p1,p2 and p3) and manually typing the value in the Epilog option. I tried Point[{p1,1}] but it doesn't work. I also tried it with MeshFunctions -> {g[#] - f[#] &}, Mesh -> {{0}}, MeshStyle -> PointSize[Large] but I get an error "functions must be pure functions". I would also like to be able to define the ranges of "d" and "pc" as {d, {min,max,incr}} instead of a list. Thanks in advance.

np = 2
f[pc_] := 1
q[d_, pc_] := (pc/(100*0.48)) *
Sum[((Pi/4)*(d - (2*n*0.48))^2), {n, 1, np}]
p[d_] := Sum[Pi*(d - (2*n - 1)*0.48), {n, 1, np}]
p1 = Solve[q[20, pc]/p == f[pc], pc]
p2 = Solve[q[10, pc]/p == f[pc], pc]
p3 = Solve[q[8, pc]/p == f[pc], pc]
g[d_, pc_] := q[d, pc]/p[d]
Plot[{Evaluate[Table[g[d, pc], {d, {8, 10, 20}}]], f[pc]}, {pc, 0,
50}, PlotRange -> All, AxesLabel -> {"%", "li/lp"},
FrameLabel -> {Style["pc", 12, Bold], Style["li/lp", 12, Bold]},
PlotLabels -> {"d=8", "d=10", "d=20"}, PlotTheme -> "Scientific",
GridLines -> Automatic, PlotLabel -> "Razão comprimentos",
Epilog -> {PointSize[0.02], Point[{10.6053, 1}], Point[{23.6134, 1}],
Point[{31.2426, 1}]}]


np = 2;
f[pc_] = 1;

dmin = 8;
dmax = 24;
dincr = 4;

q[d_, pc_] = (pc/(100*12/25))*
Sum[((Pi/4)*(d - (2*n*12/25))^2), {n, 1, np}] //
Simplify;

p[d_] = Sum[Pi*(d - (2*n - 1)*12/25), {n, 1, np}] //
Simplify;

g[d_, pc_] := q[d, pc]/p[d];

pt[d_] = {pc, f[pc]} /. Solve[g[d, pc] == f[pc], pc][];


Plotting

Plot[{
Evaluate[Table[g[d, pc], {d, dmin, dmax, dincr}]],
f[pc]}, {pc, 0, 50},
PlotRange -> All,
FrameLabel ->
(Style[#, 12, Bold] & /@ {"pc", "li/lp"}),
PlotLabels -> (StringForm["d=", #] & /@
Range[dmin, dmax, dincr]),
PlotTheme -> "Scientific",
GridLines -> Automatic,
PlotLabel -> "Razão comprimentos",
Epilog -> {PointSize[0.02],
Tooltip[Point[#], N[#[]]] & /@
(pt /@ Range[dmin, dmax, dincr])}] EDIT: To vary the level of the line

Manipulate[
pt[d_] = {pc, fpc} /. Solve[g[d, pc] == fpc, pc][];
Plot[{
Evaluate[Table[g[d, pc], {d, dmin, dmax, dincr}]],
fpc}, {pc, 0, 50},
PlotRange -> All,
FrameLabel -> (Style[#, 12, Bold] & /@
{"pc", "li/lp"}),
PlotLabels -> (StringForm["d=", #] & /@
Range[dmin, dmax, dincr]),
PlotTheme -> "Scientific",
GridLines -> Automatic,
PlotLabel -> "Razão comprimentos",
Epilog -> {PointSize[0.02],
Tooltip[Point[#], N[#[]]] & /@
Select[(pt /@ Range[dmin, dmax, dincr]), #[] <= 50 &]}],
{{fpc, 1}, 0.5, 5.5, 0.1, Appearance -> "Labeled"},
SynchronousUpdating -> False] • Hi! Is there a way to specify the pc variation in terms of pcmin,pcmax and pcincr? Jul 25, 2021 at 1:28
• It is not clear what you mean by the "pc variation". pc is the x-axis and is a continuum. Are you instead trying to vary the definition of f[pc]? Jul 25, 2021 at 1:43
• You're right. There is no reason to vary pc. Thanks. Jul 25, 2021 at 1:52
• Your solution is great but unfortunately, my knowledge of Mathematica does not allow me to understand the meaning of the syntax of the line pt[d_] = and the meaning of the symbology "d=", #, /@ & , N[#[]]] & /@ (& /@ Range etc. Are there any book or Wolfram documentation on this? Jul 25, 2021 at 2:01
• Highlight the unknown symbol in the notebook and press F1 on your keyboard for help. Or use the Help menu. Wolfram has online resources, e.g., An Elementary Introduction to the Wolfram Language Jul 25, 2021 at 2:15

Method 1

Here we plot the intersection of three functions g[8,pc], g[10,pc], g[20,pc] respect tof[pc].

For example,if we want to find the intersetion of g[8,pc] and y=f[x] when we plot g[8,pc], we can set the MeshFunction of g[8,pc] to y-f[x],that is MeshFunctions -> {#2 - f[#1] &}, Mesh -> {{0}}

np = 2;
f[pc_] := 1;
q[d_, pc_] := (pc/(100*0.48))*
Sum[((Pi/4)*(d - (2*n*0.48))^2), {n, 1, np}];
p[d_] := Sum[Pi*(d - (2*n - 1)*0.48), {n, 1, np}];
g[d_, pc_] := q[d, pc]/p[d];
plot = Plot[Evaluate[Table[g[d, pc], {d, {8, 10, 20}}]], {pc, 0, 50},
MeshFunctions -> {#2 - f[#1] &}, Mesh -> {{0}},
MeshStyle -> {PointSize[Large], Automatic}, PlotRange -> All,
AxesLabel -> {"%", "li/lp"},
FrameLabel -> {Style["pc", 12, Bold], Style["li/lp", 12, Bold]},
PlotLabels -> {"d=8", "d=10", "d=20"}, PlotTheme -> "Scientific",
GridLines -> Automatic, PlotLabel -> "Razão comprimentos"]

Show[plot, Plot[f[pc], {pc, 0, 50}]] Method 2

On the other hand, we can also set three pure functions Table[Function[pc, g[d, pc] - f[pc] // Evaluate], {d, {8, 10, 20}}]

when we plot f[pc] to get the three intersections.

np = 2;
f[pc_] := 1;
q[d_, pc_] := (pc/(100*0.48))*
Sum[((Pi/4)*(d - (2*n*0.48))^2), {n, 1, np}];
p[d_] := Sum[Pi*(d - (2*n - 1)*0.48), {n, 1, np}];
g[d_, pc_] := q[d, pc]/p[d];

Plot[f[pc], {pc, 0, 50},
MeshFunctions ->
Table[Function[pc, g[d, pc] - f[pc] // Evaluate], {d, {8, 10, 20}}],
Mesh -> {{0}}, MeshStyle -> Directive[PointSize[Large], Red]] Animation

Clear[np, f, q, p, g, plot];
np = 2;
f[pc_] := 1;
q[d_, pc_] := (pc/(100*0.48))*
Sum[((Pi/4)*(d - (2*n*0.48))^2), {n, 1, np}];
p[d_] := Sum[Pi*(d - (2*n - 1)*0.48), {n, 1, np}];
g[d_, pc_] := q[d, pc]/p[d];
plot[c_] :=
Plot[Evaluate[Table[g[d, pc], {d, {8, 10, 20}}]], {pc, 0, 50},
MeshFunctions -> {#2 - f[#1] &}, Mesh -> {{c}},
MeshStyle -> {PointSize[Large], Automatic}, PlotRange -> All,
AxesLabel -> {"%", "li/lp"},
FrameLabel -> {Style["pc", 12, Bold], Style["li/lp", 12, Bold]},
PlotLabels -> {"d=8", "d=10", "d=20"}, PlotTheme -> "Scientific",
GridLines -> Automatic, PlotLabel -> "Razão comprimentos"];
Manipulate[Show[plot[c], Plot[f[pc] + c, {pc, 0, 50}]], {c, -1, 2},
ControlPlacement -> Bottom] 