Settings

fontSize=11;

labelStyle=LabelStyle->{FontFamily->"Times",Black,FontSize->fontSize};

SetOptions[Plot,labelStyle,Frame->True,FrameStyle->Black];
SetOptions[ListPlot,labelStyle,Frame->True,FrameStyle->Black];
SetOptions[LineLegend,labelStyle];

Large deviation function

G[σ_][ω_]:=-(ω/(2σ))(Sqrt[((ω^2)/(((2σ))^2))-1])+Log[(ω/(2σ))+(Sqrt[((ω^2)/(((2σ))^2))-1])]

pG=Plot[Evaluate[ReIm[G[1][ω]]],{ω,-0.1,4.1},FrameLabel->{"μ / σ",(Subscript[G, 0])[μ]},Epilog->Inset[LineLegend[ColorData[97]/@Range[2],{"Real part","Imaginary part"}],Scaled[{0.23,0.15}]],PlotRange->{{-0.1,4.1},{-1.7,1.7}},ImageSize->340]

Export["~/doc/research/frsb_kac-rice/papers/marginal/figs/large_deviation.pdf",pG]

f34=Function[q,(1/2)((q^3)+(q^4))];

μm[f_]:=(Sqrt[4f''[1]])

ρ[f_,μ_][λ_]:=(2/(π μm[f]))(Sqrt[1-((((λ-μ))^2)/((μm[f])^2))])

340/3.

plotSpec[μ_,lab_]:=Plot[ρ[f34,μ][λ],{λ,-3,15},AspectRatio->2/3,PlotRange->{{-3,15},{0,4(4/10)(2/(π μm[f34]))}},FrameStyle->Black,ImageSize->118,PlotRangeClipping->False,Frame->True,FrameTicks->{{None,None},{None,{0}}},ImagePadding->{{Automatic,Automatic},{4,Automatic}}]

plotSpecWithμArrow[μ_,lab_,lab2_:None]:=Show[plotSpec[μ,lab],Prolog->{Arrow[{{0,(2/(π μm[f34]))(1/8)},{μ,(2/(π μm[f34]))(1/8)}}],{Dashed,Line[{{μ,0},{μ,(2/(π μm[f34]))}}],Text[Style["μ",SingleLetterItalics->False,Directive[FontFamily->"Times",Black,FontSize->fontSize]],{μ/2,(2/(π μm[f34]))(5/16)}]},{Arrowheads[{-Automatic,Automatic}],Arrow[{{μ+μm[f34],(2/(π μm[f34]))(1/8)},{μ,(2/(π μm[f34]))(1/8)}}]},Text[Style["2σ",SingleLetterItalics->False,Directive[FontFamily->"Times",Black,FontSize->fontSize]],{μ+μm[f34]/2,(2/(π μm[f34]))(5/16)}]}(*Epilog->Text[Style["("<>lab<>")",SingleLetterItalics->False,Directive[Bold,FontFamily->Times,Black,FontSize->10]],{15.5,(2/(π μm[f34]))(11.25/8)}]*),FrameLabel->{None,lab2},RotateLabel->False]

plotSpecWithIso[μ_,λi_,lab_,lab2_:None]:=Show[
plotSpec[μ,lab],
Prolog->{(*Line[{{λi,(2/(π μm[f34]))(1/8)},{λi,(2/(π μm[f34]))(5/8)}}],Text[Style["(Subscript[λ, 0])",SingleLetterItalics->False,Directive[FontFamily->"Helvetica",Black,FontSize->10]],{λi+0.1,(2/(π μm[f34]))(6.25/8)}],*)Arrow[{{0,(2/(π μm[f34]))(1/8)},{μ,(2/(π μm[f34]))(1/8)}}],{Dashed,Line[{{μ,0},{μ,(2/(π μm[f34]))}}],Text[Style["μ",SingleLetterItalics->False,Directive[FontFamily->"Times",Black,FontSize->fontSize]],{μ/2,(2/(π μm[f34]))(5/16)}]},{Arrowheads[{-Automatic,Automatic}],Arrow[{{μ+μm[f34],(2/(π μm[f34]))(1/8)},{μ,(2/(π μm[f34]))(1/8)}}]},Text[Style["2σ",SingleLetterItalics->False,Directive[FontFamily->"Times",Black,FontSize->fontSize]],{μ+μm[f34]/2,(2/(π μm[f34]))(5/16)}]},
Epilog->{{ColorData[97][1],PointSize[0.05],Point[{λi,0}]}(*,Text[Style["("<>lab<>")",SingleLetterItalics->False,Directive[Bold,FontFamily->"Helvetica",Black,FontSize->10]],{15.5,(2/(π μm[f34]))(11.25/8)}]*)},PlotRangeClipping->False,FrameLabel->{None,lab2},RotateLabel->False
]

