1
$\begingroup$

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
Improve this question
$\endgroup$

3 Answers 3

Reset to default
3
$\begingroup$ 
β = {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}} ]

enter image description here

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}} ]

enter image description here

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]

enter image description here

Improve this answer
$\endgroup$
3
  • $\begingroup$ Thanks a lot. However if I want the graph to be smooth curvy graph not like straight line as you did, is it possible ? $\endgroup$ Commented Nov 9, 2022 at 7:10
  • $\begingroup$ @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. $\endgroup$ Commented Nov 9, 2022 at 7:31
  • $\begingroup$ Thank you so much, you really help me to solve this :) $\endgroup$ Commented Nov 9, 2022 at 7:45
4
$\begingroup$ 
$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]

enter image description here

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

enter image description here

Improve this answer
$\endgroup$
1
  • $\begingroup$ Thanks for the help :) $\endgroup$ Commented Nov 11, 2022 at 6:57
4
$\begingroup$

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}

enter image description here

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"}]

enter image description here

Improve this answer
$\endgroup$
7
  • $\begingroup$ Thanks a lot. However when I tried to replicate, it doesn't plot anything only the axis. I'm using Mathematica 12.0 $\endgroup$ Commented Nov 9, 2022 at 6:46
  • $\begingroup$ @Aifa a typo, fixed now. $\endgroup$ Commented Nov 9, 2022 at 6:51
  • $\begingroup$ 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 ;) $\endgroup$ Commented Nov 9, 2022 at 7:01
  • $\begingroup$ Thank you so much :) $\endgroup$ Commented Nov 9, 2022 at 7:46
  • $\begingroup$ @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} $\endgroup$ Commented Nov 9, 2022 at 8:54

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.