1d Ising model

fexact[K_] := -Log[2 Cosh[K]];

Ki[i_] := 1/2 Log[Cosh[2 Ki[i-1]]];
gi[i_]  := 1/2 Log[2] + 1/2 Ki[i];

fRG[K_,n_] := -Sum[gi[i]/2^(i-1),{i,1,n}] - 1/2^n Log[2];

Ktest = 2;Ki[0] = Ktest;n=10;{fexact[Ktest],fRG[Ktest,n]} // N

data = Table[{Ki[0] = Ktest;Ktest,fexact[Ktest],fRG[Ktest,1],fRG[Ktest,2],fRG[Ktest,3],fRG[Ktest,4],fRG[Ktest,5],fRG[Ktest,6],fRG[Ktest,7]},{Ktest,0,3,0.04}];

pexact = ListPlot[Table[Table[{data[[i,1]],data[[i,j]]},{i,1,Length[data]}],{j,2,2}],Joined->True,AxesLabel->{"K","f"}]

pRG = ListPlot[Table[Table[{data[[i,1]],data[[i,j]]},{i,1,Length[data]}],{j,3,7}],AxesLabel->{"K","f"},PlotStyle->PointSize[0.005]]

Show[pexact,pRG]

2d Ising model

K = 0.440;{Log[2] + 1/8 (Log[Cosh[4K]] + 4 Log[Cosh[2K]]),
1/4 Log[Cosh[4K]],1/8 Log[Cosh[4K]],1/8 (Log[Cosh[4K]] - 4 Log[Cosh[2K]])}

Series[1/8 Log[Cosh[4 x]],{x,0,4}]

KK[K_,L_] := 2 K^2 + L;
LL[K_,L_] := K^2;

jmax = 10;

data = {};
dataall={};count = 0;
Do[K=K0; L=L0;
Do[{data=AppendTo[data,{K,L}];Knew=KK[K,L];Lnew=LL[K,L];K=Knew;L=Lnew;},{i,1,jmax}];dataall=AppendTo[dataall,data];count++;
data = {};,{K0,0.0,0.1,0.05},{L0,0.0,0.8,0.05}];
Do[K=K0; L=L0;
Do[{data=AppendTo[data,{K,L}];Knew=KK[K,L];Lnew=LL[K,L];K=Knew;L=Lnew;},{i,1,jmax}];dataall=AppendTo[dataall,data];count++;
data = {};,{K0,0.0,0.8,0.05},{L0,0.0,0.1,0.05}]

Graphics[{Blue,Table[{PointSize[0.02],Point[dataall[[i,1]]],Table[{Arrow[{dataall[[i,j]],dataall[[i,j+2]]}]},{j,1,jmax-2,2}]},{i,1,count}]},Axes->True,PlotRange->{{0,1},{0,1}},AxesLabel->{"K","L"}]

data = {};
dataall={};count = 0;
Do[K=K0; L=L0;
Do[{data=AppendTo[data,{K,L}];Knew=KK[K,L];Lnew=LL[K,L];K=Knew;L=Lnew;},{i,1,jmax}];dataall=AppendTo[dataall,data];count++;
data = {};,{K0,0.0,0.0,0.005},{L0,0.0,0.8,0.005}];
Do[K=K0; L=L0;
Do[{data=AppendTo[data,{K,L}];Knew=KK[K,L];Lnew=LL[K,L];K=Knew;L=Lnew;},{i,1,jmax}];dataall=AppendTo[dataall,data];count++;
data = {};,{K0,0.0,0.8,0.005},{L0,0.0,0.0,0.005}]

Graphics[{Blue,PointSize[0.02],Red,Point[{1/3,1/9}],Blue,Table[{PointSize[0.02],Point[dataall[[i,1]]],Table[{Arrow[{dataall[[i,j]],dataall[[i,j+2]]}]},{j,1,jmax-2,2}]},{i,1,count}]},Axes->True,PlotRange->{{1/4,1/2},{0,2/9}},AxesLabel->{"K","L"}]

A = {{4/3,1},{2/3,0}};

Eigenvectors[A] // FullSimplify

Eigenvalues[A] // N