pS1=plotSpecWithμArrow[4,"a",ρ[λ]]

pS2=plotSpecWithμArrow[6,"b",Style[ρ[λ],Opacity[0]]]

ps6=plotSpecWithIso[8,0,"f",Style[ρ[λ],Opacity[0]]]

Export["~/doc/research/frsb_kac-rice/papers/marginal/figs/spectrum_less.pdf",pS1];
Export["~/doc/research/frsb_kac-rice/papers/marginal/figs/spectrum_eq.pdf",pS2];
Export["~/doc/research/frsb_kac-rice/papers/marginal/figs/spectrum_more.pdf",ps6];

Two-sphere

p0RSBrules={
p0RSBmat[n_,{adt_,a0tu_,a0tl_,ad_,a0_}].p0RSBmat[n_,{bdt_,b0tu_,b0tl_,bd_,b0_}]:>p0RSBmat[n,{
adt bdt+(n-1)a0tu b0tl,
a0tu bd+adt b0tu+(n-2)a0tu b0,
a0tl bdt+ad b0tl+(n-2)b0tl a0,
ad bd+a0tl b0tu+(n-2)a0 b0,
a0 bd+ad b0+a0tl b0tu+(n-3)a0 b0
}],
p0RSBmat[n_,{adt_,a0tu_,a0tl_,ad_,a0_}]+p0RSBmat[n_,{bdt_,b0tu_,b0tl_,bd_,b0_}]:>p0RSBmat[n,{
adt+bdt,
a0tu+b0tu,
a0tl+b0tl,
ad+bd,
a0+b0
}],
-p0RSBmat[n_,{adt_,a0tu_,a0tl_,ad_,a0_}]:>p0RSBmat[n,{-adt,-a0tu,-a0tl,-ad,-a0}],
logDet[p0RSBmat[n_,{adt_,a0tu_,a0tl_,ad_,a0_}]]:>(n-2)Log[ad-a0]+Log[adt ad+(n-2)adt a0-(n-1)a0tu a0tl],
((p0RSBmat[n_,{adt_,a0tu_,a0tl_,ad_,a0_}])^2):>p0RSBmat[n,{(adt^2),(a0tu^2),(a0tl^2),(ad^2),(a0^2)}],
sumDiag[p0RSBmat[n_,{adt_,a0tu_,a0tl_,ad_,a0_}]]:>adt+(n-1)ad,
sum[p0RSBmat[n_,{adt_,a0tu_,a0tl_,ad_,a0_}]]:>adt+(n-1)(ad+a0tu+a0tl)+((n^2)-1-3(n-1))a0
};

matForm[p0RSBmat[n_,{adt_,a0tu_,a0tl_,ad_,a0_}]]:=With[{a=Unique[a]},Array[a,{n,n}]/.{a[1,1]:>adt,a[i_,i_]:>ad,a[i_,j_]:>a0tu/;(i==1&&j!=1),a[i_,j_]:>a0tl/;(i!=1&&j==1),a[_,_]:>a0}]

A=p0RSBmat[7,{adt,a0tu,a0tl,ad,a0}];
B=p0RSBmat[7,{bdt,b0tu,b0tl,bd,b0}];

matForm[A]//MatrixForm

matForm[A].matForm[B]-matForm[A.B/.p0RSBrules]//MatrixForm

