# Solve transcendental equation and plot the roots

I am practicing solving the following transcendental equation in Mathematica:

(a/c)*Sqrt[(b*m1)^2-(p*c)^2]-ArcTan[Sqrt[((p*c)^2-(b*m2)^2)/((b*m1)^2-(p*c)^2)]]-
ArcTan[Sqrt[((p*c)^2-(b*m3)^2)/((b*m1)^2-(p*c)^2)]] == r*Pi


here

a=1x10^-6; c= 3x10^8; m1=2.2; m2=1.5; m3=1;


I was trying to plot "p" vs "b" where "b" runs from 0 to 3x10^15 and r is a parameter that takes values of 0, 1 and 2. I already tried all day but I cannot find solution, I tried with FindRoot without success, can you give any suggestion?

a = 10^-6; c = 3*^8; m1 = 11/5; m2 = 3/2; m3 = 1;

eqn = (a/c)*Sqrt[(b*m1)^2 - (p*c)^2] -
ArcTan[Sqrt[((p*c)^2 - (b*m2)^2)/((b*m1)^2 - (p*c)^2)]] -
ArcTan[Sqrt[((p*c)^2 - (b*m3)^2)/((b*m1)^2 - (p*c)^2)]] == r*Pi;


EDIT: To find the function domain (i.e., LHS of eqn is real)

fd = Reduce[FunctionDomain[{eqn[[1]], b >= 0, p >= 0}, {b, p}], {b, p}]

(* b > 0 && b/200000000 <= p < (11 b)/1500000000 *)

Show[RegionPlot[fd, {b, 0, 3*^15}, {p, 10^5, 10^7},
PlotStyle -> Opacity[0.1], BoundaryStyle -> None],
ContourPlot[
Evaluate@Table[eqn, {r, 0, 2}], {b, 0, 3*^15}, {p, 10^5, 10^7},
PlotLegends ->
Placed[StringForm["r = ", #] & /@ Range[0, 2], {0.75, 0.25}]],
FrameLabel -> (Style[#, 14, Bold] & /@ {b, p})]


There are an infinite number of {b, p} values on each curve (i.e., for each value of r). Select a value of b then select an initial value for p for use in FindRoot

FindRoot[eqn /. { r -> 0, b -> 10^15}, {p, 6*^6}]

(* {p -> 6.95393*10^6} *)

FindRoot[eqn /. { r -> 1, b -> 12*^14}, {p, 7*^6}]

(* {p -> 7.38373*10^6} *)

FindRoot[eqn /. { r -> 2, b -> 18*^14}, {p, 10^7}]

(* {p -> 1.06722*10^7} *)


EDIT 2: Example for r = 0. Define pEst[b] for estimate of p in FindRoot

pEst[b_] =
s*b + i /.
FindFit[{{2*^14,
p /. FindRoot[eqn /. {r -> 0, b -> 2*^14}, {p, 10^6},
WorkingPrecision -> 20]}, {13*^14,
p /. FindRoot[eqn /. {r -> 0, b -> 13*^14}, {p, 95*^5},
WorkingPrecision -> 20]}}, s*b + i, {s, i}, b];


Generate data for ListLinePlot

data = Table[{b, p /. FindRoot[eqn /. r -> 0, {p, pEst[b]},
WorkingPrecision -> 20]}, {b, 2*^14, 15*^14, 10^14}] // N

(* {{2.*10^14, 1.05947*10^6}, {3.*10^14, 1.72713*10^6}, {4.*10^14,
2.44625*10^6}, {5.*10^14, 3.18773*10^6}, {6.*10^14,
3.93841*10^6}, {7.*10^14, 4.6924*10^6}, {8.*10^14, 5.44702*10^6}, {9.*10^14,
6.20104*10^6}, {1.*10^15, 6.95393*10^6}, {1.1*10^15,
7.70553*10^6}, {1.2*10^15, 8.45578*10^6}, {1.3*10^15,
9.20476*10^6}, {1.4*10^15, 9.95254*10^6}, {1.5*10^15, 1.06992*10^7}} *)


Plot the data

ListLinePlot[data,
Frame -> True, Axes -> False,
PlotRange -> {{0, 3*^15}, {0, 10^7}},
AspectRatio -> 1,
FrameLabel -> (Style[#, 14, Bold] & /@ {b, p})]


However, using ContourPlot as shown earlier is more straightforward.

• why the line solutions are discontinues? because I compare your plot with the reported solution and all are continues and begin on zero Commented Jun 13, 2018 at 11:13
• @yhiel - See edit. Verify your equation and/or reported solution. Commented Jun 13, 2018 at 15:31
• I see my mistake you are right, but I have a dout I trying to solve this with FindRoot Table[FindRoot[Eqn] and obtain all values for b and create a list to plotting Commented Jun 15, 2018 at 0:46