Singlet scalar extension of the SM

See e.g. [2003.05936] for the one-loop matching results obtained using diagrammatic methods.

Load Matchete

<<Matchete`

Definition of the model

Loading the SM definitions

The Higgs potential parameters are relabeled to mH and λH.

LSM=LoadModel["SM",ModelParameters->{"μ"->mH,"λ"->λh}];
LSM//NiceForm

New field and couplings

Define new field

DefineField[ϕ,Scalar,SelfConjugate->True,Mass->{Heavy,M}]

Define new couplings

DefineCoupling[A,SelfConjugate->True]
DefineCoupling[κ,SelfConjugate->True]
DefineCoupling[μ,SelfConjugate->True]
DefineCoupling[λϕ,SelfConjugate->True]

Lagrangian

Write interactions

Lint=(-A[]Bar@H[i]H[i]ϕ[]-(1/2)κ[]Bar@H[i]H[i]ϕ[]ϕ[]-(1/(3!))μ[]((ϕ[])^3)-(1/(4!))λϕ[]((ϕ[])^4))//RelabelIndices;
Lint//NiceForm

Define Lagrangian extension

Lext=FreeLag[ϕ]+Lint;

Define full UV Lagrangian

LUV=LSM+Lext;
LUV//NiceForm
CheckLagrangian@LUV

Matching to the effective Lagrangian

Tree-level

Matching

LEFT0=Match[LUV,LoopOrder->0,EFTOrder->6];
LEFT0-LSM//HcSimplify//NiceForm

Removing redundant operators off-shell

Apply IBP and other identities to reduce the output to a Green’s basis.

LEFT0OffShell=LEFT0//GreensSimplify;
LEFT0OffShell-LSM //CollectOperators//HcSimplify//NiceForm

Removing redundant operators on-shell

Simplify to the physical basis using field redefinitions.

LEFT0OnShell=LEFT0//EOMSimplify;
LEFT0OnShell -LSM //CollectOperators//HcSimplify//NiceForm

One-loop

Matching

LEFT=EchoTiming@Match[LUV,LoopOrder->1,EFTOrder->6]/.(ϵ^(-1))->0;
LEFT-LSM//CollectOperators//HcSimplify//NiceForm

Removing redundant operators off-shell

Apply IBP and other identities to reduce the output to a Green’s basis.

LEFTOffShell=LEFT//GreensSimplify;
LEFTOffShell-LSM//CollectOperators//HcSimplify//NiceForm

Removing redundant operators on-shell

Simplify to the physical basis using field redefinitions.

LEFTOnShell=EchoTiming@EOMSimplify[LEFT];
LEFTOnShell-LSM //CollectOperators//HcSimplify//NiceForm

Print the effective coupling that was introduced

PrintEffectiveCouplings[LEFTOnShell]

Extraction of specific operators

(Subscript[C, elle])

SelectOperatorClass[LEFTOnShell,{Bar[l],e,Bar[e],l},0]//NiceForm

(Subscript[C, HW])

SelectOperatorClass[LEFTOnShell,{Bar[H],H,W,W},0]//NiceForm

Extracting the Warsaw basis Wilson coefficients & cross-checks
[advanced section]

In this section we demonstrate how to map our results to the Warsaw basis and compare our results to [2003.05936]. 
We find full agreement with [2003.05936] for the finite terms in the matching conditions, but disagree with the log-terms. 
The log-terms have been partially checked against [2011.02484] (which uses a non-minimal basis) for which we find full agreement.

Going to the Warsaw basis (extracting )

Replacement rule to change to the Warsaw basis with the  operator

GetHBox=Evaluate[Bar@H[i_]H[i_]CD[ν,Bar@H[j_]]CD[ν,H[j_]]/.ν->ν_]:>Evaluate[(1/2)(Op["HBox"]-Bar@H[i]H[i](CD[{ν,ν},Bar@H[j]]H[j]+Bar@H[j]CD[{ν,ν},H[j]]))];

Extract

$CHBox=Coefficient[LEFTOnShell/.GetHBox,Op["HBox"]]/.(ϵ^(-1))->0;
%//NiceForm

Obtain remaining Lagrangian (only keep finite contributions)

LFreeOfHBox=GreensSimplify@
ReplaceEffectiveCouplings@EOMSimplify[
LEFTOnShell-$CHBox*Bar@H[k]H[k]CD[{ν,ν},Bar@H[n]H[n]]]/.(ϵ^(-1))->0;

Cross check that all contributions from  have been eliminated

SelectOperatorClass[LFreeOfHBox,{Bar@H,H,Bar@H,H},2]//NiceForm

The above corresponds to the  coefficient.

Conventions of [2003.05936]

For the cross check the Higgs quartic coupling  is shifted by λh=λ+((A^2)/(M^2))

DefineCoupling[λ,SelfConjugate->True]

LCrossCheck=GreensSimplify[SeriesEFT[LFreeOfHBox/.λh[]->(λ[]+(((A[])^2)/((M[])^2))),EFTOrder->6]]/.(ϵ^(-1))->0;

Warsaw basis Wilson coefficients and comparison to [2003.05936]

Perform the shift of λ also for

CHBox=Collect[$CHBox/.λh[]->(λ[]+(((A[])^2)/((M[])^2))),{hbar,_Log},FullSimplify];
%//NiceForm

Cross-check with [2003.05936]

CHBoxLiterature=-(((A[])^2)/(2((M[])^4)))+hbar*(-(((κ[])^2)/(24 ((M[])^2)))+((25((A[])^2)κ[]-6((A[])^2)λϕ[]-5A[]κ[]μ[])/(12((M[])^4)))+((38((A[])^4)-26((A[])^3)μ[]+11((A[])^2)((μ[])^2))/(24((M[])^6)))-((31((A[])^2)(((gY[])^2)+3((gL[])^2)))/(72((M[])^4))));

(CHBoxLiterature-(CHBox/._Log->0))//Simplify//NiceForm

SelectOperatorClass[LCrossCheck,{Bar@H,H,Bar@H,H,Bar@H,H},0]//NiceForm
CH=%/._Field->1;

CHLiterature=((((A[])^3)μ[])/(6((M[])^6)))-((((A[])^2)κ[])/(2((M[])^4)))+hbar*(-(((κ[])^3)/(12((M[])^2)))-((6((A[])^2)κ[]λϕ[]+162((A[])^2)κ[]λ[]-66((A[])^2)((κ[])^2)-164((A[])^2)((λ[])^2)+3A[]((κ[])^2)μ[])/(12((M[])^4)))+(1/(12((M[])^6)))(87((A[])^4)κ[]-6((A[])^4)λϕ[]-72((A[])^4)λ[]-60((A[])^3)κ[]μ[]+4((A[])^3)μ[]λϕ[]+78((A[])^3)λ[]μ[]+6((A[])^2)κ[]((μ[])^2))-((8((A[])^6)+21((A[])^5)μ[]-12((A[])^4)((μ[])^2)+2((A[])^3)((μ[])^3))/(12((M[])^8)))-((31((A[])^2)λ[]((gL[])^2))/(18((M[])^4))));

(CHLiterature-(CH/._Log->0))//FullSimplify//NiceForm

SelectOperatorClass[LCrossCheck,{Bar@H,H,Bar@H,H},2]//NiceForm
CHD=%/._Field->1;

CHDLiterature=-hbar*((31((A[])^2)((gY[])^2))/(18((M[])^4)));

(CHDLiterature-(CHD/._Log->0))//Simplify//NiceForm

SelectOperatorClass[LCrossCheck,{Bar@H,H},4]//NiceForm
CHB=%/.{_Field->1,FieldStrength[B,___]->1,FieldStrength[Except[B],___]->0};
CHW=%%/.{_Field->1,FieldStrength[W,___]->1,FieldStrength[Except[W],___]->0};
CHWB=(%%%/.{_Field->1,_FieldStrength->1,_CG->(1/2)})-CHB-CHW; (* generator -> (1/2) Pauli matrix *)

CHBLiterature=hbar*((((A[])^2)((gY[])^2))/(12((M[])^4)));
CHWLiterature=hbar*((((A[])^2)((gL[])^2))/(12((M[])^4)));
CHWBLiterature=hbar*((((A[])^2)gY[]gL[])/(6((M[])^4)));

(CHBLiterature-(CHB/._Log->0))//Simplify//NiceForm
(CHWLiterature-(CHW/._Log->0))//Simplify//NiceForm
(CHWBLiterature-(CHWB/._Log->0))//Simplify//NiceForm

QuH=SelectOperatorClass[LCrossCheck,{Bar@H,H,Bar@H,Bar@q,u},0];
%//NiceForm

QuHLiterature=PlusHc[-hbar*(((A[])^2)/(36((M[])^4)))(Yu[p,t](27κ[]-87λ []-((9A[]μ[])/((M[])^2))+31((gL[])^2))-45Yu[p,r]Bar@Yu[s,r]Yu[s,t])Bar@H[i]H[i]Bar@H[k]Bar@q[a,j,p]**u[a,t]*CG[eps[SU2L],{Index[j,SU2L[fund]],Index[k,SU2L[fund]]}] ];

(QuHLiterature-(QuH/._Log->0))//GreensSimplify//NiceForm

QdH=SelectOperatorClass[LCrossCheck,{Bar@H,H,H,Bar@q,d},0];
%//NiceForm

QdHLiterature=PlusHc[-hbar*(((A[])^2)/(36((M[])^4)))(Yd[p,t](27κ[]-87λ []-((9A[]μ[])/((M[])^2))+31((gL[])^2))-45Yd[p,r]Bar@Yd[s,r]Yd[s,t])Bar@H[i]H[i]H[k]Bar@q[a,k,p]**d[a,t]];

(QdHLiterature-(QdH/._Log->0))//GreensSimplify//NiceForm

QeH=SelectOperatorClass[LCrossCheck,{Bar@H,H,H,Bar@l,e},0];
%//NiceForm

QeHLiterature=PlusHc[-hbar*(((A[])^2)/(36((M[])^4)))(Ye[p,t](27κ[]-87λ []-((9A[]μ[])/((M[])^2))+31((gL[])^2))-45Ye[p,r]Bar@Ye[s,r]Ye[s,t])Bar@H[i]H[i]H[k]Bar@l[k,p]**e[t]];

(QeHLiterature-(QeH/._Log->0))//GreensSimplify//NiceForm

QHu=SelectOperatorClass[LCrossCheck,{Bar@H,H,Bar@u,u},1]//GreensSimplify;
%//NiceForm

QHuLiterature=-hbar*(((A[])^2)/(216((M[])^4)))(34((gY[])^2)Delta[Index[p,Flavor],Index[r,Flavor]]-135Bar@Yu[s,p]Yu[s,r])(Bar@H[i]I CD[ν,H[i]]-Bar@CD[ν,H[i]]I H[i])Bar@u[a,p]**γ[ν]**u[a,r];

(QHuLiterature-(QHu/._Log->0))//GreensSimplify//NiceForm

QHd=SelectOperatorClass[LCrossCheck,{Bar@H,H,Bar@d,d},1]//GreensSimplify;
%//NiceForm

QHdLiterature=hbar*(((A[])^2)/(216((M[])^4)))(17((gY[])^2)Delta[Index[p,Flavor],Index[r,Flavor]]-135Bar@Yd[s,p]Yd[s,r])(Bar@H[i]I CD[ν,H[i]]-Bar@CD[ν,H[i]]I H[i])Bar@d[a,p]**γ[ν]**d[a,r];

(QHdLiterature-(QHd/._Log->0))//GreensSimplify//NiceForm

QHud=SelectOperatorClass[LFreeOfHBox,{H,H,Bar@u,d},1];
%//NiceForm

QHudLiterature=PlusHc[-hbar*((5((A[])^2))/(4((M[])^4)))Bar@Yu[s,p]Yd[s,r]Bar@CG[eps[SU2L],{Index[i,SU2L[fund]],Index[j,SU2L[fund]]}]H[j]I CD[ν,H[i]]Bar@u[a,p]**γ[ν]**d[a,r]];

(QHudLiterature-(QHud/._Log->0))//GreensSimplify//NiceForm

QHe=SelectOperatorClass[LCrossCheck,{Bar@H,H,Bar@e,e},1]//GreensSimplify;
%//NiceForm

QHeLiterature=hbar*(((A[])^2)/(72((M[])^4)))(17((gY[])^2)Delta[Index[p,Flavor],Index[r,Flavor]]-45Bar@Ye[s,p]Ye[s,r])(Bar@H[i]I CD[ν,H[i]]-Bar@CD[ν,H[i]]I H[i])Bar@e[p]**γ[ν]**e[r];

(QHeLiterature-(QHe/._Log->0))//GreensSimplify//NiceForm

auxCHq13=SelectOperatorClass[LCrossCheck,{Bar@H,H,Bar@q,q},1]//GreensSimplify;
%//NiceForm

SU(2) Fierz identity

FierzQHq={
(-Bar[Field[H,Scalar,{Index[i_,SU2L[fund]]},{Index[μ_,Lorentz]}]] Field[H,Scalar,{Index[i_,SU2L[fund]]},{}] Bar[Field[q,Fermion,{Index[a_,SU3c[fund]],Index[j_,SU2L[fund]],Index[r_,Flavor]},{}]]**DiracProduct[GammaM[Index[μ_,Lorentz]],Proj[-1]]**Field[q,Fermion,{Index[a_,SU3c[fund]],Index[j_,SU2L[fund]],Index[p_,Flavor]},{}]+Bar[Field[H,Scalar,{Index[i_,SU2L[fund]]},{}]] Field[H,Scalar,{Index[i_,SU2L[fund]]},{Index[μ_,Lorentz]}] Bar[Field[q,Fermion,{Index[a_,SU3c[fund]],Index[j_,SU2L[fund]],Index[r_,Flavor]},{}]]**DiracProduct[GammaM[Index[μ_,Lorentz]],Proj[-1]]**Field[q,Fermion,{Index[a_,SU3c[fund]],Index[j_,SU2L[fund]],Index[p_,Flavor]},{}]):>-I* (Bar@H[i]I CD[μ,H[i]]-CD[μ,Bar@H[i]]I H[i])Bar@q[a,j,r]**γ[μ]**q[a,j,p]
,
(-Bar[Field[H,Scalar,{Index[i_,SU2L[fund]]},{Index[μ_,Lorentz]}]] Field[H,Scalar,{Index[j_,SU2L[fund]]},{}] Bar[Field[q,Fermion,{Index[a_,SU3c[fund]],Index[j_,SU2L[fund]],Index[r_,Flavor]},{}]]**DiracProduct[GammaM[Index[μ_,Lorentz]],Proj[-1]]**Field[q,Fermion,{Index[a_,SU3c[fund]],Index[i_,SU2L[fund]],Index[p_,Flavor]},{}]+Bar[Field[H,Scalar,{Index[i_,SU2L[fund]]},{}]] Field[H,Scalar,{Index[j_,SU2L[fund]]},{Index[μ_,Lorentz]}] Bar[Field[q,Fermion,{Index[a_,SU3c[fund]],Index[j_,SU2L[fund]],Index[r_,Flavor]},{}]]**DiracProduct[GammaM[Index[μ_,Lorentz]],Proj[-1]]**Field[q,Fermion,{Index[a_,SU3c[fund]],Index[i_,SU2L[fund]],Index[p_,Flavor]},{}]):>-I(1/2)((Bar@H[i]I CD[μ,H[i]]-CD[μ,Bar@H[i]]I H[i])Bar@q[a,j,r]**γ[μ]**q[a,j,p]+2*CG[gen@SU2L[fund],{J,i,n}](Bar@H[i]I CD[μ,H[n]]-CD[μ,Bar@H[i]]I H[n])2*CG[gen@SU2L[fund],{J,j,k}]Bar@q[a,j,r]**γ[μ]**q[a,k,p])
};
%//NiceForm

$auxCHq13=(auxCHq13/.FierzQHq)//GreensSimplify;

CHq13Literature=-hbar*(((A[])^2)/(432((M[])^4)))(17((gY[])^2)Delta[Index[p,Flavor],Index[r,Flavor]]+135(Yu[p,s]Bar@Yu[r,s]-Yd[p,s]Bar@Yd[r,s]))*(Bar@H[i]I CD[μ,H[i]]-CD[μ,Bar@H[i]]I H[i])Bar@q[a,j,p]**γ[μ]**q[a,j,r]-hbar*(((A[])^2)/(144((M[])^4)))(17((gL[])^2)Delta[Index[p,Flavor],Index[r,Flavor]]-45(Yu[p,s]Bar@Yu[r,s]+Yd[p,s]Bar@Yd[r,s]))*2*CG[gen@SU2L[fund],{J,i,n}](Bar@H[i]I CD[μ,H[n]]-CD[μ,Bar@H[i]]I H[n])2*CG[gen@SU2L[fund],{J,j,k}]Bar@q[a,j,p]**γ[μ]**q[a,k,r]//GreensSimplify;

RelabelIndices[CHq13Literature-($auxCHq13/._Log->0)]//GreensSimplify//NiceForm

auxCHl13=SelectOperatorClass[LCrossCheck,{Bar@H,H,Bar@l,l},1]//GreensSimplify;
%//NiceForm

FierzQHl={
(-Bar[Field[H,Scalar,{Index[i_,SU2L[fund]]},{Index[μ_,Lorentz]}]] Field[H,Scalar,{Index[i_,SU2L[fund]]},{}] Bar[Field[l,Fermion,{I,Index[j_,SU2L[fund]],Index[r_,Flavor]},{}]]**DiracProduct[GammaM[Index[μ_,Lorentz]],Proj[-1]]**Field[l,Fermion,{Index[j_,SU2L[fund]],Index[p_,Flavor]},{}]+Bar[Field[H,Scalar,{Index[i_,SU2L[fund]]},{}]] Field[H,Scalar,{Index[i_,SU2L[fund]]},{Index[μ_,Lorentz]}] Bar[Field[l,Fermion,{Index[j_,SU2L[fund]],Index[r_,Flavor]},{}]]**DiracProduct[GammaM[Index[μ_,Lorentz]],Proj[-1]]**Field[l,Fermion,{Index[j_,SU2L[fund]],Index[p_,Flavor]},{}]):>-I* (Bar@H[i]I CD[μ,H[i]]-CD[μ,Bar@H[i]]I H[i])Bar@l[j,r]**γ[μ]**l[j,p]
,
(-Bar[Field[H,Scalar,{Index[i_,SU2L[fund]]},{Index[μ_,Lorentz]}]] Field[H,Scalar,{Index[j_,SU2L[fund]]},{}] Bar[Field[l,Fermion,{Index[j_,SU2L[fund]],Index[r_,Flavor]},{}]]**DiracProduct[GammaM[Index[μ_,Lorentz]],Proj[-1]]**Field[l,Fermion,{Index[i_,SU2L[fund]],Index[p_,Flavor]},{}]+Bar[Field[H,Scalar,{Index[i_,SU2L[fund]]},{}]] Field[H,Scalar,{Index[j_,SU2L[fund]]},{Index[μ_,Lorentz]}] Bar[Field[l,Fermion,{Index[j_,SU2L[fund]],Index[r_,Flavor]},{}]]**DiracProduct[GammaM[Index[μ_,Lorentz]],Proj[-1]]**Field[l,Fermion,{Index[i_,SU2L[fund]],Index[p_,Flavor]},{}]):>-I(1/2)((Bar@H[i]I CD[μ,H[i]]-CD[μ,Bar@H[i]]I H[i])Bar@l[j,r]**γ[μ]**l[j,p]+2*CG[gen@SU2L[fund],{J,i,n}](Bar@H[i]I CD[μ,H[n]]-CD[μ,Bar@H[i]]I H[n])2*CG[gen@SU2L[fund],{J,j,k}]Bar@l[j,r]**γ[μ]**l[k,p])
};
%//NiceForm

CHl13Literature=hbar*(((A[])^2)/(144((M[])^4)))(17((gY[])^2)Delta[Index[p,Flavor],Index[r,Flavor]]+45Ye[p,s]Bar@Ye[r,s])*(Bar@H[i]I CD[μ,H[i]]-CD[μ,Bar@H[i]]I H[i])Bar@l[j,p]**γ[μ]**l[j,r]-hbar*(((A[])^2)/(144((M[])^4)))(17((gL[])^2)Delta[Index[p,Flavor],Index[r,Flavor]]-45Ye[p,s]Bar@Ye[r,s])*2*CG[gen@SU2L[fund],{J,i,n}](Bar@H[i]I CD[μ,H[n]]-CD[μ,Bar@H[i]]I H[n])2*CG[gen@SU2L[fund],{J,j,k}]Bar@l[j,p]**γ[μ]**l[k,r]//GreensSimplify;

(((auxCHl13/.FierzQHl)//GreensSimplify)-(CHl13Literature//GreensSimplify))/._Log->0//GreensSimplify//NiceForm

leptons

SelectOperatorClass[LCrossCheck,{Bar@e,e,Bar@l,l},0]//NiceForm

up-quarks

SelectOperatorClass[LCrossCheck,{Bar@u,u,Bar@q,q},0]//NiceForm

down-quarks

SelectOperatorClass[LCrossCheck,{Bar@d,d,Bar@q,q},0]//NiceForm

Comparison

Q2y=(SelectOperatorClass[LCrossCheck,{Bar@q,u,Bar@u,q},0]+SelectOperatorClass[LCrossCheck,{Bar@q,d,Bar@d,q},0]+SelectOperatorClass[LCrossCheck,{Bar@l,e,Bar@e,l},0]+SelectOperatorClass[LCrossCheck,{Bar@q,u,Bar@q,d},0]+SelectOperatorClass[LCrossCheck,{Bar@q,u,Bar@l,e},0]+SelectOperatorClass[LCrossCheck,{Bar@q,d,Bar@e,l},0])//GreensSimplify;
%//NiceForm

C2yLiterature=hbar*(((A[])^2)/(6((M[])^4)))(
Yu[p,r]Bar@q[a,j,p]**u[a,r]*CG[eps@SU2L,{j,i}]
+Bar@Yd[r,p]Bar@d[a,p]**q[a,i,r]
+Bar@Ye[r,p]Bar@e[p]**l[i,r])*
Bar[Yu[s,t]Bar@q[b,k,s]**u[b,t]*CG[eps@SU2L,{k,i}]
+Bar@Yd[t,s]Bar@d[b,s]**q[b,i,t]
+Bar@Ye[t,s]Bar@e[s]**l[i,t]
];

(Q2y-C2yLiterature)//GreensSimplify//NiceForm