# Solving and plotting roots of a transcendental equation against a log-spaced parameter

I want to plot K0 against β. In order to find the roots Subscript[α, n] of the transcendental equation, I need to substitute the parameter β that takes on values on the log scale.

β = 0.01, 0.1, 1, 10, 100

eqn = Subscript[α, n]*
BesselJ[1, Subscript[α, n]] == β*BesselJ[0, Subscript[α, n]];

roots = FindRoot[eqn, {Subscript[α, n], #}] & /@ Range[1]

K0 = roots^2


I am stuck here since I don't know how to remove the arrow in K0 (which the arrow come from the solution of FindRoot). K0 should be the square root of the root (differ for each value of β ).

I did the calculation for K0 manually. I want to plot as listed below K0 against β but I don't know how to ask Mathematica to list the answer in table and plot the graph.

 β = 0.01, α, n = 0.1412, K0 = (0.1412)^2 = 0.0199
β = 0.1,  α, n = 0.4417, K0 = (0.4417)^2 = 0.1951
β = 1,    α, n = 1.2558, K0 = (1.2558)^2 = 1.5770
β = 10,   α, n = 2.1795, K0 = (2.1795)^2 = 4.7502
β = 100,  α, n = 2.3809, K0 = (2.3809)^2 = 5.6687


β = {0.01, 0.1, 1, 10, 100}
eqns = Subscript[α, n]*BesselJ[1, Subscript[α, n]] == #*
BesselJ[0, Subscript[α, n]] & /@ β
roots = FindRoot[#, {Subscript[α, n], 1}] & /@ eqns


$$\left\{\left\{\alpha _n\to 0.141245\right\},\left\{\alpha _n\to 0.441682\right\},\left\{\alpha _n\to 1.25578\right\},\left\{\alpha _n\to 2.1795\right\},\left\{\alpha _n\to 2.3809\right\}\right\}$$

K0 = Subscript[α, n]^2 /. roots


{0.0199501, 0.195083, 1.57699, 4.75021, 5.66869}

ListPlot[Transpose[{K0, β}]
, Joined -> True
, PlotStyle -> Red
, MeshStyle -> Blue
, Mesh -> All
, ScalingFunctions -> {None, "Log"}
, AxesLabel -> {"K0", "β"}
, Ticks -> {Range[1, 6, 1], PowerRange[0.01, 100]}
, GridLines -> {Range[1, 6, 1], PowerRange[0.01, 100]}
, GridLinesStyle -> {{Gray, Dotted}, {Gray, Dotted}}
]


EDIT1-To flip axes

ListPlot[Transpose[{β, K0}]
, Joined -> True
, PlotStyle -> Red
, MeshStyle -> Blue
, Mesh -> All
, ScalingFunctions -> {"Log", None}
, AxesLabel -> {"β", "K0"}
, Ticks -> {PowerRange[0.01, 100], Range[1, 6, 1]}
, GridLines -> {PowerRange[0.01, 100], Range[1, 6, 1]}
, GridLinesStyle -> {{Gray, Dotted}, {Gray, Dotted}}
, PlotRange -> {{0.01, 110}, {-0.5, 6}}
]


EDIT2-To draw a smooth curve

Using InterpolationOrder:

p1 = ListPlot[Transpose[{β, K0}]
, Joined -> True
, PlotStyle -> Directive[Dotted, Black]
, ScalingFunctions -> {"Log", None}
, AxesLabel -> {"β", "K0"}
, Ticks -> {PowerRange[0.01, 100], Range[1, 6, 1]}
, GridLines -> {PowerRange[0.01, 100], Range[1, 6, 1]}
, GridLinesStyle -> {{Gray, Dotted}, {Gray, Dotted}}
, PlotRange -> {{0.01, 110}, {-0.5, 6}}
, InterpolationOrder -> 1
, Epilog -> { Black, AbsolutePointSize[6],
Point@Transpose[{Log@β, K0}]
}
];

p2 = ListPlot[Transpose[{β, K0}]
, Joined -> True
, PlotStyle -> Directive[Thin, Blue]
, ScalingFunctions -> {"Log", None}
, AxesLabel -> {"β", "K0"}
, Ticks -> {PowerRange[0.01, 100], Range[1, 6, 1]}
, GridLines -> {PowerRange[0.01, 100], Range[1, 6, 1]}
, GridLinesStyle -> {{Gray, Dotted}, {Gray, Dotted}}
, PlotRange -> {{0.01, 110}, {-0.5, 6}}
, InterpolationOrder -> 2
];

Show[p1, p2]


• Thanks a lot. However if I want the graph to be smooth curvy graph not like straight line as you did, is it possible ?
– Aifa
Commented Nov 9, 2022 at 7:10
• @Aifa, I have updated the answer. In this last case, I have not used Mesh for this variation. You can choose to draw one or both curves. The code can be made more concise, but at the cost of readability, so I have chosen to plot p1,p2 separately.
– Syed
Commented Nov 9, 2022 at 7:31
• Thank you so much, you really help me to solve this :)
– Aifa
Commented Nov 9, 2022 at 7:45

Edit

It is recommend to use ContourPlot.

ContourPlot[
a*BesselJ[1, a] == b*BesselJ[0, a], {b, 0, 100}, {a, 0, 6},
PlotPoints -> 50, MaxRecursion -> 4,
FrameLabel -> {"β", "K0"}] /. {b_Real, a_Real} :> {b, a^2}


Original

Maybe like this.

Clear[α, b, β, sol, roots];
β = {0.01, 0.1, 1, 10, 100};
sol = α /.
Table[FindRoot[α*BesselJ[1, α] ==
b*BesselJ[0, α], {α, 1}], {b, β}]
roots = sol^2;
ListPlot[Thread@{β, roots}, AxesLabel -> {"β", "K0"}]


• Thanks a lot. However when I tried to replicate, it doesn't plot anything only the axis. I'm using Mathematica 12.0
– Aifa
Commented Nov 9, 2022 at 6:46
• @Aifa a typo, fixed now. Commented Nov 9, 2022 at 6:51
• sorry for troubling again, can you help to change the axis K0 against [Beta] and if I want the graph to be smooth curvy graph, if using ListPlot or ListLinePlot will not produce that graph isn't? I want a smooth curvy graph that connected all the points. Thank you so much ;)
– Aifa
Commented Nov 9, 2022 at 7:01
• Thank you so much :)
– Aifa
Commented Nov 9, 2022 at 7:46
• @Aifa Take cvgmt's first advice and try ContourPlot[ a*BesselJ[1, a] == b*BesselJ[0, a], {b, 0, 100}, {a, 0, 6}, PlotPoints -> 50, MaxRecursion -> 4, ScalingFunctions -> {"Log", None}, FrameLabel -> {"Log[\[Beta]]", "K0"}] /. {b_Real, a_Real} :> {b, a^2} Commented Nov 9, 2022 at 8:54
\$Version

(* "13.1.0 for Mac OS X x86 (64-bit) (June 16, 2022)" *)

Clear["Global*"]

Format[αn] := Subscript[α, n]

eqn[β_] = αn*BesselJ[1, αn] == β*BesselJ[0, αn];

βValues = {0.01, 0.1, 0.2, 0.5, 0.75, 1, 2, 5, 7.5, 10, 20, 50,
75, 100};

root[β_?NumericQ] := αn /. FindRoot[eqn[β], {αn, 1}]

Grid[
Prepend[
tab = {#, r = root[#], r^2} & /@ βValues,
{β, αn, K0}],
Frame -> All]


ListLinePlot[tab[[All, {1, 3}]], AxesLabel -> {β, K0}]
`

• Thanks for the help :)
– Aifa
Commented Nov 11, 2022 at 6:57