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

n9=2;
F9=RF[n9];
h9=h[15];

n1=2;
F1=RF[n1];
h1=h[0];
sol1={θc->1.1942649631944824`,θ0->0.1980115286480415`,B->8.55266640049003`,gC[0]->1.1942649631944824`,AL->-0.09823515561347546`,AH->-2.3836528485084885`,A[0]->1.0766637996073516`,A[1]->2.0038100879767504`,A[2]->0.22823495175053052`};

sol9={θc->1.3334703412536566`,θ0->0.19778787932056896`,B->2.423508930724686`,gC[0]->1.2182536469166905`,AL->-0.032849858698944676`,AH->-2.476902848020555`,A[0]->1.3332747682033883`,A[1]->2.5090565130203157`,A[2]->0.23349249078258508`,gC[1]->-0.05795919615164437`,gC[2]->0.009724404457489885`,gC[3]->-0.0027930254001640054`,gC[4]->0.0009257841098320665`,gC[5]->-0.0003462096131004199`,gC[6]->0.00013670744619527473`,gC[7]->-0.000057088418113155406`,gC[8]->0.000024064383846786254`,gC[9]->-0.000010116684104855923`,gC[10]->4.024896321935335`*^-6,gC[11]->-1.4759300475764031`*^-6,gC[12]->4.686996899926149`*^-7,gC[13]->-1.2362968704699286`*^-7,gC[14]->2.395277120268058`*^-8,gC[15]->-2.99666705183393`*^-9};

θ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]]4!}
m0=-Ghs[[3]]2! h0

Ghs[[3]]

a

coeffCas[n_]:=NestList[ddξ[hCas],m0 (θ/((((θ^2)-1))^(1/8))),n]/.θ->θ0Cas

coeffCasMid[n_]:=NestList[ddη[hCas],m0 (θ/((hCas[θ])^(1/δ[2]))),n]/.θ->1

datNum=Thread[{Range[0,Length[Gls]-1],Gls}];

Export["~/doc/research/first_order_singularities/paper/data/glow_series_numeric.dat",{#1,If[Head[#2]===Around,#2["Value"],#2],If[Head[#2]===Around,#2["Uncertainty"],0]}&@@@datNum]

m0rule=Solve[datCas[[{1,2}]]==datNum[[2;;3,2]],{m0,h0}][[1]]

ClearAll[h0];ClearAll[m0];
h0=h0["Value"]/.m0rule
m0=m0["Value"]/.m0rule

coeffCasMid[5]/Range[0,5]!/.m0rule

totCas=6;
ds=invDerivativeList[totCas+1][θ|->((h0 hCas[θ])/(((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=6;
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}]

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

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}]

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

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

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}]
}]