SetDirectory[NotebookDirectory[]]

Get["Figures_style.wl"]

ϵ=1/128

rozw=NDSolve[{u''[x]+2/x u'[x]+u[x]^3-2 u'[x]^2/u[x]==0,u[ϵ]==1-ϵ^2/6+13/360ϵ^4-25/3024 ϵ^6,u'[ϵ]==-(ϵ/3)+((13 (ϵ^3))/90)-((25 (ϵ^5))/504)},u,{x,ϵ/1024,1024},WorkingPrecision->64,MaxSteps->10^5][[1]]

U=u/.rozw;

LaneEmden={u''[x]+2/x u'[x]+u[x]^(n)==0,u[ϵ]==1-((ϵ^2)/6)+((n (ϵ^4))/120)+(((5 n-8 (n^2)) (ϵ^6))/15120),u'[ϵ]==-(ϵ/3)+((n (ϵ^3))/30)+(((5 n-8 (n^2)) (ϵ^5))/2520)}//Simplify

rozwLaneEmden3=NDSolve[LaneEmden/.n->3,u,{x,ϵ/1024,1024},WorkingPrecision->64][[1]]

rozwLaneEmden133=NDSolve[LaneEmden/.n->13/3,u,{x,ϵ/1024,1024},WorkingPrecision->64][[1]]

W3=u/.rozwLaneEmden3;

W133=u/.rozwLaneEmden133;

Get["Figures_style.wl"]

A=0.4164

ϕ=0.1395

(*xTBL=Table[2^p,{p,-11,11,10}]*)

xTBL={0.1}

functions={
(Sqrt[2]/x)/U[x]-1//Abs,
(1-x^2/6)/U[x]-1//Abs,
If[x<23,W133[x]/U[x]-1//Abs,0],
(1/(3+(x/(Sqrt[2]))-((2 ((Sqrt[2])+x) Log[1+(x/(Sqrt[2]))])/x)))/U[x]-1//Abs,
 W3[x]/U[x]-1//Abs,
(1/(x/Sqrt[2]+A Cos[Sqrt[7]/2 Log[x] + ϕ]/Sqrt[x]))/U[x]-1//Abs
};

dataForPlot=Table[functions,{x,xTBL}]//Transpose

curves=Table[{xTBL,dataForPlot[[k]]}//Transpose,{k,1,Length[dataForPlot]}];

markers={"○", "□", "◇", "△", "▽","▫"}

fig2symbols=ListLogLogPlot[curves,
PlotRange->{{10^-3,10^2},{$MachineEpsilon,20}},
PlotStyle->{
{Black,AbsoluteThickness[thickness]},
{Red,AbsoluteThickness[thickness],Dashed},
{Magenta,AbsoluteThickness[thickness],DotDashed},
{Blue,AbsoluteThickness[0]},   
{Purple,AbsoluteThickness[thickness]}, 
{Brown,AbsoluteThickness[thickness],Dotted}
},
GridLines->{{ϵ},None},
GridLinesStyle->{{Black,AbsoluteThickness[0.5],DotDashed},{Black,AbsoluteThickness[0.5]}},
PlotLegends->Placed[{"x/(Sqrt[2])","(Subscript[θ, 0])","(Subscript[θ, 13/3])","Approx.","(Subscript[θ, 3])","Full asympt."},{Right,Bottom}],
PlotMarkers->markers,Joined->True,
AxesLabel->{"x","Relative error"}(*,WorkingPrecision->32*),
FrameLabel->{"x","Relative error"}(*,WorkingPrecision->32*),
Frame->True,
FrameStyle->{{Black,AbsoluteThickness[1]},{Black,AbsoluteThickness[1]},{Black,AbsoluteThickness[1]},{Black,AbsoluteThickness[1]}}]

fig2lines=LogLogPlot[functions,{x,ϵ/16,100},

PlotRange->{$MachineEpsilon,100},
PlotStyle->{
{Black,AbsoluteThickness[thickness]},
{Red,AbsoluteThickness[thickness],Dashed},
{Magenta,AbsoluteThickness[thickness],DotDashed},
{Blue,AbsoluteThickness[thickness]},   
{Purple,AbsoluteThickness[thickness]}, 
{Brown,AbsoluteThickness[thickness],Dotted}
}]

fig2=Show[fig2symbols,fig2lines]

Export["Fig2_approximations_6th_order.pdf",fig2]

(*Old figure version, unreadable*)

(*fig2=LogLogPlot[{
(Sqrt[2]/x)/U[x]-1//Abs,
(1-x^2/6)/U[x]-1//Abs,
If[x<23,W133[x]/U[x]-1//Abs,0],
(1/(3+(x/(Sqrt[2]))-((2 ((Sqrt[2])+x) Log[1+(x/(Sqrt[2]))])/x)))/U[x]-1//Abs,
 W3[x]/U[x]-1//Abs,
(1/(x/Sqrt[2]+A Cos[Sqrt[7]/2 Log[x] + ϕ]/Sqrt[x]))/U[x]-1//Abs
},{x,ϵ/16,100},

PlotRange->{$MachineEpsilon,10},
PlotStyle->{
{Black,AbsoluteThickness[thickness]},
{Red,AbsoluteThickness[thickness],Dashed},
{Magenta,AbsoluteThickness[thickness],DotDashed},
{Blue,AbsoluteThickness[thickness]},   
{Purple,AbsoluteThickness[thickness]}, 
{Brown,AbsoluteThickness[thickness],Dotted}
},
GridLines->{{ϵ},None},
GridLinesStyle->{{Black,AbsoluteThickness[0.5],DotDashed},{Black,AbsoluteThickness[0.5]}},
PlotLegends->Placed[{"x/(Sqrt[2])","(Subscript[θ, 0])","(Subscript[θ, 13/3])","Approx.","(Subscript[θ, 3])","Full asympt."},{Right,Bottom}],
(*PlotLegends->LineLegend[{"x/sqrt(2)","(Subscript[θ, 0])","(Subscript[θ, 13/3])","Approx.","(Subscript[θ, 3])","Full asympt."},LegendMargins->0],*)
AxesLabel->{"x","Relative error"}(*,WorkingPrecision->32*),
FrameLabel->{"x","Relative error"}(*,WorkingPrecision->32*),
Frame->True,
FrameStyle->{{Black,AbsoluteThickness[1]},{Black,AbsoluteThickness[1]},{Black,AbsoluteThickness[1]},{Black,AbsoluteThickness[1]}}]*)