logDet[A]-Log[Det[matForm[A]]]/.p0RSBrules//FullSimplify[#,Assumptions->{ad>a0,a0>0,ad>0,ad>0}]&

𝒮twin=With[{Q11=p0RSBmat[n,{q11d1,q111,q111,q11d0,q110}],Q22=p0RSBmat[n,{q22d1,q221,q221,q22d0,q220}],Q12=p0RSBmat[n,{q12d1,q121,q121,q12d0,q120}]},
-β(ω1 sumDiag[Q11]+ω2 sumDiag[Q22]+2 ϵ sumDiag[Q12])+λ(ω1 q11d1+ω2 q22d1+2 ϵ q12d1)+((σ1)^2)((β^2)sum[(Q11^2)]+(λ^2)(q11d1^2)-2 β λ((q11d1^2)+(n-1)(q111^2)))+((σ2)^2)((β^2)sum[(Q22^2)]+(λ^2)(q22d1^2)-2 β λ((q22d1^2)+(n-1)(q221^2)))+(1/2)logDet[Q11.Q22-Q12.Q12]//.p0RSBrules
];

e00=FullSimplify[Limit[𝒮twin,n->0],Assumptions->{0<q11d0<1,0<q11d1<1,0<q110<1,0<q220<1}]/.-2Log[a_]+Log[b_]:>Log[FullSimplify[b/(a^2)]]

e00/.{q110->(Subscript[((q^11)), 0]),q220->(Subscript[((q^22)), 0]),q120->(Subscript[((q^12)), 0]),q11d0->(Subscript[((q^11)), d]),q11d0->(Subscript[((q^11)), d]),q22d0->(Subscript[((q^22)), d]),q12d0->(Subscript[((q^12)), d]),q11d1->(Subscript[(((OverTilde[q])^11)), d]),q22d1->(Subscript[(((OverTilde[q])^22)), d]),q12d1->(Subscript[(((OverTilde[q])^12)), d]),q111->(Subscript[(((OverTilde[q])^11)), 0]),q221->(Subscript[(((OverTilde[q])^22)), 0]),q121->(Subscript[(((OverTilde[q])^12)), 0])}

-(((-2 (Subscript[(q^22), 0]) (Subscript[((OverTilde[q])^11), 0])+(Subscript[(q^22), d]) (Subscript[((OverTilde[q])^11), 0])+2 (Subscript[(q^12), 0]) (Subscript[((OverTilde[q])^12), 0])-(Subscript[((OverTilde[q])^12), 0]) ((Subscript[(q^12), d])+(Subscript[((OverTilde[q])^12), d]))+(Subscript[((OverTilde[q])^11), d]) (Subscript[((OverTilde[q])^22), 0])) (2 (Subscript[(q^12), 0]) (Subscript[((OverTilde[q])^12), 0])-(Subscript[((OverTilde[q])^12), 0]) ((Subscript[(q^12), d])+(Subscript[((OverTilde[q])^12), d]))-2 (Subscript[(q^11), 0]) (Subscript[((OverTilde[q])^22), 0])+(Subscript[(q^11), d]) (Subscript[((OverTilde[q])^22), 0])+(Subscript[((OverTilde[q])^11), 0]) (Subscript[((OverTilde[q])^22), d]))-2 (3 (Subscript[((q^12)), 0]^2)-2 (Subscript[(q^12), 0]) (Subscript[(q^12), d])-3 (Subscript[(q^11), 0]) (Subscript[(q^22), 0])+(Subscript[(q^11), d]) (Subscript[(q^22), 0])+(Subscript[(q^11), 0]) (Subscript[(q^22), d])-(Subscript[(((OverTilde[q])^12)), 0]^2)+(Subscript[((OverTilde[q])^11), 0]) (Subscript[((OverTilde[q])^22), 0])) ((Subscript[(((OverTilde[q])^12)), 0]^2)-(Subscript[(((OverTilde[q])^12)), d]^2)-(Subscript[((OverTilde[q])^11), 0]) (Subscript[((OverTilde[q])^22), 0])+(Subscript[((OverTilde[q])^11), d]) (Subscript[((OverTilde[q])^22), d]))+(2 (Subscript[((q^12)), 0]^2)-(Subscript[((q^12)), d]^2)-2 (Subscript[(q^11), 0]) (Subscript[(q^22), 0])+(Subscript[(q^11), d]) (Subscript[(q^22), d])-(Subscript[(((OverTilde[q])^12)), 0]^2)+(Subscript[((OverTilde[q])^11), 0]) (Subscript[((OverTilde[q])^22), 0])) ((Subscript[(((OverTilde[q])^12)), 0]^2)-(Subscript[(((OverTilde[q])^12)), d]^2)-(Subscript[((OverTilde[q])^11), 0]) (Subscript[((OverTilde[q])^22), 0])+(Subscript[((OverTilde[q])^11), d]) (Subscript[((OverTilde[q])^22), d]))))//Simplify

