SetDirectory[NotebookDirectory[]];

<<IsingScalingFunction`

Checking Convergence

expansionData=
{Rest@(DScriptFPlusMinusDξθ0List@@PrepareArgument[Data[2]])[10],
Rest@(DScriptFPlusMinusDξθ0List@@PrepareArgument[Data[6]])[10],
DScriptMCasDξList[10,θ0Cas]Table[(((m-1)!)/(m!)),{m,1,11}]};

lowExpansion=ListLogPlot[Abs@Prepend[N@expansionData,Rest@Gls],
PlotLegends->{"True value","(10^(-3)) acc. (n = 2)", "(10^(-7)) acc. (n = 6)", "Casselle et al."},
AxesLabel->{m,"((SubMinus[ℱ])^((m)))(0)"},AspectRatio->1,ImageSize->300,LabelStyle->{Black,FontSize->14,FontFamily->Times}
]

ListLogPlot[Abs@{
Rest@Φs,
Rest@(DScriptF0DηList@@PrepareArgument[Data[2]])[10,1],
Rest@(DScriptF0DηList@@PrepareArgument[Data[6]])[10,1]
},
PlotLegends->{"Numerics","Ours (n = 2)", "Ours (n = 6)"},
AxesLabel->{m,"((Subscript[ℱ, 0])^((m)))"}
]

ListLogPlot[Abs@{
Rest@Ghs,
Rest@(DScriptFPlusMinusDξList@@PrepareArgument[Data[2]])[10,0],
Rest@(DScriptFPlusMinusDξList@@PrepareArgument[Data[6]])[10,0],
DScriptMCasDξList[9,0]Table[(((m-1)!)/(m!)),{m,1,10}]
},
PlotLegends->{"Numerics","Ours (n = 2)", "Ours (n = 6)", "Casselle et al."},
AxesLabel->{m,"((SubPlus[ℱ])^((m)))"}
]

freeEnergyData=Table[{ut[1,γ Data[n]["θ0"]]((uh[Data[n]["θ0"],Data[n]["gs"]][1,γ Data[n]["θ0"]])^(-8/15)),Re@(DScriptF0DηList@@PrepareArgument[Data[n]])[0,γ Data[n]["θ0"]][[1]]},{n,2,6},Evaluate@N[{γ,(10^(-4)),1-(10^(-4)),(10^(-4))},40]];

freeEnergyDataInterpolation=Interpolation/@freeEnergyData;

pCovergence=LogPlot[Evaluate[(Abs[#[x]-Last[freeEnergyDataInterpolation][x]])&/@Most[freeEnergyDataInterpolation]],{x,-6,6},PlotLegends->LineLegend[{2,3,4,5},LegendLabel->"n"],AxesLabel->{"t (h^(-1/β δ))","| Δℱ |"},LabelStyle->{Black,FontSize->14,FontFamily->Times},ImageSize->300,AspectRatio->1]

magnetizationData=Table[{ut[1,γ Data[n]["θ0"]]((uh[Data[n]["θ0"],Data[n]["gs"]][1,γ Data[n]["θ0"]])^(-8/15)),Re@(DScriptF0DηList@@PrepareArgument[Data[n]])[1,γ Data[n]["θ0"]][[-1]]},{n,2,6},Evaluate@N[{γ,(10^(-4)),1-(10^(-4)),(10^(-4))},30]];

magnetizationDataInterpolation=Interpolation/@magnetizationData;

LogPlot[Evaluate[(Abs[#[x]-Last[magnetizationDataInterpolation][x]])&/@Most[magnetizationDataInterpolation]],{x,-6,6},PlotLegends->LineLegend[{2,3,4,5},LegendLabel->"n"],AxesLabel->{"t (h^(-1/β δ))","| (Subscript[ℱ, 0])((')^([n])) - (Subscript[ℱ, 0])((')^([6])) |"},LabelStyle->{Black,FontSize->12}]

Plotting as functions of scaling invariants

η2=η[Data[2]["θ0"],Data[2]["gs"]];
ξ2=ξ[Data[2]["θ0"],Data[2]["gs"]];
DScriptF0Dη2=DScriptF0Dη@@PrepareArgument[Data[2]];
DufDuh2=DufDuh@@PrepareArgument[Data[2]];
η6=η[Data[6]["θ0"],Data[6]["gs"]];
ξ6=ξ[Data[6]["θ0"],Data[6]["gs"]];
DScriptF0Dη6=DScriptF0Dη@@PrepareArgument[Data[6]];
DufDuh6=DufDuh@@PrepareArgument[Data[6]];

ParametricPlot[Evaluate@{
{η2[γ Data[2]["θ0"]],DScriptF0Dη2[0,γ Data[2]["θ0"]]},
{η6[γ Data[6]["θ0"]],DScriptF0Dη6[0,γ Data[6]["θ0"]]}
},{γ,0,0.999},
AspectRatio->1,AxesLabel->{η,(Subscript[ℱ, 0])[η]},LabelStyle->Black,PlotLegends->LineLegend[{2,6},LegendLabel->"n"]
]

ParametricPlot[Evaluate@{
{η2[γ Data[2]["θ0"]],DScriptF0Dη2[1,γ Data[2]["θ0"]]},
{η6[γ Data[6]["θ0"]],DScriptF0Dη6[1,γ Data[6]["θ0"]]}
},{γ,0,0.999},
AspectRatio->1,AxesLabel->{η,(Subscript[ℱ, 0])'[η]},LabelStyle->Black,PlotLegends->LineLegend[{2,6},LegendLabel->"n"]
]

ParametricPlot[Evaluate@{
{η2[γ Data[2]["θ0"]],-DScriptF0Dη2[2,γ Data[2]["θ0"]]},
{η6[γ Data[6]["θ0"]],-DScriptF0Dη6[2,γ Data[6]["θ0"]]}
}
,{γ,0,0.999},
AspectRatio->1,AxesLabel->{η,-(Subscript[ℱ, 0])''[η]},LabelStyle->Black,PlotLegends->LineLegend[{2,6},LegendLabel->"n"]
]

ParametricPlot[Evaluate@{
{ξ2[γ Data[2]["θ0"]],-DufDuh2[1][3,γ Data[2]["θ0"]]((Abs[ut[3,γ Data[2]["θ0"]]])^(-1/8))},
{ξ6[γ Data[6]["θ0"]],-DufDuh6[1][3,γ Data[6]["θ0"]]((Abs[ut[3,γ Data[6]["θ0"]]])^(-1/8))},
{ξ[θ0Cas,gsCas][γ θ0Cas],DScriptMCasDξList[0,γ θ0Cas][[-1]]}
},{γ,0,0.999},PlotRange->{{0,3.3},{0,1.6}},
AspectRatio->1,PlotPoints->50,AxesLabel->{"h | t((|)^(-β δ))","M | t((|)^(-β))"},LabelStyle->{Black,FontSize->14},PlotLegends->LineLegend[{2,6,"Caselle et al."},LegendLabel->"n"]
]

ParametricPlot[Evaluate@{
{ξ2[γ Data[2]["θ0"]],-DufDuh2[2][1,γ Data[2]["θ0"]]((Abs[ut[1,γ Data[2]["θ0"]]])^(7/4))},
{ξ6[γ Data[6]["θ0"]],-DufDuh6[2][1,γ Data[6]["θ0"]]((Abs[ut[1,γ Data[6]["θ0"]]])^(7/4))},
{ξ[θ0Cas,gsCas][γ θ0Cas],DScriptMCasDξList[1,γ θ0Cas][[-1]]}
},{γ,0,0.999},PlotRange->{{0,3.3},Automatic},
AspectRatio->1,WorkingPrecision->20,PlotPoints->50,AxesLabel->{"h | t((|)^(-β δ))","χ | t((|)^γ)"},LabelStyle->{Black,FontSize->14},PlotLegends->LineLegend[{2,6,"Caselle et al."},LegendLabel->"n"]
]

Applications: plotting as functions of control variables (t and h)

invCoords6=InverseCoordinates[Data[6]["θ0"],Data[6]["gs"]];
DufDut6=DufDut@@PrepareArgument[Data[6]];

Entropy

In this plot, we show ((∂(Subscript[u, f]))/(∂(Subscript[u, t]))), which is the singular part of the entropy (modulo a constant analytic factor) near the transition.

Plot[{
-Re[DufDut6[1]@@invCoords6[t,(10^(-1))]],
-Re[DufDut6[1]@@invCoords6[t,(10^(-2))]],
-Re[DufDut6[1]@@invCoords6[t,(10^(-3))]],
-Re[DufDut6[1]@@invCoords6[t,(10^(-4))]]
},{t,-2,2},PlotRange->All,Exclusions->None,AxesLabel->{t,"S"},LabelStyle->Black,PlotLegends->LineLegend[{"(10^(-1))","(10^(-2))","(10^(-3))","(10^(-4))"},LegendLabel->h]]

Specific heat

In this plot, we show (((∂^2)(Subscript[u, f]))/(∂((Subscript[u, t])^2))), which is the singular part of the specific heat (modulo a constant analytic factor) near the transition.

Plot[{
-Re[DufDut6[2]@@invCoords6[t,(10^(-1))]],
-Re[DufDut6[2]@@invCoords6[t,(10^(-2))]],
-Re[DufDut6[2]@@invCoords6[t,(10^(-3))]],
-Re[DufDut6[2]@@invCoords6[t,(10^(-4))]]
},{t,-2,2},PlotRange->All,Exclusions->None,AxesLabel->{t,"c"},LabelStyle->Black,PlotLegends->LineLegend[{"(10^(-1))","(10^(-2))","(10^(-3))","(10^(-4))"},LegendLabel->h]]

Magnetization

In this plot, we show ((∂(Subscript[u, f]))/(∂(Subscript[u, h]))), which is the singular part of the magnetization (modulo a constant analytic factor) near the transition. Notice here, as in all plots using this library, that t∝(Subscript[T, c])-T (the negative of the usual sense) following conventions in high energy physics.

Plot[{
-Re[DufDuh6[1]@@invCoords6[t,(10^(-1))]],
-Re[DufDuh6[1]@@invCoords6[t,(10^(-2))]],
-Re[DufDuh6[1]@@invCoords6[t,(10^(-3))]],
-Re[DufDuh6[1]@@invCoords6[t,(10^(-4))]]
},{t,-2,2},PlotRange->All,Exclusions->None,AxesLabel->{t,"M"},LabelStyle->Black,PlotLegends->LineLegend[{"(10^(-1))","(10^(-2))","(10^(-3))","(10^(-4))"},LegendLabel->h]]

Susceptibility

In this plot, we show (((∂^2)(Subscript[u, f]))/(∂((Subscript[u, h])^2))), which is the singular part of the susceptibility (modulo a constant analytic factor) near the transition.

LogPlot[{
-Re[DufDuh6[2]@@invCoords6[t,(10^(-1))]],
-Re[DufDuh6[2]@@invCoords6[t,(10^(-2))]],
-Re[DufDuh6[2]@@invCoords6[t,(10^(-3))]],
-Re[DufDuh6[2]@@invCoords6[t,(10^(-4))]]
},{t,-2,2},Exclusions->None,PlotRange->All,AxesLabel->{t,"χ"},LabelStyle->Black,PlotLegends->LineLegend[{"(10^(-1))","(10^(-2))","(10^(-3))","(10^(-4))"},LegendLabel->h]]