Please note that before starting you need to fix the Working precision (wpc). Normaly 40 is enough here

Same for AccuracyGoal (acc = 8 is enough) and PrecisionGoal (prec = 8 is enough).

SetDirectory[NotebookDirectory[]];
wpc=40;
$MinPrecision=wpc;
acc=8;prec=8;

You may load our results (see section results).

Get["EE_KS.mx"];

Understanding GPPZ background

The Lagrangian we work with is:

ℒ=((ϵ^(10/3))/(16 (Sqrt[6])))(((β[τ]+((R'[τ])^2)))^(1/2))((R[τ])^2)((h[τ])^(-3/4))((h[τ])^(5/4))k[τ]((Sinh[τ])^2)/.β-> Function[τ,h[τ](ϵ^(4/3))/(6((k[τ])^2))]//Simplify

This is a consistency check, using the determinant of the 10 D action

(((h[τ])^(-(1/2)))((R'[τ])^2) + ((((h[τ])^(1/2)) (ϵ^(4/3)))/(6 ((k[τ])^2))))(((h[τ])^(-(1/2)))((R[τ])^2))(((h[τ])^(-(1/2)))((R[τ])^2))((((h[τ])^(1/2)) (ϵ^(4/3)))/(6 ((k[τ])^2)))((((1/2)((h[τ])^(1/2))(ϵ^(4/3))k[τ]))^4)((Cosh[(τ/2)])^4)((Sinh[(τ/2)])^4)//FullSimplify
Assuming[τ>0&&R[τ]>0&&k[τ]>0&&h[τ]>0&&ϵ>0,ℒ-(Sqrt[%])//FullSimplify//Together//Simplify]

Now, K is

rulek={k->Function[τ,((((Sinh[2τ]-2τ))^(1/3))/((2^(1/3))Sinh[τ]))]};

And the warp factor can be computed as follows

hprime[τs_]=-((τs Coth[τs]-1)/(((Sinh[τs])^2) ))(((Sinh[2 τs]-2 τs))^(1/3));

integral[τ_]:=NIntegrate[hprime[τs],{τs,cutoff,τ},WorkingPrecision->wpcback];

(hprime[τ]//TrigToExp//Simplify)/.{(E^(num_ τ))->((eτ)^num)}//Simplify;
(Series[%,{eτ,∞,15}]//Normal//Simplify)/.eτ->Exp[τ];
hUV[τ_]=Integrate[%,τ];

computeWarpFactor:=solh=NDSolve[{𝒽'[τ]==hprime[τ],𝒽[cutoff]==hUV[cutoff]},𝒽,{τ,cutoff,cutoffIR},WorkingPrecision->wpcback,Method-> "ExplicitRungeKutta",MaxSteps->maxsteps]//Flatten

We can factor out the cahrges in the following way:

ℒdimless=Assuming[M0>0&&ϵ>0,(M0^(-4))ℒ/.rulek/.R-> (M0 (ϵ^(-2/3))  R[#]&)/.h->( (M0^2) (ϵ^(-8/3))𝒽[#]&)//Simplify]

Assuming[M0>0&&ϵ>0&&Λkk>0&&gs>0&&ls>0&&M>0,FullSimplify[(ℒ/(M0^4))/. rulek/. R->(((R[#1] (2^(1/3)))/(Λkk))&)/. h->((((ϵ^(-4/3)) (2^(2/3)) 𝒽[#1])/((Λkk)^2))&)/. M0->(gs M (ls^2)) (2^(1/3))/. Λkk->((ϵ^(2/3))/(gs (ls^2) M))]];
Assuming[M0>0&&ϵ>0&&Λkk>0&&gs>0&&ls>0&&M>0&&τ>0,FullSimplify[Simplify[((ℒdimless)^2)-((%)^2)]]]

Now what the code computes is the integral of ℒdimless. Then the final result is 

S= (((Subscript[M, 0])^4)/(4G10))∫(Subscript[Ω, 2])∫(Subscript[g, i]) ∫ℒdimless and ∫(Subscript[g, i]) = 64 (π^3) and ∫(Subscript[Ω, 2])=4π 

Recall that the volume of the (T^(1,1)) part is:

So to the final result we have to multiply by

((M0^4)/(4 G10))(4π )(64(π^3))/.G10 ->8(π^6)(ls^8)(gs^2)/.M0->(gs M (ls^2))(2^(1/3))//Simplify
factor = %/((gs^2)(M^4))
%//N

Similarly, the code uses dimensionless ρ. So at the end of the computation I will multiply by (2^(1/3))

((2^(1/3)) ρt[τ]) - R[τ](Λkk)/.R-> (M0 (ϵ^(-2/3))  ρt[#]&)/.M0->(gs M (ls^2))(2^(1/3))/.Solve[Λkk==(ϵ^(2/3))/(gs (ls^2) M),M][[1]]

Embeddings

Equation of motion and solutions

eomτ=(∂_(R[τ]))ℒdimless-(∂_τ)((∂_(R'[τ]))ℒdimless)//Simplify//Together//Numerator//Simplify;

eomτsubs=eomτ/.𝒽'[τ]->hprime[τ]//Simplify;

solTipTau={cR[1]->((2^(5/6)) (Sqrt[3]) ((Sinh[τs])^(3/2)) (((-2 τs+Sinh[2 τs]))^(2/3)) 𝒽[τs])/(√((2 τs-Sinh[2 τs]) ((12 τs Cosh[τs]+3 Sinh[τs]-5 Sinh[3 τs]) 𝒽[τs]-3 Sinh[τs] (-2 τs+Sinh[2 τs]) 𝒽'[τs]))),cR[2]->0,cR[3]->((Sqrt[Sinh[τs]]) (-162 ((Sinh[τs])^2) (2 τs-5 Sinh[2 τs]) (-2 τs+Sinh[2 τs]) ((𝒽[τs])^2) ((12 τs Cosh[τs]+3 Sinh[τs]-5 Sinh[3 τs]) 𝒽[τs]-3 Sinh[τs] (-2 τs+Sinh[2 τs]) 𝒽'[τs])-72 ((Sinh[τs])^3) (12 τs Cosh[τs]+3 Sinh[τs]-5 Sinh[3 τs]) ((𝒽[τs])^2) ((12 τs Cosh[τs]+3 Sinh[τs]-5 Sinh[3 τs]) 𝒽[τs]-3 Sinh[τs] (-2 τs+Sinh[2 τs]) 𝒽'[τs])+540 ((Sinh[τs])^4) (-2 τs+Sinh[2 τs]) 𝒽[τs] 𝒽'[τs] ((12 τs Cosh[τs]+3 Sinh[τs]-5 Sinh[3 τs]) 𝒽[τs]-3 Sinh[τs] (-2 τs+Sinh[2 τs]) 𝒽'[τs])-27 Sinh[τs] (-2 τs+Sinh[2 τs]) (12 τs Cosh[τs]+3 Sinh[τs]-5 Sinh[3 τs]) 𝒽[τs] 𝒽'[τs] ((12 τs Cosh[τs]+3 Sinh[τs]-5 Sinh[3 τs]) 𝒽[τs]-3 Sinh[τs] (-2 τs+Sinh[2 τs]) 𝒽'[τs])+60 ((Sinh[τs])^3) 𝒽[τs] ((((12 τs Cosh[τs]+3 Sinh[τs]-5 Sinh[3 τs]) 𝒽[τs]-3 Sinh[τs] (-2 τs+Sinh[2 τs]) 𝒽'[τs]))^2)+81 Cosh[τs] (-2 τs+Sinh[2 τs]) 𝒽[τs] ((((12 τs Cosh[τs]+3 Sinh[τs]-5 Sinh[3 τs]) 𝒽[τs]-3 Sinh[τs] (-2 τs+Sinh[2 τs]) 𝒽'[τs]))^2)+54 Sinh[τs] (-2 τs+Sinh[2 τs]) 𝒽'[τs] ((((12 τs Cosh[τs]+3 Sinh[τs]-5 Sinh[3 τs]) 𝒽[τs]-3 Sinh[τs] (-2 τs+Sinh[2 τs]) 𝒽'[τs]))^2)-2 ((((12 τs Cosh[τs]+3 Sinh[τs]-5 Sinh[3 τs]) 𝒽[τs]-3 Sinh[τs] (-2 τs+Sinh[2 τs]) 𝒽'[τs]))^3)-81 Cosh[τs] (Sqrt[Sinh[τs]]) (-2 τs+Sinh[2 τs]) 𝒽[τs] 𝒽'[τs] √((2 τs-Sinh[2 τs]) ((12 τs Cosh[τs]+3 Sinh[τs]-5 Sinh[3 τs]) 𝒽[τs]-3 Sinh[τs] (-2 τs+Sinh[2 τs]) 𝒽'[τs])) √(Sinh[τs] (2 τs-Sinh[2 τs]) ((12 τs Cosh[τs]+3 Sinh[τs]-5 Sinh[3 τs]) 𝒽[τs]-3 Sinh[τs] (-2 τs+Sinh[2 τs]) 𝒽'[τs]))+81 ((Sinh[τs])^2) (((-2 τs+Sinh[2 τs]))^2) 𝒽[τs] ((12 τs Cosh[τs]+3 Sinh[τs]-5 Sinh[3 τs]) 𝒽[τs]-3 Sinh[τs] (-2 τs+Sinh[2 τs]) 𝒽'[τs]) 𝒽''[τs]))/(30 (2^(1/6)) (Sqrt[3]) (((-2 τs+Sinh[2 τs]))^(1/3)) ((((12 τs Cosh[τs]+3 Sinh[τs]-5 Sinh[3 τs]) 𝒽[τs]-3 Sinh[τs] (-2 τs+Sinh[2 τs]) 𝒽'[τs]))^2) √((2 τs-Sinh[2 τs]) ((12 τs Cosh[τs]+3 Sinh[τs]-5 Sinh[3 τs]) 𝒽[τs]-3 Sinh[τs] (-2 τs+Sinh[2 τs]) 𝒽'[τs])))};

or=2;
Assuming[0<τs<τ,eomτ/.R-> Function[τ,(∑_(kk=1)^or)cR[kk](((τ-τs))^(kk/2))+((O[τ,τs])^((or+1)/2))/.solTipTau]//Simplify]
Solve[%==0,cR[3]]//Simplify//Flatten

or=3;
Clear[RIRτ,dRIRτ]
RIRτ[τs_,τ_]=(∑_(kk=1)^or)cR[kk](((τ-τs))^(kk/2))/.solTipTau/.cR[0]-> Rs;
dRIRτ[τs_,τ_]=D[%,τ];

solDiconnected={cR[n_]:>0/;OddQ[n],cR[2]->(h0/(6 (2^(2/3)) (3^(1/3)) cR[0])),cR[4]->-((5 (2^(1/3)) (h0^2)+18 (2^(2/3)) ((cR[0])^2)-12 (3^(1/3)) h0 ((cR[0])^2))/(2160 (6^(2/3)) ((cR[0])^3))),cR[6]->(1/(8164800 ((cR[0])^5)))(-75 (h0^3)-630 (2^(2/3)) (3^(1/3)) (h0^2) ((cR[0])^2)+216 (3^(1/3)) ((cR[0])^4)+2 (2^(1/3)) h0 ((cR[0])^2) (385+72 (3^(2/3)) ((cR[0])^2))),
cR[8]->(1/(1763596800 (6^(2/3)) ((cR[0])^7)))(9325 (3^(1/3)) (h0^4)+11700 (6^(2/3)) (h0^3) ((cR[0])^2)+9936 (3^(2/3)) h0 ((cR[0])^4)+108 (2^(2/3)) ((cR[0])^4) (7 (3^(1/3))-36 ((cR[0])^2))+60 (h0^2) (7 (6^(1/3)) ((cR[0])^2)+162 (2^(1/3)) ((cR[0])^4))),
cR[10]->(-16352875 (2^(1/3)) (h0^6)+15818600 (3^(1/3)) (h0^5) ((cR[0])^2)+29804544 (2^(1/3)) ((cR[0])^6)-864 (2^(2/3)) h0 ((cR[0])^6) (90629 (3^(1/3))+6840 ((cR[0])^2))+180 (2^(2/3)) (h0^4) ((cR[0])^2) (-227395+97978 (3^(2/3)) ((cR[0])^2))+216 (h0^2) ((cR[0])^4) (-116865+385924 (3^(2/3)) ((cR[0])^2)+4608 (3^(1/3)) ((cR[0])^4))-3360 (h0^3) (13691 (6^(1/3)) ((cR[0])^4)+22572 (2^(1/3)) ((cR[0])^6)))/(40739086080000 (6^(2/3)) h0 ((cR[0])^9)),
cR[12]->(8972541875 (6^(2/3)) (h0^8)-222888928500 (2^(1/3)) (h0^7) ((cR[0])^2)+116237721600 (3^(2/3)) ((cR[0])^8)-926580695040 (2^(1/3)) h0 ((cR[0])^8)-32400 (2^(2/3)) (h0^5) ((cR[0])^4) (168641+1592958 (3^(2/3)) ((cR[0])^2))+19440 (2^(2/3)) (h0^2) ((cR[0])^6) (-7007 (3^(2/3))+48259068 (3^(1/3)) ((cR[0])^2)+1268352 ((cR[0])^4))+32760 (2^(1/3)) (h0^4) ((cR[0])^4) (2624455 (3^(2/3))-1157184 (3^(1/3)) ((cR[0])^2)+8678016 ((cR[0])^4))+2700 (h0^6) (46965695 (3^(2/3)) ((cR[0])^2)-72606844 (3^(1/3)) ((cR[0])^4))-7776 (h0^3) ((cR[0])^6) (-31811745+90386140 (3^(2/3)) ((cR[0])^2)+65664 (3^(1/3)) ((cR[0])^4)))/(1715930305689600000 (6^(2/3)) (h0^2) ((cR[0])^11))};

Assuming[τ>0,Series[hprime[τ],{τ,0,16}]]//Simplify//Normal
hIR[h0_][τ_]=h0+Integrate[%,τ]

or=12;
Assuming[0<τs<τ,eomτ/.{𝒽->(hIR[h0][#]&),R-> Function[τ,(∑_(kk=0)^or)cR[kk](τ^kk)+((O[τ,0])^(or+1))/.solDiconnected]}]//Simplify
Solve[%[[3,1]]==0,cR[or]]//Simplify//Flatten

or=12;
Clear[RIRτdis,dRIRτdis]
RIRτdis[h0_,Rs_,τ_]=(∑_(kk=0)^or)cR[kk](τ^kk)/.solDiconnected/.cR[0]-> Rs;
dRIRτdis[h0_,Rs_,τ_]=D[%,τ];

computeDiskTau[τsnow_]:=Block[{ϵIR=ϵIRnow,τs=τsnow},


dog[τsnow]=NDSolve[{eomτsubs==0,R[τs+ϵIR]==RIRτ[τs,τs+ϵIR],R'[τs+ϵIR]==dRIRτ[τs,τs+ϵIR]}/.solh,R,{τ,τs+ϵIR,cutoffDisk},

WorkingPrecision->wpc,Method-> "StiffnessSwitching"][[1]]

]//Flatten

computeDiskDisconnected[Rsnow_]:=Block[{ϵIR=ϵIRnow,Rs=Rsnow},


dogDis[Rsnow]=NDSolve[{eomτsubs==0,R[ϵIR]==RIRτdis[h0,Rs,ϵIR],R'[ϵIR]==dRIRτdis[h0,Rs,ϵIR]}/.solh/.ruleh0,R,{τ,ϵIR,cutoffDisk},

WorkingPrecision->wpc,Method-> "StiffnessSwitching"][[1]]

]//Flatten

labelStyle=Directive[,FontFamily->"Courier",FontSize->14];


Clear[plotDisk]
plotDisk[τs_,plotstyle_:{{Darker[Blue],Thick}}]:=Block[{R0},

R0=R[dog[τs][[1,2,1,1,2]]]/.dog[τs];

Show[ParametricPlot[{{-R[τ],τ},{R[τ],τ}}/.dog[τs],{τ,dog[τs][[1,2,1,1,1]],dog[τs][[1,2,1,1,2]]},
Ticks->{{{-4,4},{-(Sqrt[3]),-1},{(Sqrt[3]),1},{4,4}},None(*{{0,0},{-1,1}}}*)}

,PlotRange->Automatic,AspectRatio->1/3,ImageSize->500,PlotStyle->plotstyle,LabelStyle->labelStyle,
AxesOrigin->{0,cutoffDisk}
]
]

]

Clear[plotDiskdisc]
plotDiskdisc[Rs_,plotstyle_:{{Darker[Blue],Thick}}]:=Block[{R0},

R0=R[dogDis[Rs][[1,2,1,1,2]]]/.dogDis[Rs];

Show[ParametricPlot[{{-R[τ],τ},{R[τ],τ}}/.dogDis[Rs],{τ,dogDis[Rs][[1,2,1,1,1]],dogDis[Rs][[1,2,1,1,2]]},

Ticks->{{{-4,4},{-(Sqrt[3]),-1},{(Sqrt[3]),1},{4,4}},None(*{{0,0},{-1,1}}}*)},PlotRange->All,AspectRatio->1/3,ImageSize->500,PlotStyle->plotstyle,LabelStyle->labelStyle,
AxesOrigin->{0,cutoffDisk}
]
]

]

Note that we increase the precision when computing the warp factor (since it appears later)

cutoff=15;wpcback=70;cutoffIR=(10^(-5));

maxsteps=20000;

computeWarpFactor

wpc=40;ϵIRnow=(10^(-4));cutoffDisk=cutoff;
$MinPrecision=wpc;

computeDiskTau[1/10];

Do[
computeDiskTau[k],{k,1,13}]

It will also be useful to define:

ruleh0=Solve[0==hIR[h0][τ]-𝒽[τ]/.solh/.τ->cutoffIR,h0]//Flatten

(2^(2/3))(h0/.ruleh0);
(1/(2π))((%)^(-1/2))

Do[computeDiskDisconnected[k/10],{k,2,26,2}];

Show[Flatten[{Append[Table[plotDisk[k],{k,1,13}],plotDisk[(1/10)]],Table[plotDiskdisc[(k/10),{Orange,Thick}],{k,2,26,2}]}],
ListLinePlot[{{-4,cutoffDisk},{4,cutoffDisk}},PlotStyle->{Black}],
ListLinePlot[{{-4,0},{4,0}},PlotStyle->{Black,Dashed}]
,PlotRange->{{-2.2,2.2},All}]
Export["KS_embeddings.pdf",%]

Near the boundary behaviour of the embedding

The Klebanov–Strassler background exhibits a somewhat intricate UV behavior near the boundary, so the equations will require some manipulation.

(hprime[τ]//TrigToExp//Simplify)/.{(E^(num_ τ))->((eτ)^num)}//Simplify
(Series[%,{eτ,∞,15}]//Normal//Simplify)/.eτ->Exp[τ]
hUV[τ_]=Integrate[%,τ];

In particular, it is useful to work with the exponential, rather the hypergeometric functions,

Solve[eomτsubs==0,R''[τ]]//TrigToExp//Simplify;
eqaux=Assuming[τ>0,%//Simplify//Flatten][[1]]/.(x_->y_)->x-y

In this way, we can treat the exponentials order by order. The following computations actually take quite some time, if you lack pacience you can load the solution from the initialization cell below.

eqaux/.{𝒽-> (hUV[#]&),R-> (R0 + f1[#](E^(-2#/3))&)}/.{(E^(num_ τ))->((eτ)^num)}/.{(E^τ)->eτ};
aux=Assuming[τ>0&&((eτ)^(2/3))>0,((eτ)^(2/3))%/.{(E^(num_ τ))->((eτ)^num)}/.{(E^τ)->eτ}//Simplify];
Assuming[τ>0&&((eτ)^(2/3))>0,Series[aux,{eτ,∞,0}]]

f1[τ]/.DSolve[((9-36 τ-32 R0 f1[τ]+72 R0 f1''[τ])/(72 R0))==0,f1,τ][[1]]/.{(C[1])->0,(C[2])->0}

The constants are set to zero, because they correspond to modes with an exponential, which correspond to other orders in the expansion.

rulef1={f1-> Function[τ,((9-36 τ)/(32 R0))]};

eqaux/.{𝒽-> (hUV[#]&),R-> (R0 + f1[#](E^(-2#/3))+ f2[#](E^(-4#/3))&)}/.{(E^(num_ τ))->((eτ)^num)}/.{(E^τ)->eτ};
aux=Assuming[τ>0&&((eτ)^(2/3))>0,((eτ)^(2/3))%/.{(E^(num_ τ))->((eτ)^num)}/.{(E^τ)->eτ}/.rulef1//Simplify];
Assuming[τ>0&&((eτ)^(2/3))>0,Series[aux,{eτ,∞,1}]]

f2[τ]/.DSolve[(-3807-4860 τ+11664 (τ^2)-5184 (τ^3)-128 (R0^3) f2'[τ]+1024 (R0^3) τ f2'[τ]-2048 (R0^3) (τ^2) f2'[τ]+96 (R0^3) f2''[τ]-768 (R0^3) τ f2''[τ]+1536 (R0^3) (τ^2) f2''[τ])==0,f2,τ][[1]]/.(C[2])->R4/.(C[1])->0//Simplify

rulef2={f2-> Function[τ,R4-((81 (4 (E^(1/3)) (-2+τ) τ+9 (E^(4 τ/3)) ExpIntegralEi[(1/3) (1-4 τ)]))/(256 (E^(1/3)) (R0^3)))]};

Entanglement entropy

Near the boundary behaviour and formulas for the entanglement entropy

(ℒdimless//TrigToExp//Simplify)/.𝒽-> (hUV[#]&)/.R-> (R0 + f1[#](E^(-2#/3))+f2[#](E^(-4#/3))+f3[#](E^(-6#/3))&);
aux=Assuming[τ>0&&((eτ)^(2/3))>0,%/.{(E^(num_ τ))->((eτ)^num)}/.{(E^τ)->eτ}//Simplify];

ℒdimlessSeries=Assuming[τ>0&&((eτ)^(2/3))>0,Series[aux,{eτ,∞,1}]//Simplify]

ℒctaux=(((R0^2) (-1+4 τ) ((eτ)^(2/3)))/(512 (2^(1/3))))+((R0 (9 (-1+4 τ) f1[τ]+4 R0 (((2 f1[τ]-3 f1'[τ]))^2)))/(2304 (2^(1/3))));

ℒdimlessSeries-ℒctaux//Simplify
ℒUVaux=%//Normal

ℒct//Clear
Assuming[τ>0,ℒct[R0_,τ_]=ℒctaux/.rulef1/.eτ-> Exp[τ]//Simplify]

factor %//Simplify//Collect[#,(E^(2 τ/3)),Simplify]&

Sct[R0_,τ_]=Integrate[ℒct[R0,τ],τ]

Sct[R0,τ];
factor %//Simplify//Collect[#,(E^(2 τ/3)),Simplify]&

ℒUV//Clear
Assuming[τ>0,ℒUV[R0_,R4_,τ_]=ℒUVaux/.rulef1/.rulef2/.eτ-> Exp[τ]//Simplify]

Clear[SEEUV]
Integrate[ℒUV[R0,R4,τ],τ]//Simplify
SEEUV[R0_,R4_,τs_]=Limit[%,τ->∞]-Limit[%,τ->τs]

Code to compute the entanglement entropy

RUV[R0_,R4_,τ_]=R0 + f1[τ](E^(-2τ/3))+ f2[τ](E^(-4τ/3))/.rulef1/.rulef2;
Rprime[R0_,R4_,τ_]=D[%,τ];

integrand[R0_,τ_]=Assuming[τ>0,(ℒdimless//TrigToExp//Simplify)-ℒct[R0,τ]//Together//Simplify]

computeEEvarτ[τs_]:=Block[{R0,R4,hofτ},

{R0,R4}={R0h,R4h}/.FindRoot[
{RUV[R0h,R4h,dog[τs][[1,2,1,1,2]]]-R[dog[τs][[1,2,1,1,2]]]/.dog[τs],
Rprime[R0h,R4h,dog[τs][[1,2,1,1,2]]]-R'[dog[τs][[1,2,1,1,2]]]/.dog[τs]
},{{R0h,R[dog[τs][[1,2,1,1,2]]]/.dog[τs]},{R4h,R4seed}},WorkingPrecision->wpc];

R4seed=R4;

(*SEEUV[R0,R4,cutoff]//Print;*)

{τs,R0,R4,

NIntegrate[integrand[R0,τ]/.solh/.dog[τs],{τ,dog[τs][[1,2,1,1,1]],cutoff},WorkingPrecision->wpc,AccuracyGoal->acc,PrecisionGoal->prec]+
SEEUV[R0,R4,cutoff]+
-Sct[R0,τs]}
]

computeEEvarτDisc[Rs_]:=Block[{R0,R4,hofτ},

{R0,R4}={R0h,R4h}/.FindRoot[

{RUV[R0h,R4h,dogDis[Rs][[1,2,1,1,2]]]-R[dogDis[Rs][[1,2,1,1,2]]]/.dogDis[Rs],
Rprime[R0h,R4h,dogDis[Rs][[1,2,1,1,2]]]-R'[dogDis[Rs][[1,2,1,1,2]]]/.dogDis[Rs]
},{{R0h,R[dogDis[Rs][[1,2,1,1,2]]]/.dogDis[Rs]},{R4h,R4seed}},WorkingPrecision->wpc];

R4seed=R4;

(*SEEUV[R0,R4,cutoff]//Print;*)

{Rs,R0,R4,

NIntegrate[integrand[R0,τ]/.solh/.dogDis[Rs],{τ,dogDis[Rs][[1,2,1,1,1]],cutoff},WorkingPrecision->wpc,AccuracyGoal->acc,PrecisionGoal->prec]+
SEEUV[R0,R4,cutoff]+
-Sct[R0,0]}
]

plotIntegrand[τs_]:=Block[{R0,R4,hofτ},


{R0,R4}={R0h,R4h}/.FindRoot[

{RUV[R0h,R4h,dog[τs][[1,2,1,1,2]]]-R[dog[τs][[1,2,1,1,2]]]/.dog[τs],
Rprime[R0h,R4h,dog[τs][[1,2,1,1,2]]]-R'[dog[τs][[1,2,1,1,2]]]/.dog[τs]
},{{R0h,R[dog[τs][[1,2,1,1,2]]]/.dog[τs]},{R4h,3}},WorkingPrecision->wpc];

Print[R0];

Show[
Plot[integrand[R0,τ]/.solh/.dog[τs],{τ,dog[τs][[1,2,1,1,1]],cutoff},PlotRange->All,PlotStyle->Darker[Blue]],

Plot[ℒUV[R0,R4,τ]/.solh/.dog[τs],{τ,1cutoff/2,cutoff},PlotRange->All,PlotStyle->{Red,Dashed,Thick}]
,ImageSize->150
]



]

Numerics

R4seed=3; 
(* because the values of R0 and R4 are obtained using FindRoot, an initial seed is required.
Then the seed is updated everytime an embedding is calculated. *)

computeEEvarτDisc[1]

computeEEvarτ[1]

computeDiskTau[1/10];
computeEEvarτ[1/10]

computeEEvarτ[10]

Row[{plotIntegrand[1/10],plotIntegrand[1],plotIntegrand[10]}]

This justifies our choice of cutoff = 15.

Dynamic[τshere]

R4seed=3;
tableEE=Table[
 $MinPrecision=wpc;
computeDiskTau[τshere];
computeEEvarτ[τshere],{τshere,1,10,1/10}];

R4seed=tableEE[[-1,3]];

tableEEmore=Table[
 $MinPrecision=wpc;
computeDiskTau[τshere];
computeEEvarτ[τshere],{τshere,1/100,1,1/10}]//Quiet;

tableEEdisconnected=Table[
 $MinPrecision=wpc;
computeDiskDisconnected[Rshere];
computeEEvarτDisc[Rshere],{Rshere,1/100,1,1/10}]//Quiet;

tableEEdisconnectedmore=Table[
computeDiskDisconnected[Rshere];
computeEEvarτDisc[Rshere],{Rshere,1,10,1/10}]//Quiet;

tableEEaux=Join[tableEEmore,tableEE];

tableEEdisconaux=Join[tableEEdisconnected,tableEEdisconnectedmore];

saveResults={tableEEaux,tableEEdisconaux};

DeleteFile["EE_KS.mx"];
Save["EE_KS.mx",{saveResults}];

saveResults=%152;

Results and Plots

saveResults=Get["EE_KS.mx"];

{tableEEaux,tableEEdisconaux}=saveResults;

tableresults={tableEEaux[[All,{2,4}]],tableEEdisconaux[[All,{2,4}]]};

labelStyle=Directive[,FontFamily->"Courier",FontSize->14];

((M0^4)/(4 G10))64(π^3)4π /.G10 ->8(π^6)(ls^8)(gs^2)/.M0->(gs M (ls^2))(2^(1/3))//Simplify
factor = %/((gs^2)(M^4))
%//N

ListLinePlot[(tableresults).{{(2^(1/3)),0},{0,factor}},
Frame->True,AxesOrigin->{0,0},
PlotRange->{{0,8},{-20/100,1.2}},
PlotStyle->{{Darker[Blue],Thick},{Orange,Thick}},
ImageSize->350,
LabelStyle->labelStyle,Frame->True,AspectRatio->(GoldenRatio^(-1)),
PlotRangePadding->0,
ImagePadding->{{36,15},{15,5}}
]
Export["Entropies_KS.pdf",%]

ListLinePlot[(tableresults).{{(2^(1/3)),0},{0,factor}},
Frame->True,AxesOrigin->{0,0},
PlotRange->{{1.709,1.7121},{-.0182,-.0177}},
PlotStyle->{{Darker[Blue],Thick},{Orange,Thick}},
ImageSize->350,
LabelStyle->labelStyle,Frame->True,AspectRatio->(GoldenRatio^(-1)),
PlotRangePadding->0,
ImagePadding->{{36,15},{15,5}}
]

intOrder=4;

tableresults={tableEEaux[[All,{2,4}]],tableEEdisconaux[[All,{2,4}]]};

Roftaus=Interpolation[tableEEaux[[All,{1,2}]].{{1,0},{0,(2^(1/2))}},InterpolationOrder->intOrder];
EEoftaus= Interpolation[tableEEaux[[All,{1,4}]].{{1,0},{0,factor}},InterpolationOrder->intOrder];

Roftausdisc=Interpolation[tableEEdisconaux[[All,{1,2}]].{{1,0},{0,(2^(1/2))}},InterpolationOrder->intOrder];
EEoftausdisc=Interpolation[tableEEdisconaux[[All,{1,4}]].{{1,0},{0,factor}},InterpolationOrder->intOrder];

EprimeOfTaus[τs_]=EEoftaus'[τs]/Roftaus'[τs];
EppOfTaus[τs_]=((Roftaus'[τs] EEoftaus''[τs]-EEoftaus'[τs] Roftaus''[τs])/((Roftaus'[τs])^3));

EprimeOfTausDisc[τs_]=EEoftausdisc'[τs]/Roftaus'[τs];
EppOfTausDisc[τs_]=(Roftausdisc'[τs] EEoftausdisc''[τs]-EEoftausdisc'[τs] Roftausdisc''[τs])/((Roftausdisc'[τs])^3);

(1/2)(L D[#,L]&)@(L D[EE[L],L]-2EE[L])//Simplify
%/.{func_''[L]->((ℓ'[τs])^(-1))D[((ℓ'[τs])^(-1)) func'[τs] ,τs],func_'[L]->((ℓ'[τs])^(-1)) func'[τs] ,func_[L]-> func[τs]}/.L-> ℓ[τs]//Simplify
cDiconnectedOfTau[τs_]=%/.ℓ-> Roftausdisc/.EE->EEoftausdisc;

(*p1=ParametricPlot[{Roftausdisc[τs],cDiconnectedOfTau[τs]},{τs,Roftausdisc[[1,1,1]],Roftausdisc[[1,1,2]]},AspectRatio->(GoldenRatio^(-1)),PlotStyle->{Orange,Thick}];

p1=ListLinePlot[Transpose[{Roftausdisc[τs],cDiconnectedOfTau[τs]}/. τs->tableEEaux[[3;;-1,1]]],PlotRange->All,AspectRatio->(GoldenRatio^(-1)),PlotStyle->{Orange,Thick}];

{Roftaus[τs],(1/2)Roftaus[τs] (-EprimeOfTaus[τs]+Roftaus[τs] EppOfTaus[τs])}/.τs->tableEEaux[[6;;-1,1]]//Transpose;
p2=ListLinePlot[%,PlotStyle->{Darker[Blue],Thick}];

plotcKS=Show[p2,p1,
PlotRange->{{0,8},{-1,4}},Frame->True,AxesOrigin->{0,0},
PlotStyle->{{Darker[Blue],Thick},{Orange,Thick}},
ImageSize->350,
LabelStyle->labelStyle,Frame->True,AspectRatio->(GoldenRatio^(-1)),
PlotRangePadding->0,
ImagePadding->{{36,15},{15,5}}]
Export["cfunction_KS.pdf",%]

p1aux=ListLinePlot[Transpose[{Roftausdisc[τs],EprimeOfTaus[τs]}/. τs->tableEEaux[[3;;-1,1]]],PlotRange->All,AspectRatio->(GoldenRatio^(-1)),PlotStyle->{Orange,Thick},PlotMarkers->{Automatic, 5}];

{Roftaus[τs],EprimeOfTaus[τs]}/.τs->tableEEaux[[6;;-1,1]]//Transpose;
p2aux=ListLinePlot[%,PlotStyle->{Darker[Blue],Thick},PlotMarkers->{Automatic, 5}];

Show[p2aux,p1aux,
PlotRange->{{0,7},{-.1,0.2}},Frame->True,AxesOrigin->{0,0},
PlotStyle->{{Darker[Blue],Thick},{Orange,Thick}},
ImageSize->350,
LabelStyle->labelStyle,Frame->True,AspectRatio->(GoldenRatio^(-1)),
PlotRangePadding->0,FrameLabel-> {"R","E'(R)"}]
Export["fig2.pdf",%]

(*Show[plotcKS,limitingc,
PlotRange->{{5,10},{-0.6,0}},
ImagePadding->{{36,15},{15,5}},
ImageSize->178,
FrameTicks->{{5,10},{0,-.6},None,None}
]
Export["cfunction_KS_zoom.pdf",%]

c-holo

Solve[Λkk==(ϵ^(2/3))/(gs (ls^2) M),ϵ]

Assuming[ϵ>0&&Λkk>0&&M>0&&gs>0&&ls>0,((((Sqrt[Mfile]) (ϵ^2)))/(G10 ))/.Mfile->((8(π^6))/3)(ϵ^(20/3))/.G10 ->8(π^6)(ls^8)(gs^2)/.ϵ->(((gs (ls^2) M Λkk))^(3/2))//Simplify]

((((Sqrt[M]) (ϵ^2)))/(G10 ))((((3/(Sqrt[6]))))^3)  ((((Sinh[τ])^2) ((𝒽[τ])^2))/(((k[τ])^2) (((((2 k'[τ])/(k[τ]))+4 Coth[τ]+((𝒽'[τ])/(𝒽[τ]))))^3)))/. rulek
LogLogPlot[((%)/(((Sqrt[M]) (ϵ^2))/G10))/. solh/. τ->(1/x),{x,(1/15),(1/(1/(10^2)))},PlotRange->All,PlotStyle->{{Darker[Black],Thick}}];
((((((3/(Sqrt[6]))))^3) (((Sinh[τ])^2) ((𝒽[τ])^2)))/(((k[τ])^2) (((((2 k'[τ])/(k[τ]))+4 Coth[τ]+((𝒽'[τ])/(𝒽[τ]))))^3)))/. 𝒽->hUV/. τ->(1/x)/. rulek;
Quiet[LogLogPlot[%,{x,(1/1000),(1/15)},WorkingPrecision->200,PlotStyle->{{Darker[Black],Thick}}]];
Show[%%%,%,PlotRange->All,Frame->True,Axes->None,LabelStyle->labelStyle,ImageSize->350]
Export["choloKS.pdf",%]

((((Sqrt[M]) (ϵ^2)))/(G10 ))((((((3/(Sqrt[6]))))^3)  (((Sinh[τ])^2) ((𝒽[τ])^2)))/((((k[τ])^2) (((((2 k'[τ])/(k[τ]))+4 Coth[τ]+((𝒽'[τ])/(𝒽[τ]))))^3))))/. rulek;
Plot[((%)/(((Sqrt[M]) (ϵ^2))/G10))/. solh,{τ,(10^(-5)),15},PlotRange->All,PlotStyle->{{Darker[Black],Thick}},Frame->True,Axes->None,LabelStyle->labelStyle,ImageSize->350,PlotRangePadding->{{0,0},{.2,0}}]
Export["choloKS.pdf",%]

((((Sqrt[M]) (ϵ^2)))/(G10 ))((((((3/(Sqrt[6]))))^3)  (((Sinh[τ])^2) ((𝒽[τ])^2)))/((((k[τ])^2) (((((2 k'[τ])/(k[τ]))+4 Coth[τ]+((𝒽'[τ])/(𝒽[τ]))))^3))))/. rulek
LogLogPlot[((%)/(((Sqrt[M]) (ϵ^2))/G10))/. solh,{τ,(10^(-5)),15},PlotRange->All,PlotStyle->{{Darker[Black],Thick}}];
((((((3/(Sqrt[6]))))^3) (((Sinh[τ])^2) ((𝒽[τ])^2)))/(((k[τ])^2) (((((2 k'[τ])/(k[τ]))+4 Coth[τ]+((𝒽'[τ])/(𝒽[τ]))))^3)))/. 𝒽->hUV/. τ->(1/x)/. rulek;
Quiet[LogLogPlot[%,{x,(1/1000),(1/15)},WorkingPrecision->200,PlotStyle->{{Darker[Black],Thick}}]];
Show[%%%,%,PlotRange->All,Frame->True,Axes->None,LabelStyle->labelStyle,ImageSize->350]
Export["choloKS.pdf",%]

c hol anisotropic

{sqrtDetg8->Function[τ,
Assuming[ϵ>0&&τ>0&&k[τ]>0,
(((((h[τ])^(-(3/2)))((((h[τ])^(1/2)) (ϵ^(4/3)))/(6 ((k[τ])^2)))((((1/2)((h[τ])^(1/2))(ϵ^(4/3))k[τ]))^4)((Cosh[(τ/2)])^4)((Sinh[(τ/2)])^4)))^(1/2))//FullSimplify]//Evaluate],

b->Function[τ,((h[τ] (ϵ^(4/3)))/(6 ((k[τ])^2)))] (* hmmm check once more *)

};
(*  H[r]  *)   (VolR3^2)(((64(π^3)))^2)((sqrtDetg8[τ])^2)/.%//FullSimplify
Assuming[ϵ>0&&τ>0&&k[τ]>0,((((d-1))^(d-1))/G10)((b[τ])^((d-1)/2))((((%))^((2d-1)/2))/(((D[%,τ]))^(d-1)))/.%%/.d->4//Simplify//FullSimplify]
Assuming[ϵ>0&&τ>0&&k[τ]>0&&VolR3>0,%-(((3 (gs^2) (M^4) VolR3)/(2 (2^(2/3)) (π^3)))) (((((Sinh[τ])^2) ((𝒽[τ])^2)))/((((k[τ])^2) (((((2 k'[τ])/(k[τ]))+4 Coth[τ]+((𝒽'[τ])/(𝒽[τ]))))^3))))/.h->( (M0^2) (ϵ^(-8/3))𝒽[#]&)/.G10 ->8(π^6)(ls^8)(gs^2)/.M0->(gs M (ls^2))(2^(1/3))//Simplify]

Assuming[ϵ>0,((3 (gs^2) (M^4) VolR3)/(2 (2^(2/3)) (π^3)))/(((((((Sqrt[Mc]) (ϵ^2)))/(G10 ))((((3/(Sqrt[6]))))^3)/.Mc->((8(π^6))/3)(ϵ^(20/3))))^(-1))/.G10 ->8(π^6)(ls^8)(gs^2)/.M0->(gs M (ls^2))(2^(1/3))//Simplify]

computeWarpFactor

(((3 (gs^2) (M^4) VolR3)/(2 (2^(2/3)) (π^3)))) (((((Sinh[τ])^2) ((𝒽[τ])^2)))/((((k[τ])^2) (((((2 k'[τ])/(k[τ]))+4 Coth[τ]+((𝒽'[τ])/(𝒽[τ]))))^3))))/. rulek;
Plot[((%)/(((gs^2) (M^4) VolR3)))/. solh,{τ,(10^(-5)),15},PlotRange->All,PlotStyle->{{Darker[Black],Thick}},Frame->True,Axes->None,LabelStyle->labelStyle,ImageSize->350,PlotRangePadding->{{0,0},{.2,0}}]
Export["choloKS.pdf",%]

(((3 (gs^2) (M^4) VolR3)/(2 (2^(2/3)) (π^3)))) (((((Sinh[τ])^2) ((𝒽[τ])^2)))/((((k[τ])^2) (((((2 k'[τ])/(k[τ]))+4 Coth[τ]+((𝒽'[τ])/(𝒽[τ]))))^3))))/. rulek;
ParametricPlot[{(1/(1+τ)),((%)/(((gs^2) (M^4) VolR3)))/. solh},{τ,(10^(-5)),15},
PlotRange->{{0,1},{0,6/10}}
,PlotStyle->{{Darker[Black],Thick}},Frame->True,Axes->None,LabelStyle->labelStyle,ImageSize->350,AspectRatio->(GoldenRatio^(-1)),
PlotRangePadding->{{.00002,.001},{.002,0}}]
Export["choloKS.pdf",%]

SetDirectory[NotebookDirectory[]]

Assuming[ϵ>0&&τ>0&&k[τ]>0&&gs>0&&ls>0&&𝒽[τ]>0&&M>0,(64(π^3))(Sqrt[(((ϵ^(20/3)) h[τ] ((k[τ])^2) ((Sinh[τ])^4))/1536)])/.h->( (M0^2) (ϵ^(-8/3))𝒽[#]&)/.M0->(gs M (ls^2))(2^(1/3))//Simplify]
%(((((2 (2^(5/6))(π^3))/(Sqrt[3]))((ls^(2 ))gs M (ϵ^2))))^(-1))

((2 (2^(5/6))(π^3))/(Sqrt[3]))//FullSimplify

((π^3)/(12 (2^(1/3))))((((ls^(2 ))gs M (ϵ^2)))^2)//TeXForm
((k[τ])^2) ((Sinh[τ])^4) 𝒽[τ]//TeXForm

h[τ]/.h->(((Λkk)^(-2)) (ϵ^(-4/3))2^(2/3)𝒽[#]&)
h[τ]/.h->( (M0^2) (ϵ^(-8/3))𝒽[#]&)/.M0->(gs M (ls^2))(2^(1/3))
%-%%/.Λkk->(ϵ^(2/3))/(gs (ls^2) M)//Simplify

(gs^2) (ls^4) (M^2) (π^3) (ϵ^4)/.Solve[{Λs==((ϵ^(2/3))/((ls^2) (Sqrt[gs M]))),Λkk==((ϵ^(2/3))/(gs (ls^2) M))},{ϵ,gs}]//Simplify