1
$\begingroup$

I'm new in Mathematica, I want to plot a bifurcation diagram for a complicated Ising system with dynamics that I'm working on, but to get familiar with how to perform it on Mathematica I wish to start with well known mean field approximation

$$m = c\tanh(m)$$

I have no idea how to approach it, what I have so far is:

f1[c_, m_] := c Tanh[m];
f2[m_] := m;
$\endgroup$

2 Answers 2

6
$\begingroup$

With your definitions, I assume you want to solve the equation $m = c\tanh(m)$ for $m$ as a function of the parameter $c$. Here is one way of doing this:

mMax = 100;
f1[c_, m_] := c Tanh[m];
f2[m_] := m;    
mIsing[sign_][c_] := 
 Module[{m}, 
  m /. Quiet[NSolve[f1[c, m] == f2[m] && -mMax < m < mMax, m]][[sign]]]

Plot[{mIsing[1][c], mIsing[-1][c]}, {c, 0, 10}]

bifurcation

The function mIsing has c as a variable and also depends on the parameter sign that can be $\pm 1$ for the upper and lower branch (if they exist). The main part id the numerical solution of the equation in NSolve.

I enclose the solver in a Module to make sure the variable m we're solving for is properly localized. The Quiet is in there to suppress a harmless warning message from the solver. Below the bifurcation, the two solutions are just identical to 0.

A faster way to make the plot (if you only want a plot) is this:

ContourPlot[f1[c, m] == f2[m], {c, 0, 10}, {m, -10, 10}]

bifurc2

$\endgroup$
3
  • $\begingroup$ Actually, zero is a solution for all values of c as shown in the ContourPlot; your approach with Plot leaves off the third solution. Recommend generating data and using ListLinePlot to show all three solutions. $\endgroup$
    – Bob Hanlon
    Commented Oct 11, 2015 at 18:04
  • $\begingroup$ @BobHanlon Yes, I assumed we only want the nonzero solutions after the bifurcation - this illustrates how to select particular branches if desired. That depends on the goal of the question, which is left open... $\endgroup$
    – Jens
    Commented Oct 11, 2015 at 18:25
  • $\begingroup$ @Jens ,thanks , this detailed solution was very helpful $\endgroup$
    – jarhead
    Commented Oct 12, 2015 at 5:52
3
$\begingroup$

This really adds nothing to Jens answer (which I have upvoted). I just post it for fun (and to illustrate utility of MeshShading).

Manipulate[
 Row[{Show[
    Plot[p Tanh[x], {x, -10, 10}, MeshFunctions -> (# - p Tanh[#] &), 
     Mesh -> {{0}}, MeshStyle -> {Red, PointSize[0.02]}, 
     MeshShading -> {Red, Blue}], 
    Plot[x, {x, -10, 10}, PlotStyle -> Dashed], Frame -> True, 
    PlotRange -> {-10, 10}, AspectRatio -> Automatic, 
    ImageSize -> 300],
   ContourPlot[x == r Tanh[x], {r, 0, 10}, {x, -10, 10}, 
    ImageSize -> 300, GridLines -> {{p}, None}, 
    MeshFunctions -> (#1 &), Mesh -> {{p}}, 
    MeshStyle -> {Red, PointSize[0.02]}, PerformanceGoal -> "Quality"]
   }], {p, 0, 10}]

enter image description here

$\endgroup$
4
  • $\begingroup$ Clever. Wonder whether these can be saved as apps for the IPAD....pretty sure these visuals will encourage more students to take maths & physics. $\endgroup$
    – thils
    Commented Oct 12, 2015 at 3:18
  • $\begingroup$ @thils thank you...Mathematica is a wonderful tool to aid understanding...cannot answer iPad question...not enough fun and play in teaching and learning...MSE has taught me a lot so l like to share fun...sometimes I am over the top...so thank you for kind words :-) $\endgroup$
    – ubpdqn
    Commented Oct 12, 2015 at 3:26
  • $\begingroup$ reason I mention IPAD is bcos the schools want students to get one so it is easier to test students for several subjects... $\endgroup$
    – thils
    Commented Oct 12, 2015 at 3:42
  • $\begingroup$ @ubpdqn ,thanks , will work with what you did $\endgroup$
    – jarhead
    Commented Oct 12, 2015 at 5:53

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.