e1=FullSimplify[Limit[𝒮twin,n->0],Assumptions->{0<q11d0<1,0<q11d1<1,0<q110<1,0<q220<1}]/.{q22d0->1-q11d0,q22d1->1-q11d1}

e2=FullSimplify[e1/.{ϵ->0,q120->0,q121->0,q12d0->0,q12d1->0},Assumptions->{(q111^2)+(-2 q110+q11d0) q11d1>0}]

e3=FullSimplify[D[e2,{{λ,q110,q111,q11d0,q11d1,q220,q221}}]];

rules={q110->q11d-y11/β-z110/(β^2),q111->q11d-y11/β-z111/(β^2),q11d0->q11d- y11d/β- z11d0/(β^2),q11d1->q11d- y11d/β- z11d1/(β^2),q220->q22d-y22/β-z220/(β^2),q221->q22d-y22/β-z221/(β^2),q22d->1-q11d};

e4=SeriesCoefficient[e3//.rules,{β,∞,-2}]

e5=SeriesCoefficient[e3//.rules,{β,∞,-1}]//Simplify

e6=SeriesCoefficient[e3[[1]]//.rules,{β,∞,0}]//Simplify

s6=Simplify[Solve[0==Join[e4,e5,{e6}],{λ,y11,y11d,y22,q11d,z110,z111,z11d0,z11d1,z220,z221}]];

testparams={σ1->1,σ2->1,ω1->3+2/10,ω2->200005/100000,ϵ->1/100};

rules2={q110->q11d-y110/β-z110/(β^2),q111->q11d-y111/β-z111/(β^2),q11d0->q11d- y11d0/β-z11d0/(β^2),q11d1->q11d-y11d1/β-z11d1/(β^2),q220->q22d-y220/β-z220/(β^2),q221->q22d-y221/β-z221/(β^2),q12d1->q12-y12d1/β-z12d1/(β^2),q12d0->q12-y12d0/β-z12d0/(β^2),q121->q12-y121/β-z121/(β^2),q120->q12-y120/β-z120/(β^2),q22d->1-q11d,λ->λ0-λ1/β-λ2/(β^2)};

stest2=Solve[0=={2 y120-2 y121-y12d0+y12d1,2 y110-2 y111-y11d0+y11d1,y11d0-y11d1+2 y220-2 y221},{y110,y120,y220}]

e9=Simplify[e1/.-2Log[x_]+Log[y_]:>Log[y (x^(-2))]//.rules2/.stest2[[1]],TimeConstraint->600];

e10=Simplify[Limit[e9,β->∞]];

e10

e11=Simplify[D[e10,{{q11d,q12,y111,y221,y12d1,y11d0,y11d1,y121,y12d0,z110,z111,z11d0,z11d1,z220,z221,z120,z121,z12d0,z12d1,λ0}}]];

iniTest=Thread[{{q11d,q12,y111,y221,y12d1,y11d0,y11d1,y121,y12d0,z110,z111,z11d0,z11d1,z220,z221,z120,z121,z12d0,z12d1,λ0},
{q11d,q12,y111,y221,y12d1,y11d0,y11d1,y121,y12d0,z110,z111,z11d0,z11d1,z220,z221,z120,z121,z12d0,z12d1,λ0}/.{
λ0-> λ,y110->y11,y111->y11,y220->y22,y221->y22,y11d0->y11d,y11d1->y11d
}/.s6[[3]]/.{z111->0,z110->0,z11d0->0,z220->0,z221->0,z11d1->0,q12->0,y12d1->0,y121->0,y12d0->0,z120->0,z121->0,z12d0->0,z12d1->0}/.Append[Most[testparams],ϵ->(10^(-2))]/. 0:>RandomReal[](10^(-5))
}];
newsol=FindRoot[e11/.Append[Most[testparams],ϵ->(10^(-2))],iniTest,WorkingPrecision->20,MaxIterations->1000]

e12=FoldList[Function[{sol,ω22},Join[Append[Delete[testparams,{4}],ω2->ω22],FindRoot[e11/.Append[Delete[testparams,{4}],ω2->ω22],Drop[sol,5]/.Rule->List,WorkingPrecision->20]]],Join[Append[Most[testparams],ϵ->(10^(-2))],newsol],Range[200005/100000,200003/100000,-(10^(-6))]];

testzero=SelectFirst[e12,Abs[λ0]<(10^(-2))/.#&];
solzero=Join[{λ0->0},Delete[Take[testzero,5],{4}],FindRoot[e11/.Delete[Take[testzero,5],{4}]/.λ0->0,Prepend[Delete[Drop[testzero,5],{-1}],ω2->(ω2/.testzero)]/.Rule->List,WorkingPrecision->30]]

solzeros=FoldList[Function[{sol,ϵϵ},Join[Append[Take[sol,4],ϵ->ϵϵ],FindRoot[e11/.Append[Take[sol,4],ϵ->ϵϵ],Drop[sol,5]/.Rule->List,WorkingPrecision->20,MaxIterations->500]]],solzero,Range[1/100,1.6,(10^(-3))]];

ListPlot[{ϵ,ω2}/.solzeros]

SetAttributes[untilSuccess,HoldAll];
untilSuccess[e_]:=Quiet[Check[e,untilSuccess[e]]]

e13=(inisol|->FoldWhileList[Function[{sol,ω11},Join[Append[Take[sol,4],ω1->ω11],untilSuccess@FindRoot[e11/.Append[Take[sol,4],ω1->ω11],{#1,#2+(10^(-6))RandomVariate[NormalDistribution[]]}&@@@Drop[sol,5]/.Rule->List,WorkingPrecision->28]]],Join[inisol[[{1,2,3,5,4,6}]],inisol[[7;;]]],Range[Rationalize[ω1/.inisol,(10^(-6))],2,-(10^(-2))/4],ω2<ω1/.#&])/@((ϵϵ|->SelectFirst[solzeros,ϵ==ϵϵ/.#&])/@Range[0.2,1.4,0.2]);

(testω0=Rationalize[{ω1,ω2}/.First[MinimalBy[e13[[2]],Abs[ω1-2.8]/.#&],(10^(-9))]])//N

(testω=Rationalize[{ω1,ω2}/.First[MinimalBy[e13[[4]],Abs[ω1-2.8]/.#&],(10^(-9))],(10^(-9))])//N

(testω2=Rationalize[{ω1,ω2}/.First[MinimalBy[e13[[6]],Abs[ω1-2.8]/.#&],(10^(-9))],(10^(-9))])//N

mlegend=LineLegend[ColorData[97]/@Range[8],NumberForm[#,{∞,1}]&/@Range[0,1.4,0.2],LegendLabel->ϵ,labelStyle,LegendLayout->"Row"]

mplot1=ListPlot[Evaluate[Prepend[Join[{ω1,ω2}/.Most[#],{ω2,ω1}/.Reverse[Most[#]]]&/@e13,{{3.1,2},{2,2},{2,3.1}}]],PlotRange->{{1.7,3.1},{1.7,3.1}},AspectRatio->1,Joined->True,FrameLabel->{(Subscript[ω, 1]),(Subscript[ω, 2])},ImageSize->165,labelStyle,Epilog->{EdgeForm[Black],Thread[{ColorData[97]/@{1,3,5,7},Disk[#,0.016]&/@{{2.8,2},testω0,testω,testω2}}],Inset[Style["(a)",FontSize->fontSize,Black,Bold],Scaled[{0.11,0.9}]]}]

Two-sphere spectrum

𝒮=(1/4)((Subscript[σ, 1])^2)((Subscript[q, 11])^2)+(1/4)((Subscript[σ, 2])^2)((Subscript[q, 22])^2)-(1/2)(λ((Subscript[q, 11])+(Subscript[q, 22]))-(Subscript[ω, 1])(Subscript[q, 11])-(Subscript[ω, 2])(Subscript[q, 22])-2 ϵ (Subscript[q, 12]))+(1/2)Log[Det[{{(Subscript[q, 11]),(Subscript[q, 12])},{(Subscript[q, 12]),(Subscript[q, 22])}}]];

s1=Solve[0==D[𝒮,{{(Subscript[q, 11]),(Subscript[q, 22]),(Subscript[q, 12])}}],{(Subscript[q, 11]),(Subscript[q, 22]),(Subscript[q, 12])}]

testparams0={(Subscript[σ, 1])->1,(Subscript[σ, 2])->1,(Subscript[ω, 1])->testω0[[1]],(Subscript[ω, 2])->testω0[[2]],ϵ->4/10};
testparams={(Subscript[σ, 1])->1,(Subscript[σ, 2])->1,(Subscript[ω, 1])->testω[[1]],(Subscript[ω, 2])->testω[[2]],ϵ->8/10};
testparams2={(Subscript[σ, 1])->1,(Subscript[σ, 2])->1,(Subscript[ω, 1])->testω2[[1]],(Subscript[ω, 2])->testω2[[2]],ϵ->12/10};

Plot[Evaluate[{Abs@Im[(Subscript[q, 11])+(Subscript[q, 22])]/.s1[[{2,4}]]/.testparams,Abs@Im[(Subscript[q, 11])+(Subscript[q, 22])]/.s1[[2]]/.ϵ->(10^(-10))/.testparams}],{λ,-0.0005,0.0005},WorkingPrecision->20,PlotPoints->200]

Plot[Evaluate[{Re[(Subscript[q, 11])+(Subscript[q, 22])]/.s1/.testparams}],{λ,-1,5},WorkingPrecision->20]

Plot[Evaluate[{Re[(Subscript[q, 11])],Re[(Subscript[q, 22])]}/.s1[[2]]/.testparams],{λ,-1,5},WorkingPrecision->20]

NIntegrate[Evaluate[(1/π)Abs@Im[(Subscript[q, 11])+(Subscript[q, 22])]/.s1[[{2}]]/.testparams],{λ,0,5.1}]

ρsemi[x_]:=Re[(1/(4π))(Sqrt[4-(((x))^2)])]

mplot2=Plot[Evaluate[{ρsemi[λ-2]+ρsemi[λ-28/10],(1/(2π))Abs@Im[(Subscript[q, 11])+(Subscript[q, 22])]/.s1[[{2}]]/.testparams0,(1/(2π))Abs@Im[(Subscript[q, 11])+(Subscript[q, 22])]/.s1[[{2}]]/.testparams,(1/(2π))Abs@Im[(Subscript[q, 11])+(Subscript[q, 22])]/.s1[[{2}]]/.testparams2}],{λ,-0.25,6},WorkingPrecision->20,Evaluate@labelStyle,ImageSize->165,FrameLabel->{λ,ρ[λ]},GridLines->{{0},{0}},GridLinesStyle->Black,PlotStyle->{ColorData[97][1],ColorData[97][3],ColorData[97][5],ColorData[97][7]},Exclusions->None,AspectRatio->1.0,PlotRange->{Automatic,{-0.025,0.39}},Epilog->Inset[Style["(b)",FontSize->fontSize,Black,Bold],Scaled[{0.15,0.9}]]]

Export["~/doc/research/frsb_kac-rice/papers/marginal/figs/msg_marg_params.pdf",mplot1];
Export["~/doc/research/frsb_kac-rice/papers/marginal/figs/msg_marg_spectra.pdf",mplot2];
Export["~/doc/research/frsb_kac-rice/papers/marginal/figs/msg_marg_legend.pdf",mlegend];

Two-sphere complexity

𝒮SSG[f_][e_,μ_][β_,r_,d_,g_]:=β e-(r+g)μ+(1/2)((β^2)f[1]+(2 β r-d)f'[1]+((r^2)-(g^2))f''[1])+(1/2)Log[Det[{{1,I r},{I r,d}}]]-(1/2)Log[(g^2)]

f34=Function[q,(1/2)((q^3)+(q^4))];

sSSG[f_][e_,ω_][β_,r_,d_,g_]=Solve[0==D[𝒮SSG[f][e,ω][β,r,d,g],{{β,r,d,g}}],{β,r,d,g}]//Simplify

sSSGpure[p_][e_,ω_][r_,d_,g_]=Solve[0==D[𝒮SSG[Function[q,(1/(p(p-1)))(q^p)]][e,ω][0,r,d,g],{{r,d,g}}],{r,d,g}]//Simplify

Plot[𝒮SSG[f][e,2(Sqrt[f''[1]])][β,r,d,g]/.stest/.f->f34,{e,-1.73,-1.6},PlotRange->{0,0.04}]

𝒮MSG[f1_,f2_][e_,ω1_,ω2_]:=𝒮SSG[f1][ee1,ω1][β,r1,d1,g1]+𝒮SSG[f2][ee2,ω2][β,r2,d2,g2]+ϵ(r12+r21+g12+g21)+β(e-ee1-ee2-ϵ c12)+(1/2)Log[Det[IdentityMatrix[2]-Inverse[{{1,I r1},{I r1,d1}}].{{c12,I r21},{I r12,d12}}.Inverse[{{1,I r2},{I r2,d2}}].Transpose[{{c12,I r21},{I r12,d12}}]]]-(1/2)Log[(((1-((g12 g21)/(g1 g2))))^2)]

testf=Simplify[𝒮MSG[Function[q,(1/(p(p-1)))(q^p)],Function[q,(1/(s(s-1)))(q^s)]][0,ω1,ω2]/.β->0]

testf0=Simplify[testf/.{ϵ->0,c12->0,r12->0,r21->0,d12->0,g12->0,g21->0}/.sSSGpure[p][e,ω1][r1,d1,g1][[2]]/.sSSGpure[s][e,ω2][r2,d2,g2][[2]]]

Plot[testf0/.{p->3,s->3,ω2->2},{ω1,2,2.1}]

solMSG=Solve[0==D[testf,{{r1,d1,g1,r2,d2,g2,c12,r12,r21,d12,g12,g21}}],{r1,d1,g1,r2,d2,g2,c12,r12,r21,d12,g12,g21}];

Length[solMSG]

Length[e13[[3]]]

testf0/.{p->3,s->5,ω2->2,ω1->Tan[θ/2]}/.θ->0.

ParametricPlot[{{ArcTan[ω1,ω2]-π/4,testf0}/.{p->3,s->5,ω2->2},{ArcTan[ω2,ω1]-π/4,Evaluate[testf0/.{ω1->ω2,ω2->ω1}]}/.{p->3,s->5,ω2->2}},{ω1,2,3},PlotRange->{Automatic,{0,Automatic}}]

ListPlot[(i|->Join[{ArcTan[ω1,ω2]-π/4,testf}/.solMSG[[i]]/.{p->3,s->5}/.e13[[1,;;;;100]],{ArcTan[ω1,ω2]-π/4,testf}/.solMSG[[i]]/.{p->3,s->5}/.(Reverse@e13[[1,;;;;100]]/.{ω1->ω2,ω2->ω1})])/@Range[Length[solMSG]],Joined->True]

ColorData[97]/@Range[15]

Length[e13]

pMSGcList=ListPlot[Prepend[(dat|->Join[{ω1-ω2,Re@testf}/.solMSG[[8]]/.{p->3,s->4}/.Most[dat],{ω1-ω2,Re@testf}/.solMSG[[8]]/.{p->3,s->4}/.(Reverse@Most[dat]/.{ω1->ω2,ω2->ω1})])/@Rest[e13],Join[{ω1-ω2,Re@testf}/.solMSG[[3]]/.{p->3,s->4}/.Most[e13[[1]]],{ω1-ω2,Re@testf}/.solMSG[[3]]/.{p->3,s->4}/.(Reverse@Most[e13[[1]]]/.{ω1->ω2,ω2->ω1})]],Joined->True,PlotStyle->ColorData[97]/@Range[2,8],PlotRange->{Automatic,{0,All}}]

pMSGc=Show[
pMSGcList,
ParametricPlot[{{ω1-ω2,testf0}/.{p->3,s->4,ω2->2}},{ω1,2,3},PlotStyle->ColorData[97][1]],
ParametricPlot[{{ω1-ω2,testf0}/.{p->3,s->4,ω1->2}},{ω2,2,3},PlotStyle->ColorData[97][1]],
PlotRange->{{-0.2,0.32},{0,0.08}},FrameLabel->{"(Subscript[ω, 1]) - (Subscript[ω, 2])",Σ},RotateLabel->False,ImageSize->340,AspectRatio->1/2,Epilog->Inset[Style["(c)",FontSize->fontSize,Black,Bold],Scaled[{0.07,0.9}]]
]

Export["~/doc/research/frsb_kac-rice/papers/marginal/figs/msg_marg_complexity.pdf",pMSGc]

e13[[3,5]]

pMSGcListE=ListPlot[Prepend[(dat|->Join[Re@{-((ω1)/p)-((ω2)/s)+((1/p)+(1/s))ϵ c12,testf}/.solMSG[[8]]/.{p->3,s->4}/.Most[dat],Re@{-((ω1)/p)-((ω2)/s)+((1/p)+(1/s))ϵ c12,testf}/.solMSG[[8]]/.{p->3,s->4}/.(Reverse@Most[dat]/.{ω1->ω2,ω2->ω1})])/@Most[Rest[e13]],Join[{-((ω1)/p)-((ω2)/s)+((1/p)+(1/s))ϵ c12,testf}/.solMSG[[3]]/.{p->3,s->4}/.Most[e13[[1]]],{-((ω1)/p)-((ω2)/s)+((1/p)+(1/s))ϵ c12,testf}/.solMSG[[3]]/.{p->3,s->4}/.(Reverse@Most[e13[[1]]]/.{ω1->ω2,ω2->ω1})]],Joined->True,PlotStyle->ColorData[97]/@Range[2,8],PlotRange->{Automatic,{0,All}},AspectRatio->1]

pMSGcE=Show[
pMSGcListE,
ParametricPlot[{{-((ω1)/p)-((ω2)/s),testf0}/.{p->3,s->4,ω2->2}},{ω1,2,3},PlotStyle->ColorData[97][1]],
ParametricPlot[{{-((ω1)/p)-((ω2)/s),testf0}/.{p->3,s->4,ω1->2}},{ω2,2,3},PlotStyle->ColorData[97][1]],
PlotRange->{{-1.23,-0.95},{0,0.065}},AspectRatio->1,FrameLabel->{"(Subscript[E, 1])+(Subscript[E, 2])",Σ},RotateLabel->False
]

Least squares

𝒮LS=(OverHat[β])e-μ(r+g)-(1/2)μ (OverHat[λ])+(OverHat[λ])λ+(1/2)Log[((d+(r^2))/(g^2))(((y0^2)-Δz)/(y0^2))]-(α/2)Log[((1-(2y0+(OverHat[λ]))f'[1]+((y0^2)-Δz)((f'[1])^2))/(((1-y0 f'[1]))^2))]-(α/2)Log[(((f'[1]d-(OverHat[β])-f''[1]((r^2)-(g^2)+2y0 (OverHat[λ])+Δz+(1/2)((OverHat[λ])^2)))f[1]+(((1-r f'[1]))^2))/(((1+g f'[1]))^2))]