The Ising Model

Create a random grid

Create a random n ×n grid of +1 and -1 values. Set all of the edge values to +1.

n=10;
grid=RandomChoice[{-1,1},{n,n}]
Image[grid,ImageSize->Tiny]
(* set boundary entries to 1*)
Do[grid[[1,j]]=1;grid[[n,j]]=1,{j,1,n}];
Do[grid[[i,1]]=1;grid[[i,n]]=1,{i,2,n-1}];
Framed[Image[grid,ImageSize->Tiny],FrameMargins->0]

For a grid g, define f(g) to be the number of pairs of neighboring entries with the same value.

f[g_]:=Module[
{total=0,n=Length[g]},
(* examine vertical pairs *)
Do[
If[g[[i,j]]==g[[i+1,j]],total+=1(*;Print[{i,j}]*)]
,{i,1,n-1},{j,1,n}];
(* examine horizontal pairs *)
Do[
If[g[[i,j]]==g[[i,j+1]],total+=1(*;Print[{i,j}]*)]
,{i,1,n},{j,1,n-1}];
(* return total *) 
total
]

f[grid]

Define the weight of the grid to be weight(g)=(e^(β f(g))) for some constant β>=0.

weight[g_,β_]:=Exp[β*f[g]]

weight[grid,0.5]

Define the magnetization of the grid to be the sum of all its entries divided by its area.

mag[g_]:=((Total[g,2])/((Length[g])^2))

mag[grid]

Markov chains of grids

A transition from one grid to another flips a random entry.

{i,j}=RandomInteger[{2,n-1},2]
f[grid]
Framed[Image[grid,ImageSize->Tiny],FrameMargins->0]
grid[[i,j]]=-1*grid[[i,j]]
f[grid]
Framed[Image[grid,ImageSize->Tiny],FrameMargins->0]

How do  transitions affect the weight of a grid?

{i,j}=RandomInteger[{2,n-1},2]
f[grid]
Framed[Image[grid,ImageSize->Tiny],FrameMargins->0]

(* compute Δf *)
Δf=0;
If[grid[[i,j]]==grid[[i-1,j]],Δf-=1,Δf+=1];
If[grid[[i,j]]==grid[[i+1,j]],Δf-=1,Δf+=1];
If[grid[[i,j]]==grid[[i,j-1]],Δf-=1,Δf+=1];
If[grid[[i,j]]==grid[[i,j+1]],Δf-=1,Δf+=1];
Print[Δf]

grid[[i,j]]=-1*grid[[i,j]];
f[grid]
Framed[Image[grid,ImageSize->Tiny],FrameMargins->0]

Now generate a Markov chain of grids

(* set parameters *)
n=25;
steps=10000;
chain=Table[0,steps];
β=2;

(* randomly generate an initial grid *)
grid=RandomChoice[{-1,1},{n,n}];
(* set boundary entries to 1*)
Do[grid[[1,j]]=1;grid[[n,j]]=1,{j,1,n}];
Do[grid[[i,1]]=1;grid[[i,n]]=1,{i,2,n-1}];

(* generate the Markov chain *)
Do[
(* first select a proposed transition *)
{i,j}=RandomInteger[{2,n-1},2];
prop=grid;
prop[[i,j]]=-1*prop[[i,j]];

(* compute the change in weight if the proposal is accepted *)
Δf=0;
If[grid[[i,j]]==grid[[i-1,j]],Δf-=1,Δf+=1];
If[grid[[i,j]]==grid[[i+1,j]],Δf-=1,Δf+=1];
If[grid[[i,j]]==grid[[i,j-1]],Δf-=1,Δf+=1];
If[grid[[i,j]]==grid[[i,j+1]],Δf-=1,Δf+=1];


(* now decide whether or not to accept the proposed transition *)
ratio=Exp[β*Δf];
r=RandomReal[];
If[r<ratio,grid=prop]; (* accept the proposed transition *)

(* optionally, store the grid in a list *)
chain[[m]]=grid

,{m,1,steps}]

(* draw the grids *)
Table[Framed[Image[chain[[k]],ImageSize->Tiny],FrameMargins->0],{k,200,steps,200}]

Questions

What do you observe when you simulate a long Markov chain of grids? What does a typical high-weight grid look like?

What happens when you adjust the parameter β? How does β affect the long-term behavior of the Markov chain?

What happens when you adjust the size n? How does the size affect the long-term behavior of the Markov chain?

What happens when you adjust the boundary values in the grid? How does this affect the long-term behavior of the Markov chain?

What questions do you have?