Get["~/doc/research/first_order_singularities/mma/schofield.wl"]

g[θ0Cas,gsCas][θ]//Simplify

hCas[θ]h0//Simplify

θ0Cas=(Sqrt[1.16951]);
hCas[θ_]:=(1-((θ^2)/((θ0Cas)^2)))θ(1-0.222389 (θ^2)-0.043547 (θ^4)-0.014809 (θ^6)-0.007168 (θ^8))
h0=a b ρ/.{a->((c2^2)/c4),b->(((((-c4)/(c2^3))))^(1/2)),ρ->2.00881}/.{c2->Ghs[[3]]2!,c4->Ghs[[5]]["Value"]4!}
m0=-Ghs[[3]]2! h0

totCas=4;
ds=invDerivativeList[totCas+1][θ|->((h0 hCas[θ])/((RealAbs[t[θ]])^(Δ[2])))][θ0Cas];
dMs=m0 NestList[D[#,θ]&,(θ/((((θ^2)-1))^(1/8))),totCas]/.θ->θ0Cas;
datCas=Table[-Sum[dMs[[k+1]]BellY[n,k,ds[[;;n-k+1]]],{k,0,n}]/(n+1)!,{n,0,totCas}]

totCas=4;
ds=invDerivativeList[totCas+1][θ|->((h0 hCas[θ])/((RealAbs[t[θ]])^(Δ[2])))][θ];
dMs=m0 NestList[D[#,θ]&,(θ/((RealAbs[(θ^2)-1])^(1/8))),totCas];
datCas=Table[-Sum[dMs[[k+1]]BellY[n,k,ds[[;;n-k+1]]],{k,0,n}]/(n+1)!,{n,0,totCas}];

pCasM=ParametricPlot[{((h0  hCas[θ])/((Abs[((θ^2)-1)])^(15/8))),- datCas[[1]]},{θ,1.001,θ0Cas},AspectRatio->1,PlotRange->{{0,3.3},Automatic},PlotStyle->ColorData[97][3],PlotPoints->40]

pCasS=ParametricPlot[{((h0 hCas[θ])/((Abs[((θ^2)-1)])^(15/8))),2 Abs@datCas[[2]]},{θ,1,θ0Cas},AspectRatio->1,PlotRange->{{0,3.3},Automatic},PlotStyle->ColorData[97][3],PlotPoints->40]

totCas=13;
ds=invDerivativeList[totCas+1][θ|->((h0 hCas[θ])/(((-t[θ]))^(Δ[2])))][0];
dMs=m0 NestList[D[#,θ]&,(θ/(((1-(θ^2)))^(1/8))),totCas]/.θ->0;
datCasH=Table[-Sum[dMs[[k+1]]BellY[n,k,ds[[;;n-k+1]]],{k,0,n}]/(n+1)!,{n,0,totCas}]

D[((RealAbs[η])^2),η]

D[((RealAbs[η])^2)ℱpm[((RealAbs[η])^(-Δ[]))],{η,1}]

test= (1/(#!))D[(η^2)(ℱpm[(η^(-Δ[]))]+(( 1)/(8π))Log[(η^2)]),{η,#}]/.Derivative[n_][ℱpm][_]:>-datCasM[[n]]/.ℱpm[_]:>(η^(-2))ℱ0[η]-(1/(8π))Log[(η^2)]/.η->t[θ](((h0 hCas[θ]))^(-1/Δ[]))&@1;

Series[test,{θ,1,0},Assumptions->{θ>1}]

test= (1/(#!))D[(η^2)(ℱpm[(η^(-Δ[]))]+(( 1)/(8π))Log[(η^2)]),{η,#}]/.Derivative[n_][ℱpm][_]:>-datCasM[[n]]/.ℱpm[_]:>(η^(-2))Φs[[1]]-(1/(8π))Log[(η^2)]/.η->t[θ](((h0 hCas[θ]))^(-1/Δ[]))&/@Range[0,4];

test3=SeriesCoefficient[#,{θ,1,0},Assumptions->{θ>1}]&@test

ListLogPlot[Abs@{Φs,test3}]

test3[[3]]

Show[
ParametricPlot[{t[θ](((h0 hCas[θ]))^(-1/Δ[])),test[[1]]},{θ,0.5,1.1},AspectRatio->1/GoldenRatio,WorkingPrecision->30],
Plot[test3[[1]]+test3[[2]]x,{x,-5,5},PlotStyle->Red]
]

Φs[[4]]

totCas=6;
ds=invDerivativeList[totCas+1][θ|->((h0 hCas[θ])/((t[θ])^(Δ[2])))][θ];
dMs=m0 NestList[D[#,θ]&,(θ/((t[θ])^(β[]))),totCas];
datCasM=Table[Sum[dMs[[k+1]]BellY[n,k,ds[[;;n-k+1]]],{k,0,n}],{n,0,totCas}];

Plot[{Abs@datCasM[[2]],Evaluate[Abs[m0/D[((h0 hCas[θ])/((t[θ])^(Δ[2]))),θ]D[(θ/((t[θ])^(β[]))),θ]]]},{θ,0,θ0Cas}]

2/Δ[]-1/Δ[]-1

2/Δ[]-1

-Φs[[1]]//N

ParametricPlot[Evaluate[{{((t[θ])/((H[2][θ])^(1/Δ[]))),((Abs[t[θ]/((H[2][θ])^(1/Δ[]))])^(β[]))dGdξList[NF[2],H[2]][1,θ][[2]]}//.rules[H[2]]/.S[2],{((t[θ])/((H[9][θ])^(1/Δ[]))),((Abs[t[θ]/((H[9][θ])^(1/Δ[]))])^(β[]))dGdξList[NF[9],H[9]][1,θ][[2]]}//.rules[H[9]]/.S[9],
{((((θ^2)-1))/(((h0 hCas[θ]))^(1/Δ[]))),-m0 θ/(((h0 hCas[θ]))^(β[]/Δ[]))}}],{θ,0,1.4},AspectRatio->1/GoldenRatio,PlotPoints->100]

S[2]

m0/(((h0 hCas[1]))^(β[]/Δ[]))

Φs[[1]]

datCasM/.m0rule

totOurs=17;
ds=invDerivativeList[totOurs][θ|->((h1[θ]/.sol1)/(((t[θ]))^(Δ[2])))][θc/.sol1];
dFRegs=NestList[D[#,θ]&,RFReg[n1][θ]/.sol1,totOurs]/.θ->θc/.sol1;
dF=dFRegs+Table[Piecewise[{{AL m! Gamma[m-1] B^(m-1)/π,m>1},{0,True}}],{m,0,totOurs}];
dMs=Rest[NestList[D[#,θ]&,((fp[θ])/((t[θ])^2))-(1/(8π))Log[((t[θ])^2)],totOurs]]/.θ->θc/.Map[Derivative[#][fp][θc]->dF[[#+1]]&,Range[0,totOurs]]/.sol1;
datOurs=Table[Sum[dMs[[k]]BellY[n,k,ds[[;;n-k+1]]],{k,1,n}]/(n)!,{n,1,totOurs}]

datOurLow2=Chop[dGdξLowList[NF[2],H[2],Join[rules[H[2]],S[2]]][14]]

datOurLow6=Chop[dGdξLowList[NF[6],H[6],Join[rules[H[6]],S[6]]][14]]

datOurHigh2=Chop[dGdξList[NF[2],H[2],Join[rules[H[2]],S[2]]][14,0]]

datOurHigh6=Chop[dGdξList[NF[6],H[6],Join[rules[H[6]],S[6]]][14,0]]

datOurMid2=Chop[dΦdηList[NF[2],H[2],Join[rules[H[2]],S[2]]][14,1]]

datOurMid6=Chop[dΦdηList[NF[6],H[6],Join[rules[H[6]],S[6]]][14,1]]

Export["~/doc/research/first_order_singularities/paper/data/glow_series_ours_2.dat",Table[{i-1,datOurLow2[[i]]},{i,1,Length[datOurLow2]}]]

Export["~/doc/research/first_order_singularities/paper/data/glow_series_ours_6.dat",Table[{i-1,datOurLow6[[i]]},{i,1,Length[datOurLow6]}]]

Export["~/doc/research/first_order_singularities/paper/data/glow_series_caselle.dat",Prepend[Table[{i,datCas[[i]]},{i,1,Length[datCas]}],{0,0}]]

Export["~/doc/research/first_order_singularities/paper/data/ghigh_caselle.dat",Prepend[Table[{i,datCasH[[i]]},{i,1,Length[datCasH]}],{0,0}]]

Export["~/doc/research/first_order_singularities/paper/data/ghigh_series_ours_2.dat",Thread[{Range[0,14],datOurHigh2}]]

Export["~/doc/research/first_order_singularities/paper/data/ghigh_series_ours_6.dat",Thread[{Range[0,14],datOurHigh6}]]

Export["~/doc/research/first_order_singularities/paper/data/phi_series_ours_2.dat",Thread[{Range[0,14],datOurMid2}]]

Export["~/doc/research/first_order_singularities/paper/data/phi_series_ours_6.dat",Thread[{Range[0,14],datOurMid6}]]

Gls[[1]]

ListLogPlot[{
Abs@datNum,Abs@Prepend[datCas,Gls[[2]]]
}]

Export["~/doc/research/first_order_singularities/paper/data/Glow_series_numeric

datNum

convNum=Table[{i,#[[i]]/i!},{i,2,Length[#]}]&@Abs[Rest@datNum[[All,2]]]

ListPlot[{
Table[{1/i,#[[i]]/#[[i-1]]/i},{i,2,Length[#]}]&@Abs[Rest@datNum[[All,2]]],
Table[{1/i,#[[i]]/#[[i-1]]/i},{i,2,Length[#]}]&@Abs[datCas],
Table[{1/i,#[[i]]/#[[i-1]]/i},{i,2,Length[#]}]&@Rest[datOurs]
},PlotRange->{{0,0.5},All}]

datOurs=Chop[Abs[dFdξHighList[n1,h1][12]]/.sol1];

datNumHigh=Thread[{Range[0,Length[Ghs]-1],Abs[Ghs]((Range[Length[Ghs]]-1)!)}];

datCasHigh=NestList[ddξ[hCas],m0 (θ/(((1-(θ^2)))^(1/8))),11]/.θ->0/.m0rule

ListLogPlot[{
Abs@datNumHigh,Abs@datCasHigh,Thread[{Range[0,Length[datOurs]-1],datOurs}]
}]