# Bifurcation diagram for 1D ising model

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;


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


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


• 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. Oct 11, 2015 at 18:04
• @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...
– Jens
Oct 11, 2015 at 18:25
• @Jens ,thanks , this detailed solution was very helpful Oct 12, 2015 at 5:52

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


• Clever. Wonder whether these can be saved as apps for the IPAD....pretty sure these visuals will encourage more students to take maths & physics. Oct 12, 2015 at 3:18
• @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 :-) Oct 12, 2015 at 3:26
• reason I mention IPAD is bcos the schools want students to get one so it is easier to test students for several subjects... Oct 12, 2015 at 3:42
• @ubpdqn ,thanks , will work with what you did Oct 12, 2015 at 5:53