Gibbs Sampler

Generic Process

Neighbourhood[radius_]:= {Range[-radius,radius],Range[-radius,radius]};
   (* update rule looks up to <radius> site away *)
Neighb[site_,LatticeDim_]:=Mod[site+TheNeighbourhood-1,LatticeDim]+1;
   (* Neighbourhood of a site *)
Resample[X_,site_,LatticeDim_]:=
RandomChoice[
TheRule[X[[Neighb[site,LatticeDim][[1]],Neighb[site,LatticeDim][[2]]]]]->S
];
   (* samples a new value for site <site> *)
RandomSite[LatticeDim_]:={
RandomInteger[{1,LatticeDim[[1]]}],RandomInteger[{1,LatticeDim[[2]]}]
};
   (* returns a uniformly random site in the lattice *)
ChainStep[X_]:=Module[{Z,site},
Z=X;
site=RandomSite[Dimensions[X]];
Z[[site[[1]],site[[2]]]]=Resample[X,site,Dimensions[X]];
Z
];
   (* returns a sample of a single transition of the Markov chain *)
RandomInitial[LatticeDim_]:=Table[
RandomChoice[S],{i,1,LatticeDim[[1]]},{j,1,LatticeDim[[2]]}
];
   (* returns a uniformly random configuration *)

Ising model

S={-1,1};   (* possible states of a single site *)
radius = 1;
TheNeighbourhood=Neighbourhood[radius];
   (* updating depends only on the nearest neighbours *)
IsingEnergy[Pat_]:=-(Pat[[3,2]]+Pat[[2,3]]+Pat[[1,2]]+Pat[[2,1]]);
   (* returns the energy of placing an upward spin at a site.
<Pat> is the pattern seen in the neighbourhood of a site.  The state of the site itself is <Pat[[2,2]]>. *)
IsingRule[Pat_]:={ Exp[β IsingEnergy[Pat]],Exp[-β IsingEnergy[Pat]]};
   (* probability distribution over S.  normalization is not necessary. *)
TheRule=IsingRule;
IsingPalette = {-1->White,+1->Darker[Red]};
   (* upward spin is depicted by dark red *)
ThePalette = IsingPalette;
β = 10;   (* default inverse temperature *)

Simulation

LatticeSize = {50,50};   (* size of the lattice *)

Delay=0;   (* single refresh delay in seconds *)
wait = Infinity;
jump = 1;   (* how many step before refreshing the plot *)
{X,t}={RandomInitial[LatticeSize],0};
Dynamic[ArrayPlot[X,ColorRules->ThePalette]]
Grid[{{
"t="Dynamic[t],
Button["Next", {X,t}={ChainStep[X],t+1}],
Button["Run",wait=Delay],
Button["Stop",wait=Infinity],
Button["Initialize",{X,t}={RandomInitial[LatticeSize],0}]
}}]
Grid[{{
"Jump="InputField[Dynamic[jump],Number,FieldSize->7],
Slider[Dynamic[jump],{1,1000,1}]
}}]
Grid[{{
"β="InputField[Dynamic[β],Number,FieldSize->5],
Slider[Dynamic[β],{-100,100}]
}}]
Dynamic[Refresh[
{X,t}={Nest[ChainStep,X,jump],t+jump};,
UpdateInterval->wait,TrackedSymbols:>{}
]]