(* ::Package:: *)

(* ::Input:: *)
(*(*SELF-ENERGY AND BETA FUNCTIONS*)*)
(**)


(* ::Input::Closed:: *)
(*(*INITIAL SETTINGS*)*)


(* ::Input:: *)
(*SetAttributes[\[Eta],Orderless]*)
(*SetAttributes[f1, Orderless]*)
(*SetAttributes[f2, Orderless]*)
(*SetAttributes[f3, Orderless]*)
(*SetAttributes[f4, Orderless]*)
(*Unprotect[Power,Plus,Times];*)
(*\[Eta][\[Mu]_,\[Nu]_]\[Eta][\[Nu]_,\[Rho]_]:=\[Eta][\[Mu],\[Rho]]*)
(*\[Eta][\[Mu]_,\[Mu]_]:=4*)
(*\[Eta][\[Mu]_,\[Nu]_]^2:=4*)
(*\[Eta][\[Mu]_,\[Nu]_]p[\[Nu]_]:=p[\[Mu]]*)
(*\[Eta][\[Mu]_,\[Nu]_]k[\[Nu]_]:=k[\[Mu]]*)
(*\[Eta][\[Mu]_,\[Nu]_]q[\[Nu]_]:=q[\[Mu]]*)
(*\[Eta][\[Mu]_,\[Nu]_]l[\[Nu]_]:=l[\[Mu]]*)
(*p[\[Mu]_]^2:=p2*)
(*k[\[Mu]_]^2:=k2*)
(*q[\[Mu]_]^2:=q2*)
(*l[\[Mu]_]^2:=l2*)
(*p[m_] q[m_]:=pq*)
(*p[m_] k[m_]:=pk*)
(*q[m_] k[m_]:=qk*)
(*l[m_]p[m_]:=lp*)
(*l[m_]q[m_]:=lq*)
(*l[m_]k[m_]:=lk*)
(*(2p_)[m_]:=2(p[m])*)
(*(-2p_)[m_]:=-2(p[m])*)
(*(p_+q_)[m_]:= p[m]+ q[m]*)
(*(-p_)[m_]:=-(p[m])*)
(*\[CapitalLambda]^2:=0*)
(*\[CapitalLambda]^3:=0*)
(*\[CapitalLambda] Cc:=0*)
(*\[CapitalLambda] Cc^2:=0*)
(*\[CapitalLambda] Cc^3:=0*)
(*\[CapitalLambda] p[m_]:=0*)
(*\[CapitalLambda] pk:=0*)
(*\[CapitalLambda] p2:=0*)
(*\[CapitalLambda] p2^2:=0*)
(*\[CapitalLambda] p2^3:=0*)
(*\[CapitalLambda] p2^4:=0*)
(*\[CapitalLambda] p2^5:=0*)
(*\[CapitalLambda] p2^6:=0*)
(*\[CapitalLambda] pk^2:=0*)
(*\[CapitalLambda] pk^3:=0*)
(*\[CapitalLambda] pk^4:=0*)
(*\[CapitalLambda] pk^5:=0*)
(*\[CapitalLambda] pk^6:=0*)
(*Cc^2 p2:=0*)
(*Cc^2 p[m_]:=0*)
(*Cc^2 p2^2:=0*)
(*Cc^2 p2^3:=0*)
(*Cc^3:=0*)
(*Cc^4:=0*)


(* ::Input::Closed:: *)
(*(*SUBSTITUTION RULES FOR SYMMETRIC INTEGRATION*)*)


(* ::Input::Closed:: *)
(*	(*Function used to construct the rules*)*)


(* ::Input:: *)
(*F[m_]:=2/\[Pi] ((1+(-1)^m) Sqrt[\[Pi]] Gamma[(1+m)/2])/(4 Gamma[2+m/2])*)


(* ::Input::Closed:: *)
(*	(*Functions used for the rules up to the 4 tensor case, p external, q integrated, m integer  *)*)


(* ::Input:: *)
(**)
(*F0[m_,p2_,q2_]:=p2^(m/2)q2^(m/2)F[m]*)
(*F1[m_,r_,p_,p2_,q2_]:=p2^((m+1)/2-1)q2^((m+1)/2)F[m+1]p[r]*)
(*F2[m_,r_,s_,p_,p2_,q2_]:=Expand[p2^((m+2)/2-2)q2^((m+2)/2) F[m+2]/(m+1) (p2 \[Eta][r,s]+m p[r]p[s])]*)
(*F3[m_,r_,s_,t_,p_,p2_,q2_]:=Expand[p2^((m+3)/2-3)q2^((m+3)/2) F[m+3]/(m+2) (p2 (p[t] \[Eta][r,s]+p[r] \[Eta][t,s]+p[s] \[Eta][r,t])+(m-1)p[r]p[s]p[t])]*)
(*F4[m_,r_,s_,t_,u_,p_,p2_,q2_]:=Expand[-(((1+(-1)^m) p2^(-2+m/2) q2^(2+m/2) (3 p[r] (-p2 ((1+2 m) Gamma[4+m/2] Gamma[(3+m)/2]-2 (1+m) Gamma[3+m/2] Gamma[(5+m)/2]) (p[u] \[Eta][s,t]+p[t] \[Eta][s,u])+p[s] (((8+11 m) Gamma[4+m/2] Gamma[(3+m)/2]-16 (1+m) Gamma[3+m/2] Gamma[(5+m)/2]) p[t] p[u]+p2 (-(1+2 m) Gamma[4+m/2] Gamma[(3+m)/2]+2 (1+m) Gamma[3+m/2] Gamma[(5+m)/2]) \[Eta][t,u]))+p2 (-3 ((1+2 m) Gamma[4+m/2] Gamma[(3+m)/2]-2 (1+m) Gamma[3+m/2] Gamma[(5+m)/2]) p[s] p[u] \[Eta][r,t]-3 ((1+2 m) Gamma[4+m/2] Gamma[(3+m)/2]-2 (1+m) Gamma[3+m/2] Gamma[(5+m)/2]) p[t] (p[u] \[Eta][r,s]+p[s] \[Eta][r,u])+p2 ((-2+m) Gamma[4+m/2] Gamma[(3+m)/2]-(1+m) Gamma[3+m/2] Gamma[(5+m)/2]) (\[Eta][r,u] \[Eta][s,t]+\[Eta][r,t] \[Eta][s,u]+\[Eta][r,s] \[Eta][t,u]))))/(30 (1+m) Sqrt[\[Pi]] Gamma[3+m/2] Gamma[4+m/2]))]*)


(* ::Input::Closed:: *)
(*	(*Rules up to 14 integrated q, p external*)*)


(* ::Input:: *)
(**)
(*rp1410=q[m_]q[n_]q[r_]q[s_]pq^10:>F4[10,m,n,r,s,p,p2,q2];*)
(*rp1411=q[m_]q[n_]q[r_]pq^11:>F3[11,m,n,r,p,p2,q2];*)
(*rp1412=q[m_]q[n_]pq^12:>F2[12,m,n,p,p2,q2];*)
(*rp1413=q[m_]pq^13:>F1[13,m,p,p2,q2];*)
(*rp1414=pq^14:>F0[14,p2,q2];*)
(*rp128=q[m_]q[n_]q[r_]q[s_]pq^8:>F4[8,m,n,r,s,p,p2,q2];*)
(*rp129=q[m_]q[n_]q[r_]pq^9:>F3[9,m,n,r,p,p2,q2];*)
(*rp1210=q[m_]q[n_]pq^10:>F2[10,m,n,p,p2,q2];*)
(*rp1211=q[m_]pq^11:>F1[11,m,p,p2,q2];*)
(*rp1212=pq^12:>F0[12,p2,q2];*)
(*rp106=q[m_]q[n_]q[r_]q[s_]pq^6:>F4[6,m,n,r,s,p,p2,q2];*)
(*rp107=q[m_]q[n_]q[r_]pq^7:>F3[7,m,n,r,p,p2,q2];*)
(*rp108=q[m_]q[n_]pq^8:>F2[8,m,n,p,p2,q2];*)
(*rp109=q[m_]pq^9:>F1[9,m,p,p2,q2];*)
(*rp1010=pq^10:>F0[10,p2,q2];*)
(*rp84=q[m_]q[n_]q[r_]q[s_]pq^4:>F4[4,m,n,r,s,p,p2,q2];*)
(*rp85=q[m_]q[n_]q[r_]pq^5:>F3[5,m,n,r,p,p2,q2];*)
(*rp86=q[m_]q[n_]pq^6:>F2[6,m,n,p,p2,q2];*)
(*rp87=q[m_]pq^7:>F1[7,m,p,p2,q2];*)
(*rp88=pq^8:>F0[8,p2,q2];*)
(*rp62=q[m_]q[n_]q[r_]q[s_]pq^2:>F4[2,m,n,r,s,p,p2,q2];*)
(*rp63=q[m_]q[n_]q[r_]pq^3:>F3[3,m,n,r,p,p2,q2];*)
(*rp64=q[m_]q[n_]pq^4:>F2[4,m,n,p,p2,q2];*)
(*rp65=q[m_]pq^5:>F1[5,m,p,p2,q2];*)
(*rp66=pq^6:>F0[6,p2,q2];*)
(*rp40=q[m_]q[n_]q[r_]q[s_]:>F4[0,m,n,r,s,p,p2,q2];*)
(*rp41=q[m_]q[n_]q[r_]pq:>F3[1,m,n,r,p,p2,q2];*)
(*rp42=q[m_]q[n_]pq^2:>F2[2,m,n,p,p2,q2];*)
(*rp43=q[m_]pq^3:>F1[3,m,p,p2,q2];*)
(*rp44=pq^4:>F0[4,p2,q2];*)
(*rp20=q[m_]q[n_]:>(q2/4)\[Eta][m,n];*)
(*rp21=q[m_]pq:>(q2/4)p[m];*)
(*rp22=pq^2:>q2 p2/4;*)


(* ::Input::Closed:: *)
(*(*EXPANSION OF CURVATURE TENSORS UP TO THE 4TH ORDER IN THE GRAVITON FIELD*)*)


(* ::Input:: *)
(**)
(*(*Metric expanded as g[m,n]=\[Eta][m,n]+f[m,n]*)*)
(**)
(*(*Inverse metric*)*)
(**)
(*ginv1[m_,n_,f1_]:=-f1[m,n]*)
(*ginv2[m_,n_,f1_,f2_,a_]:=f1[m,a]f2[a,n]*)
(*ginv3[m_,n_,f1_,f2_,f3_,a_,b_]:=-f1[m,a]f2[a,b]f3[b,n]*)
(**)
(*(*Connection*)*)
(**)
(*\[CapitalGamma]1[m_,n_,r_,f1_,p_]:=Expand[1/2 (I p[m]f1[n,r]+I p[n]f1[m,r]-I p[r]f1[m,n])]*)
(*\[CapitalGamma]2[m_,n_,r_,f1_,p_,f2_,a_]:=Expand[ginv1[r,a,f2]\[CapitalGamma]1[m,n,a,f1,p]]*)
(*\[CapitalGamma]3[m_,n_,r_,f1_,p_,f2_,f3_,a_,b_]:=Expand[ginv2[r,a,f2,f3,b]\[CapitalGamma]1[m,n,a,f1,p]]*)
(*\[CapitalGamma]4[m_,n_,r_,f1_,p_,f2_,f3_,f4_,a_,b_,c_]:=Expand[ginv3[r,a,f2,f3,f4,b,c]\[CapitalGamma]1[m,n,a,f1,p]]*)
(**)
(*(*Ricci tensor*)*)
(**)
(*Ric1[m_,n_,f1_,p_,a_]:=Expand[I p[a]\[CapitalGamma]1[m,n,a,f1,p]-I p[n]\[CapitalGamma]1[m,a,a,f1,p]]*)
(*Ric2[m_,n_,f1_,p_,f2_,k_,a_,b_]:=Expand[I (p[a]+k[a])\[CapitalGamma]2[m,n,a,f1,p,f2,b]-I (p[n]+k[n])\[CapitalGamma]2[m,a,a,f1,p,f2,b]+\[CapitalGamma]1[b,a,a,f1,p]\[CapitalGamma]1[m,n,b,f2,k]-\[CapitalGamma]1[b,n,a,f1,p]\[CapitalGamma]1[m,a,b,f2,k]]*)
(*Ric3[m_,n_,f1_,p_,f2_,k_,f3_,q_,a_,b_,c_]:=Expand[I (p[a]+k[a]+q[a])\[CapitalGamma]3[m,n,a,f1,p,f2,f3,b,c]-I (p[n]+k[n]+q[n])\[CapitalGamma]3[m,a,a,f1,p,f2,f3,b,c]+\[CapitalGamma]2[b,a,a,f1,p,f3,c]\[CapitalGamma]1[m,n,b,f2,k]+\[CapitalGamma]1[b,a,a,f1,p]\[CapitalGamma]2[m,n,b,f2,k,f3,c]-\[CapitalGamma]2[b,n,a,f1,p,f3,c]\[CapitalGamma]1[m,a,b,f2,k]-\[CapitalGamma]1[b,n,a,f1,p]\[CapitalGamma]2[m,a,b,f2,k,f3,c]]*)
(*Ric4[m_,n_,f1_,p_,f2_,k_,f3_,q_,f4_,l_,a_,b_,c_,d_]:=Expand[I (p[a]+k[a]+q[a]+l[a])\[CapitalGamma]4[m,n,a,f1,p,f2,f3,f4,b,c,d]-I (p[n]+k[n]+q[n]+l[n])\[CapitalGamma]4[m,a,a,f1,p,f2,f3,f4,b,c,d]+\[CapitalGamma]3[b,a,a,f1,p,f2,f3,c,d]\[CapitalGamma]1[m,n,b,f4,l]+\[CapitalGamma]2[b,a,a,f1,p,f2,c]\[CapitalGamma]2[m,n,b,f3,q,f4,d]+\[CapitalGamma]1[b,a,a,f1,p]\[CapitalGamma]3[m,n,b,f2,k,f3,f4,c,d]-\[CapitalGamma]3[b,n,a,f1,p,f2,f3,c,d]\[CapitalGamma]1[m,a,b,f4,l]-\[CapitalGamma]2[b,n,a,f1,p,f2,c]\[CapitalGamma]2[m,a,b,f3,q,f4,d]-\[CapitalGamma]1[b,n,a,f1,p]\[CapitalGamma]3[m,a,b,f2,k,f3,f4,c,d]]*)
(**)
(*(*Ricci scalar*)*)
(**)
(*R1[f1_,p_,a_,b_]:=Expand[Ric1[b,b,f1,p,a]]*)
(*R2[f1_,p_,f2_,k_,a_,b_,c_]:=Expand[Expand[Ric2[c,c,f1,p,f2,k,a,b]]+Expand[ginv1[a,b,f1]Ric1[a,b,f2,k,c]]]*)
(*R3[f1_,p_,f2_,k_,f3_,q_,a_,b_,c_,d_]:=Expand[Expand[Ric3[d,d,f1,p,f2,k,f3,q,a,b,c]]+Expand[ginv1[a,b,f3]Ric2[a,b,f1,p,f2,k,c,d]]+Expand[ginv2[a,b,f2,f3,c]Ric1[a,b,f1,p,d]]]*)
(*R4[f1_,p_,f2_,k_,f3_,q_,f4_,l_,a_,b_,c_,d_,e_]:=Expand[Expand[Ric4[a,a,f1,p,f2,k,f3,q,f4,l,b,c,d,e]]+Expand[ginv1[a,b,f4]Ric3[a,b,f1,p,f2,k,f3,q,c,d,e]]+Expand[ginv2[a,b,f1,f2,c]Ric2[a,b,f3,q,f4,l,d,e]]+Expand[ginv3[a,b,f1,f2,f3,c,d]Ric1[a,b,f4,l,e]]]*)
(**)
(*(*Square root of det g*)*)
(**)
(*sqrtg1[f1_,a_]:=1/2 f1[a,a]*)
(*sqrtg2[f1_,f2_,a_,b_]:=1/8 f1[a,a]f2[b,b]-1/4 f1[a,b]f2[b,a]*)
(*sqrtg3[f1_,f2_,f3_,a_,b_,c_]:=1/48 f1[a,a]f2[b,b]f3[c,c]-1/8 f1[a,a]f2[b,c]f3[b,c]+1/6 f1[a,b]f2[b,c]f3[c,a]*)
(*sqrtg4[f1_,f2_,f3_,f4_,a_,b_,c_,d_]:=(f1[a,a]f2[b,b]f3[c,c]f4[d,d])/384-(f1[a,a]f2[b,b] f3[c,d]f4[d,c])/32+(f1[a,b]f2[a,b]f3[c,d]f4[c,d])/32+(f1[a,a] f2[b,c]f3[c,d]f4[d,b])/12-(f1[a,b] f2[b,c]f3[c,d]f4[d,a])/8*)
(**)


(* ::Input::Closed:: *)
(*(*EUCLIDEAN VERTICES*)*)


(* ::Input::Closed:: *)
(*	(*Three graviton vertex, momenta and indices: f1\[Rule](p,\[Mu],\[Nu]), f2\[Rule](k,\[Rho],\[Sigma]), f3\[Rule](q,\[Alpha],\[Beta])*)*)


(* ::Input:: *)
(**)
(*VV3[\[Mu]_,\[Nu]_,p_,\[Rho]_,\[Sigma]_,k_,\[Alpha]_,\[Beta]_,q_,m_,n_,a_,b_,c_]:=Expand[( Aa (Expand[2 Ric2[m,n,f1,p,f2,k,a,b]Ric1[m,n,f3,q,c]]+Expand[sqrtg1[f1,a]Ric1[m,n,f2,k,b]Ric1[m,n,f3,q,c]]+2 Expand[Ric1[m,n,f1,p,a]Ric1[c,n,f2,k,b]ginv1[m,c,f3]])+1/2 (Bb-Aa) (Expand[2Ric2[m,m,f1,p,f2,k,a,b]Ric1[n,n,f3,q,c]]+Expand[sqrtg1[f1,a]Ric1[m,m,f2,k,b]Ric1[n,n,f3,q,c]]+2 Expand[Ric1[m,n,f1,p,a]Ric1[c,c,f2,k,b]ginv1[m,n,f3]])+Cc(ExpandAll[(Expand[Expand[Ric3[c,c,f1,p,f2,k,f3,q,a,b,m]]+Expand[ginv1[a,b,f3]Ric2[a,b,f1,p,f2,k,m,c]]+Expand[ginv2[a,b,f2,f3,m]Ric1[a,b,f1,p,c]]]*)
(*+sqrtg1[f3,n](Expand[Expand[Ric2[m,m,f1,p,f2,k,a,b]]+Expand[ginv1[a,b,f1]Ric1[a,b,f2,k,m]]])+sqrtg2[f3,f2,a,b]Expand[Ric1[c,c,f1,p,m]])])-ExpandAll[2\[CapitalLambda] sqrtg3[f1,f2,f3,a,b,c]])/.{f1[x_,y_]:>1/2 (\[Eta][x,\[Mu]]\[Eta][y,\[Nu]]+\[Eta][x,\[Nu]]\[Eta][y,\[Mu]]),f2[z_,t_]:>1/2 (\[Eta][z,\[Rho]]\[Eta][t,\[Sigma]]+\[Eta][z,\[Sigma]]\[Eta][t,\[Rho]]),f3[u_,w_]:>1/2 (\[Eta][u,\[Alpha]]\[Eta][w,\[Beta]]+\[Eta][u,\[Beta]]\[Eta][w,\[Alpha]])}]*)
(**)
(*V3Sym[\[Mu]_,\[Nu]_,p_,\[Rho]_,\[Sigma]_,k_,\[Alpha]_,\[Beta]_,q_,m_,n_,a_,b_,c_]:=ExpandAll[VV3[\[Mu],\[Nu],p,\[Rho],\[Sigma],k,\[Alpha],\[Beta],q,m,n,a,b,c]+VV3[\[Mu],\[Nu],p,\[Alpha],\[Beta],q,\[Rho],\[Sigma],k,m,n,a,b,c]+VV3[\[Rho],\[Sigma],k,\[Mu],\[Nu],p,\[Alpha],\[Beta],q,m,n,a,b,c]+VV3[\[Rho],\[Sigma],k,\[Alpha],\[Beta],q,\[Mu],\[Nu],p,m,n,a,b,c]+VV3[\[Alpha],\[Beta],q,\[Mu],\[Nu],p,\[Rho],\[Sigma],k,m,n,a,b,c]+VV3[\[Alpha],\[Beta],q,\[Rho],\[Sigma],k,\[Mu],\[Nu],p,m,n,a,b,c]]*)
(**)


(* ::Input::Closed:: *)
(*	(*Four gravitons vertex, momenta and indices f1\[Rule](p,\[Mu],\[Nu]), f2\[Rule](k,\[Rho],\[Sigma]), f3\[Rule](q,\[Alpha],\[Beta]), f4\[Rule](l,\[Gamma],\[Delta])*)*)


(* ::Input:: *)
(*VV4[\[Mu]_,\[Nu]_,p_,\[Rho]_,\[Sigma]_,k_,\[Alpha]_,\[Beta]_,q_,\[Gamma]_,\[Delta]_,l_,m_,n_,a_,b_,c_,d_,e_]:=ExpandAll[(Aa(Expand[Ric1[m,n,f1,p,a]Ric1[c,d,f2,k,b]ginv1[m,c,f3]ginv1[n,d,f4]]+2Expand[Ric1[m,n,f1,p,a]Ric1[c,n,f2,k,b]ginv2[m,c,f3,f4,e]]+4Expand[Ric1[m,n,f1,p,a]Ric2[c,n,f2,k,f3,q,b,e]ginv1[m,c,f4]]+Expand[Ric2[m,n,f1,p,f2,k,a,b]Ric2[m,n,f3,q,f4,l,c,d]]+2Expand[Ric3[m,n,f1,p,f2,k,f3,q,a,b,c]Ric1[m,n,f4,l,d]]+2Expand[sqrtg1[f1,a]Ric1[m,n,f2,k,b]Ric1[c,n,f3,q,d]ginv1[m,c,f4]]+2Expand[sqrtg1[f1,a]Ric1[m,n,f2,k,b]Ric2[m,n,f3,q,f4,l,c,d]]+Expand[sqrtg2[f1,f2,a,b]Ric1[m,n,f3,q,c]Ric1[m,n,f4,l,d]])+1/2 (Bb-Aa)(Expand[Ric1[m,n,f1,p,a]Ric1[c,d,f2,k,b]ginv1[m,n,f3]ginv1[c,d,f4]]+2Expand[Ric1[m,n,f1,p,a]Ric1[c,c,f2,k,b]ginv2[m,n,f3,f4,e]]+2Expand[Ric1[m,n,f1,p,a]Ric2[c,c,f2,k,f3,q,b,e]ginv1[m,n,f4]]+2Expand[Ric1[c,c,f1,p,a]Ric2[m,n,f2,k,f3,q,b,e]ginv1[m,n,f4]]+Expand[Ric2[m,m,f1,p,f2,k,a,b]Ric2[n,n,f3,q,f4,l,c,d]]+2Expand[Ric3[m,m,f1,p,f2,k,f3,q,a,b,c]Ric1[n,n,f4,l,d]]+2Expand[sqrtg1[f1,a]Ric1[m,n,f2,k,b]Ric1[c,c,f3,q,d]ginv1[m,n,f4]]+2Expand[sqrtg1[f1,a]Ric1[m,m,f2,k,b]Ric2[n,n,f3,q,f4,l,c,d]]+Expand[sqrtg2[f1,f2,a,b]Ric1[m,m,f3,q,c]Ric1[n,n,f4,l,d]])*)
(*+Cc(R4[f1,p,f2,k,f3,q,f4,l,a,b,c,d,e]+sqrtg1[f1,a]R3[f2,k,f3,q,f4,l,b,c,d,e]+sqrtg2[f1,f2,a,b]R2[f3,q,f4,l,c,d,e]+sqrtg3[f1,f2,f3,a,b,c]R1[f4,l,d,e])-ExpandAll[2\[CapitalLambda] sqrtg4[f1,f2,f3,f4,a,b,c,d]])/.{f1[x_,y_]->1/2 (\[Eta][x,\[Mu]]\[Eta][y,\[Nu]]+\[Eta][x,\[Nu]]\[Eta][y,\[Mu]]),f2[z_,t_]->1/2 (\[Eta][z,\[Rho]]\[Eta][t,\[Sigma]]+\[Eta][z,\[Sigma]]\[Eta][t,\[Rho]]),f3[u_,w_]->1/2 (\[Eta][u,\[Alpha]]\[Eta][w,\[Beta]]+\[Eta][u,\[Beta]]\[Eta][w,\[Alpha]]),f4[h_,i_]->1/2 (\[Eta][h,\[Gamma]]\[Eta][i,\[Delta]]+\[Eta][h,\[Delta]]\[Eta][i,\[Gamma]])}]*)
(**)
(*V4Sym[\[Mu]_,\[Nu]_,p_,\[Rho]_,\[Sigma]_,k_,\[Alpha]_,\[Beta]_,q_,\[Gamma]_,\[Delta]_,l_,m_,n_,a_,b_,c_,d_,e_]:=ExpandAll[(VV4[\[Mu],\[Nu],p,\[Rho],\[Sigma],k,\[Alpha],\[Beta],q,\[Gamma],\[Delta],l,m,n,a,b,c,d,e]+VV4[\[Mu],\[Nu],p,\[Rho],\[Sigma],k,\[Gamma],\[Delta],l,\[Alpha],\[Beta],q,m,n,a,b,c,d,e]+VV4[\[Mu],\[Nu],p,\[Alpha],\[Beta],q,\[Rho],\[Sigma],k,\[Gamma],\[Delta],l,m,n,a,b,c,d,e]+VV4[\[Mu],\[Nu],p,\[Alpha],\[Beta],q,\[Gamma],\[Delta],l,\[Rho],\[Sigma],k,m,n,a,b,c,d,e]+*)
(*VV4[\[Mu],\[Nu],p,\[Gamma],\[Delta],l,\[Rho],\[Sigma],k,\[Alpha],\[Beta],q,m,n,a,b,c,d,e]+*)
(*VV4[\[Mu],\[Nu],p,\[Gamma],\[Delta],l,\[Alpha],\[Beta],q,\[Rho],\[Sigma],k,m,n,a,b,c,d,e]+*)
(*VV4[\[Rho],\[Sigma],k,\[Mu],\[Nu],p,\[Alpha],\[Beta],q,\[Gamma],\[Delta],l,m,n,a,b,c,d,e]+*)
(*VV4[\[Rho],\[Sigma],k,\[Mu],\[Nu],p,\[Gamma],\[Delta],l,\[Alpha],\[Beta],q,m,n,a,b,c,d,e]+*)
(*VV4[\[Rho],\[Sigma],k,\[Alpha],\[Beta],q,\[Mu],\[Nu],p,\[Gamma],\[Delta],l,m,n,a,b,c,d,e]+*)
(*VV4[\[Rho],\[Sigma],k,\[Alpha],\[Beta],q,\[Gamma],\[Delta],l,\[Mu],\[Nu],p,m,n,a,b,c,d,e]+*)
(*VV4[\[Rho],\[Sigma],k,\[Gamma],\[Delta],l,\[Mu],\[Nu],p,\[Alpha],\[Beta],q,m,n,a,b,c,d,e]+*)
(*VV4[\[Rho],\[Sigma],k,\[Gamma],\[Delta],l,\[Alpha],\[Beta],q,\[Mu],\[Nu],p,m,n,a,b,c,d,e]+*)
(*VV4[\[Alpha],\[Beta],q,\[Mu],\[Nu],p,\[Rho],\[Sigma],k,\[Gamma],\[Delta],l,m,n,a,b,c,d,e]+*)
(*VV4[\[Alpha],\[Beta],q,\[Mu],\[Nu],p,\[Gamma],\[Delta],l,\[Rho],\[Sigma],k,m,n,a,b,c,d,e]+*)
(*VV4[\[Alpha],\[Beta],q,\[Rho],\[Sigma],k,\[Mu],\[Nu],p,\[Gamma],\[Delta],l,m,n,a,b,c,d,e]+*)
(*VV4[\[Alpha],\[Beta],q,\[Rho],\[Sigma],k,\[Gamma],\[Delta],l,\[Mu],\[Nu],p,m,n,a,b,c,d,e]+*)
(*VV4[\[Alpha],\[Beta],q,\[Gamma],\[Delta],l,\[Mu],\[Nu],p,\[Rho],\[Sigma],k,m,n,a,b,c,d,e]+*)
(*VV4[\[Alpha],\[Beta],q,\[Gamma],\[Delta],l,\[Rho],\[Sigma],k,\[Mu],\[Nu],p,m,n,a,b,c,d,e]+*)
(*VV4[\[Gamma],\[Delta],l,\[Mu],\[Nu],p,\[Rho],\[Sigma],k,\[Alpha],\[Beta],q,m,n,a,b,c,d,e]+*)
(*VV4[\[Gamma],\[Delta],l,\[Mu],\[Nu],p,\[Alpha],\[Beta],q,\[Rho],\[Sigma],k,m,n,a,b,c,d,e]+*)
(*VV4[\[Gamma],\[Delta],l,\[Rho],\[Sigma],k,\[Mu],\[Nu],p,\[Alpha],\[Beta],q,m,n,a,b,c,d,e]+*)
(*VV4[\[Gamma],\[Delta],l,\[Rho],\[Sigma],k,\[Alpha],\[Beta],q,\[Mu],\[Nu],p,m,n,a,b,c,d,e]+*)
(*VV4[\[Gamma],\[Delta],l,\[Alpha],\[Beta],q,\[Mu],\[Nu],p,\[Rho],\[Sigma],k,m,n,a,b,c,d,e]+VV4[\[Gamma],\[Delta],l,\[Alpha],\[Beta],q,\[Rho],\[Sigma],k,\[Mu],\[Nu],p,m,n,a,b,c,d,e])]*)
(**)


(* ::Input::Closed:: *)
(*	(*Graviton-Ghost-Antighost vertex, momenta and indices: antighost\[Rule](\[Mu],q), ghost\[Rule](\[Nu],p), f1\[Rule](\[Alpha],\[Beta],k)*)*)


(* ::Input:: *)
(**)
(*Vgh[\[Mu]_,\[Nu]_,p_,\[Alpha]_,\[Beta]_,k_,n_]:=Expand[-Expand[I(p[n]+k[n])(f1[\[Mu],\[Nu]]I p[n]+f1[\[Nu],n]I p[\[Mu]]+I k[\[Nu]]f1[\[Mu],n])-\[Omega] I(p[\[Mu]]+k[\[Mu]])(f1[\[Nu],n]I p[n]+1/2 f1[n,n]I k[\[Nu]])]/.{f1[x_,y_]:>1/2 (\[Eta][x,\[Alpha]]\[Eta][y,\[Beta]]+\[Eta][x,\[Beta]]\[Eta][y,\[Alpha]])}]*)


(* ::Input::Closed:: *)
(*(*PROPAGATORS*)*)


(* ::Input::Closed:: *)
(*	(*Graviton propagator*)*)


(* ::Input::Closed:: *)
(*		(*0 momenta in the numerator, Part I*)*)


(* ::Input:: *)
(*(*Numerator*)*)
(*N01[\[Mu]_,\[Nu]_,\[Rho]_,\[Sigma]_,p_]:=  \[Eta][\[Mu],\[Nu]]\[Eta][\[Rho],\[Sigma]]*)
(**)
(*(*Denominator*)*)
(*D01[p2_]:=-(4 \[CapitalLambda] (-Bb p2^2+\[CapitalLambda])+Cc^2 p2^2 \[Lambda] (-2+\[Omega])^2+Aa^2 p2^4 \[Lambda] (-2+\[Omega])^2-2 Cc p2 (\[CapitalLambda]+2 \[Lambda] \[CapitalLambda]+Aa p2^2 \[Lambda] (-2+\[Omega])^2-Bb p2^2 \[Lambda] (-2+\[Omega])^2-\[Lambda] \[CapitalLambda] \[Omega]^2)-2 Aa p2^2 (Bb p2^2 \[Lambda] (-2+\[Omega])^2+\[CapitalLambda] (-1+\[Lambda] (-2+\[Omega]^2))))/((Cc p2-Aa p2^2-2 \[CapitalLambda]) (-6 Bb p2^2 \[CapitalLambda]+4 \[CapitalLambda]^2+Cc^2 p2^2 \[Lambda] (-2+\[Omega])^2+Aa^2 p2^4 \[Lambda] (-2+\[Omega])^2+Aa p2^2 (-3 Bb p2^2 \[Lambda] (-2+\[Omega])^2+2 \[CapitalLambda] (1+\[Lambda]+2 \[Lambda] \[Omega]-2 \[Lambda] \[Omega]^2))-Cc p2 (2 Aa p2^2 \[Lambda] (-2+\[Omega])^2-3 Bb p2^2 \[Lambda] (-2+\[Omega])^2+2 \[CapitalLambda] (1+\[Lambda]+2 \[Lambda] \[Omega]-2 \[Lambda] \[Omega]^2))))*)
(**)
(**)


(* ::Input::Closed:: *)
(*		(*0 momenta in the numerator Part II*)*)


(* ::Input:: *)
(**)
(*(*Numerator*)*)
(*N02[\[Mu]_,\[Nu]_,\[Rho]_,\[Sigma]_,p_]:=\[Eta][\[Mu],\[Rho]] \[Eta][\[Nu],\[Sigma]]+\[Eta][\[Mu],\[Sigma]] \[Eta][\[Nu],\[Rho]]*)
(**)
(*(*Denominator*)*)
(*D02[p2_]:=1/(Cc p2-Aa p2^2-2 \[CapitalLambda])*)


(* ::Input::Closed:: *)
(*		(*2 momenta in the numerator*)*)


(* ::Input:: *)
(*(*Numerator*)*)
(*N2[\[Mu]_,\[Nu]_,\[Rho]_,\[Sigma]_,p_]:=(p[\[Rho]] p[\[Sigma]] \[Eta][\[Mu],\[Nu]]+p[\[Mu]] p[\[Nu]] \[Eta][\[Rho],\[Sigma]])*)
(**)
(*(*Denominator*)*)
(*D2[p2_]:=(2 (Cc^2 p2 \[Lambda] (2-3 \[Omega]+\[Omega]^2)+Cc \[Lambda] (Bb p2^2 (-2+\[Omega])^2+2 \[CapitalLambda] (-1+\[Omega])-2 Aa p2^2 (2-3 \[Omega]+\[Omega]^2))+p2 (-2 Bb \[CapitalLambda]-Aa \[Lambda] (Bb p2^2 (-2+\[Omega])^2+2 \[CapitalLambda] (-1+\[Omega]))+Aa^2 p2^2 \[Lambda] (2-3 \[Omega]+\[Omega]^2))))/((Cc p2-Aa p2^2-2 \[CapitalLambda]) (-6 Bb p2^2 \[CapitalLambda]+4 \[CapitalLambda]^2+Cc^2 p2^2 \[Lambda] (-2+\[Omega])^2+Aa^2 p2^4 \[Lambda] (-2+\[Omega])^2+Aa p2^2 (-3 Bb p2^2 \[Lambda] (-2+\[Omega])^2+2 \[CapitalLambda] (1+\[Lambda]+2 \[Lambda] \[Omega]-2 \[Lambda] \[Omega]^2))-Cc p2 (2 Aa p2^2 \[Lambda] (-2+\[Omega])^2-3 Bb p2^2 \[Lambda] (-2+\[Omega])^2+2 \[CapitalLambda] (1+\[Lambda]+2 \[Lambda] \[Omega]-2 \[Lambda] \[Omega]^2))))*)


(* ::Input::Closed:: *)
(*		(*4 momenta in the numerator*)*)


(* ::Input:: *)
(*(*Numerator*)*)
(*N4[\[Mu]_,\[Nu]_,\[Rho]_,\[Sigma]_,p_]:=(p[\[Mu]] p[\[Nu]] p[\[Rho]]p[\[Sigma]])*)
(**)
(*(*Denominator*)*)
(*D4[p2_]:=(4 (4 Bb \[CapitalLambda]^2-Cc^3 p2 \[Lambda] (-1+\[Omega]) (-3+\[Lambda]+\[Omega]+\[Lambda] \[Omega])+Aa^3 p2^4 \[Lambda] (-1+\[Omega]) (-3+\[Lambda]+\[Omega]+\[Lambda] \[Omega])-4 Aa Bb p2^2 \[Lambda] \[CapitalLambda] (2-4 \[Omega]+\[Omega]^2)+Aa^2 p2^2 \[Lambda] (4 \[CapitalLambda] (-1+\[Omega]) (-1+\[Lambda] \[Omega])+Bb p2^2 (\[Lambda] (-2+\[Omega])^2-3 (3-4 \[Omega]+\[Omega]^2)))+Cc^2 \[Lambda] (4 \[CapitalLambda] (-1+\[Omega]) (-1+\[Lambda] \[Omega])+3 Aa p2^2 (-1+\[Omega]) (-3+\[Lambda]+\[Omega]+\[Lambda] \[Omega])+Bb p2^2 (\[Lambda] (-2+\[Omega])^2-3 (3-4 \[Omega]+\[Omega]^2)))+Cc p2 \[Lambda] (-3 Aa^2 p2^2 (-1+\[Omega]) (-3+\[Lambda]+\[Omega]+\[Lambda] \[Omega])+4 Bb \[CapitalLambda] (2-4 \[Omega]+\[Omega]^2)-2 Aa (4 \[CapitalLambda] (-1+\[Omega]) (-1+\[Lambda] \[Omega])+Bb p2^2 (\[Lambda] (-2+\[Omega])^2-3 (3-4 \[Omega]+\[Omega]^2))))))/((Cc p2-Aa p2^2-2 \[CapitalLambda]) (Cc p2 \[Lambda]-Aa p2^2 \[Lambda]-2 \[CapitalLambda]) (-6 Bb p2^2 \[CapitalLambda]+4 \[CapitalLambda]^2+Cc^2 p2^2 \[Lambda] (-2+\[Omega])^2+Aa^2 p2^4 \[Lambda] (-2+\[Omega])^2+Aa p2^2 (-3 Bb p2^2 \[Lambda] (-2+\[Omega])^2+2 \[CapitalLambda] (1+\[Lambda]+2 \[Lambda] \[Omega]-2 \[Lambda] \[Omega]^2))-Cc p2 (2 Aa p2^2 \[Lambda] (-2+\[Omega])^2-3 Bb p2^2 \[Lambda] (-2+\[Omega])^2+2 \[CapitalLambda] (1+\[Lambda]+2 \[Lambda] \[Omega]-2 \[Lambda] \[Omega]^2))))*)


(* ::Input::Closed:: *)
(*		(*Part which vanishes at \[Lambda]=1*)*)


(* ::Input:: *)
(*(*Numerator*)*)
(*NL[\[Mu]_,\[Nu]_,\[Rho]_,\[Sigma]_,p_]:=(p[\[Mu]] p[\[Rho]] \[Eta][\[Nu],\[Sigma]]+p[\[Mu]] p[\[Sigma]] \[Eta][\[Nu],\[Rho]]+p[\[Nu]] p[\[Rho]] \[Eta][\[Mu],\[Sigma]]+p[\[Nu]] p[\[Sigma]] \[Eta][\[Mu],\[Rho]])*)
(**)
(*(*Denominator*)*)
(*DL[p2_]:=-(((Cc-Aa p2) (-1+\[Lambda]))/((Cc p2-Aa p2^2-2 \[CapitalLambda]) (Cc p2 \[Lambda]-Aa p2^2 \[Lambda]-2 \[CapitalLambda])))*)


(* ::Input::Closed:: *)
(*	(*Ghost propagator*)*)


(* ::Input:: *)
(*(*Numerator*)*)
(*Ngh[\[Mu]_,\[Nu]_,p_,a_]:=(\[Omega]-1)/(\[Omega]-2) p[\[Mu]]p[\[Nu]]-p[a]p[a]\[Eta][\[Mu],\[Nu]]*)
(*(*Denominator 1/p2^2*)*)
(**)


(* ::Input::Closed:: *)
(*(*SELF-ENERGY*)*)


(* ::Input::Closed:: *)
(*	(*Graviton loop*)*)


(* ::Input::Closed:: *)
(*	(*Bubble diagram*)*)


(* ::Input::Closed:: *)
(*		(*Diagram evaluation*)*)


(* ::Input:: *)
(*d30101=ExpandAll[ExpandAll[ExpandAll[V3Sym[\[Mu],\[Nu],p,\[Mu]1,\[Nu]1,k-p,\[Mu]2,\[Nu]2,-k,m1,n1,a1,b1,c1]N01[\[Mu]1,\[Nu]1,\[Rho]1,\[Sigma]1,k-p]]ExpandAll[V3Sym[\[Rho],\[Sigma],-p,\[Rho]1,\[Sigma]1,p-k,\[Rho]2,\[Sigma]2,k,m2,n2,a2,b2,c2]N01[\[Mu]2,\[Nu]2,\[Rho]2,\[Sigma]2,k]]]];*)
(**)
(*d30102=ExpandAll[ExpandAll[ExpandAll[V3Sym[\[Mu],\[Nu],p,\[Mu]1,\[Nu]1,k-p,\[Mu]2,\[Nu]2,-k,m1,n1,a1,b1,c1]N01[\[Mu]1,\[Nu]1,\[Rho]1,\[Sigma]1,k-p]]ExpandAll[V3Sym[\[Rho],\[Sigma],-p,\[Rho]1,\[Sigma]1,p-k,\[Rho]2,\[Sigma]2,k,m2,n2,a2,b2,c2]N02[\[Mu]2,\[Nu]2,\[Rho]2,\[Sigma]2,k]]]];*)
(**)
(*d30202=ExpandAll[ExpandAll[ExpandAll[V3Sym[\[Mu],\[Nu],p,\[Mu]1,\[Nu]1,k-p,\[Mu]2,\[Nu]2,-k,m1,n1,a1,b1,c1]N02[\[Mu]1,\[Nu]1,\[Rho]1,\[Sigma]1,k-p]]ExpandAll[V3Sym[\[Rho],\[Sigma],-p,\[Rho]1,\[Sigma]1,p-k,\[Rho]2,\[Sigma]2,k,m2,n2,a2,b2,c2]N02[\[Mu]2,\[Nu]2,\[Rho]2,\[Sigma]2,k]]]];*)
(**)
(*d3012=ExpandAll[ExpandAll[ExpandAll[V3Sym[\[Mu],\[Nu],p,\[Mu]1,\[Nu]1,k-p,\[Mu]2,\[Nu]2,-k,m1,n1,a1,b1,c1]N01[\[Mu]1,\[Nu]1,\[Rho]1,\[Sigma]1,k-p]]ExpandAll[V3Sym[\[Rho],\[Sigma],-p,\[Rho]1,\[Sigma]1,p-k,\[Rho]2,\[Sigma]2,k,m2,n2,a2,b2,c2]N2[\[Mu]2,\[Nu]2,\[Rho]2,\[Sigma]2,k]]]];*)
(**)
(*d3022=ExpandAll[ExpandAll[ExpandAll[V3Sym[\[Mu],\[Nu],p,\[Mu]1,\[Nu]1,k-p,\[Mu]2,\[Nu]2,-k,m1,n1,a1,b1,c1]N02[\[Mu]1,\[Nu]1,\[Rho]1,\[Sigma]1,k-p]]ExpandAll[V3Sym[\[Rho],\[Sigma],-p,\[Rho]1,\[Sigma]1,p-k,\[Rho]2,\[Sigma]2,k,m2,n2,a2,b2,c2]N2[\[Mu]2,\[Nu]2,\[Rho]2,\[Sigma]2,k]]]];*)
(*d322=ExpandAll[ExpandAll[ExpandAll[V3Sym[\[Mu],\[Nu],p,\[Mu]1,\[Nu]1,k-p,\[Mu]2,\[Nu]2,-k,m1,n1,a1,b1,c1]N2[\[Mu]1,\[Nu]1,\[Rho]1,\[Sigma]1,k-p]]ExpandAll[V3Sym[\[Rho],\[Sigma],-p,\[Rho]1,\[Sigma]1,p-k,\[Rho]2,\[Sigma]2,k,m2,n2,a2,b2,c2]N2[\[Mu]2,\[Nu]2,\[Rho]2,\[Sigma]2,k]]]];*)
(**)
(*d3014=ExpandAll[ExpandAll[ExpandAll[V3Sym[\[Mu],\[Nu],p,\[Mu]1,\[Nu]1,k-p,\[Mu]2,\[Nu]2,-k,m1,n1,a1,b1,c1]N01[\[Mu]1,\[Nu]1,\[Rho]1,\[Sigma]1,k-p]]ExpandAll[V3Sym[\[Rho],\[Sigma],-p,\[Rho]1,\[Sigma]1,p-k,\[Rho]2,\[Sigma]2,k,m2,n2,a2,b2,c2]N4[\[Mu]2,\[Nu]2,\[Rho]2,\[Sigma]2,k]]]];*)
(**)
(*d3024=ExpandAll[ExpandAll[ExpandAll[V3Sym[\[Mu],\[Nu],p,\[Mu]1,\[Nu]1,k-p,\[Mu]2,\[Nu]2,-k,m1,n1,a1,b1,c1]N02[\[Mu]1,\[Nu]1,\[Rho]1,\[Sigma]1,k-p]]ExpandAll[V3Sym[\[Rho],\[Sigma],-p,\[Rho]1,\[Sigma]1,p-k,\[Rho]2,\[Sigma]2,k,m2,n2,a2,b2,c2]N4[\[Mu]2,\[Nu]2,\[Rho]2,\[Sigma]2,k]]]];*)
(**)
(*d324=ExpandAll[ExpandAll[ExpandAll[V3Sym[\[Mu],\[Nu],p,\[Mu]1,\[Nu]1,k-p,\[Mu]2,\[Nu]2,-k,m1,n1,a1,b1,c1]N2[\[Mu]1,\[Nu]1,\[Rho]1,\[Sigma]1,k-p]]ExpandAll[V3Sym[\[Rho],\[Sigma],-p,\[Rho]1,\[Sigma]1,p-k,\[Rho]2,\[Sigma]2,k,m2,n2,a2,b2,c2]N4[\[Mu]2,\[Nu]2,\[Rho]2,\[Sigma]2,k]]]];*)
(**)
(*d344=ExpandAll[ExpandAll[ExpandAll[V3Sym[\[Mu],\[Nu],p,\[Mu]1,\[Nu]1,k-p,\[Mu]2,\[Nu]2,-k,m1,n1,a1,b1,c1]N4[\[Mu]1,\[Nu]1,\[Rho]1,\[Sigma]1,k-p]]ExpandAll[V3Sym[\[Rho],\[Sigma],-p,\[Rho]1,\[Sigma]1,p-k,\[Rho]2,\[Sigma]2,k,m2,n2,a2,b2,c2]N4[\[Mu]2,\[Nu]2,\[Rho]2,\[Sigma]2,k]]]];*)
(**)
(*d301L=ExpandAll[ExpandAll[ExpandAll[V3Sym[\[Mu],\[Nu],p,\[Mu]1,\[Nu]1,k-p,\[Mu]2,\[Nu]2,-k,m1,n1,a1,b1,c1]N01[\[Mu]1,\[Nu]1,\[Rho]1,\[Sigma]1,k-p]]ExpandAll[V3Sym[\[Rho],\[Sigma],-p,\[Rho]1,\[Sigma]1,p-k,\[Rho]2,\[Sigma]2,k,m2,n2,a2,b2,c2]NL[\[Mu]2,\[Nu]2,\[Rho]2,\[Sigma]2,k]]]];*)
(**)
(*d302L=ExpandAll[ExpandAll[ExpandAll[V3Sym[\[Mu],\[Nu],p,\[Mu]1,\[Nu]1,k-p,\[Mu]2,\[Nu]2,-k,m1,n1,a1,b1,c1]N02[\[Mu]1,\[Nu]1,\[Rho]1,\[Sigma]1,k-p]]ExpandAll[V3Sym[\[Rho],\[Sigma],-p,\[Rho]1,\[Sigma]1,p-k,\[Rho]2,\[Sigma]2,k,m2,n2,a2,b2,c2]NL[\[Mu]2,\[Nu]2,\[Rho]2,\[Sigma]2,k]]]];*)
(**)
(*d32L=ExpandAll[ExpandAll[ExpandAll[V3Sym[\[Mu],\[Nu],p,\[Mu]1,\[Nu]1,k-p,\[Mu]2,\[Nu]2,-k,m1,n1,a1,b1,c1]N2[\[Mu]1,\[Nu]1,\[Rho]1,\[Sigma]1,k-p]]ExpandAll[V3Sym[\[Rho],\[Sigma],-p,\[Rho]1,\[Sigma]1,p-k,\[Rho]2,\[Sigma]2,k,m2,n2,a2,b2,c2]NL[\[Mu]2,\[Nu]2,\[Rho]2,\[Sigma]2,k]]]];*)
(**)
(*d34L=ExpandAll[ExpandAll[ExpandAll[V3Sym[\[Mu],\[Nu],p,\[Mu]1,\[Nu]1,k-p,\[Mu]2,\[Nu]2,-k,m1,n1,a1,b1,c1]N4[\[Mu]1,\[Nu]1,\[Rho]1,\[Sigma]1,k-p]]ExpandAll[V3Sym[\[Rho],\[Sigma],-p,\[Rho]1,\[Sigma]1,p-k,\[Rho]2,\[Sigma]2,k,m2,n2,a2,b2,c2]NL[\[Mu]2,\[Nu]2,\[Rho]2,\[Sigma]2,k]]]];*)
(**)
(*d3LL=ExpandAll[ExpandAll[ExpandAll[V3Sym[\[Mu],\[Nu],p,\[Mu]1,\[Nu]1,k-p,\[Mu]2,\[Nu]2,-k,m1,n1,a1,b1,c1]NL[\[Mu]1,\[Nu]1,\[Rho]1,\[Sigma]1,k-p]]ExpandAll[V3Sym[\[Rho],\[Sigma],-p,\[Rho]1,\[Sigma]1,p-k,\[Rho]2,\[Sigma]2,k,m2,n2,a2,b2,c2]NL[\[Mu]2,\[Nu]2,\[Rho]2,\[Sigma]2,k]]]];*)


(* ::Input::Closed:: *)
(*		(*UV expansion and divergent parts*)*)


(* ::Input:: *)
(*Expand[1/2 (d30101 D01[k2-2pk+p2]D01[k2])]/.{k2->q2/y^2,pk->pq/y,k[m_]->q[m]/y};*)
(**)
(*D30101=Expand[Simplify[Coefficient[Normal[Series[%,{y,0,4}]],y,4]]];*)
(**)
(*Expand[1/2 (d30102 D01[k2-2pk+p2]D02[k2])]/.{k2->q2/y^2,pk->pq/y,k[m_]->q[m]/y};*)
(**)
(*D30102=Expand[Simplify[Coefficient[Normal[Series[%,{y,0,4}]],y,4]]];*)
(**)
(*Expand[1/2 (d30202 D02[k2-2pk+p2]D02[k2])]/.{k2->q2/y^2,pk->pq/y,k[m_]->q[m]/y};*)
(**)
(*D30202=Expand[Simplify[Coefficient[Normal[Series[%,{y,0,4}]],y,4]]];*)
(**)
(*Expand[1/2 (d3012 D01[k2-2pk+p2]D2[k2])]/.{k2->q2/y^2,pk->pq/y,k[m_]->q[m]/y};*)
(**)
(*D3012=Expand[Simplify[Coefficient[Normal[Series[%,{y,0,4}]],y,4]]];*)
(**)
(*Expand[1/2 (d3022 D02[k2-2pk+p2]D2[k2])]/.{k2->q2/y^2,pk->pq/y,k[m_]->q[m]/y};*)
(**)
(*D3022=Expand[Simplify[Coefficient[Normal[Series[%,{y,0,4}]],y,4]]];*)
(**)
(*Expand[1/2 (d322 D2[k2-2pk+p2]D2[k2])]/.{k2->q2/y^2,pk->pq/y,k[m_]->q[m]/y};*)
(**)
(*D322=Expand[Simplify[Coefficient[Normal[Series[%,{y,0,4}]],y,4]]];*)
(**)
(*Expand[1/2 (d3014 D01[k2-2pk+p2]D4[k2])]/.{k2->q2/y^2,pk->pq/y,k[m_]->q[m]/y};*)
(**)
(*D3014=Expand[Simplify[Coefficient[Normal[Series[%,{y,0,4}]],y,4]]];*)
(**)
(*Expand[1/2 (d3024 D02[k2-2pk+p2]D4[k2])]/.{k2->q2/y^2,pk->pq/y,k[m_]->q[m]/y};*)
(**)
(*D3024=Expand[Simplify[Coefficient[Normal[Series[%,{y,0,4}]],y,4]]];*)
(**)
(*Expand[1/2 (d324 D2[k2-2pk+p2]D4[k2])]/.{k2->q2/y^2,pk->pq/y,k[m_]->q[m]/y};*)
(**)
(*D324=Expand[Simplify[Coefficient[Normal[Series[%,{y,0,4}]],y,4]]];*)
(**)
(*Expand[1/2 (d344 D4[k2-2pk+p2]D4[k2])]/.{k2->q2/y^2,pk->pq/y,k[m_]->q[m]/y};*)
(**)
(*D344=Expand[Simplify[Coefficient[Normal[Series[%,{y,0,4}]],y,4]]];*)
(**)
(*Expand[1/2 (d301L D01[k2-2pk+p2]DL[k2])]/.{k2->q2/y^2,pk->pq/y,k[m_]->q[m]/y};*)
(**)
(*D301L=Expand[Simplify[Coefficient[Normal[Series[%,{y,0,4}]],y,4]]];*)
(**)
(*Expand[1/2 (d302L D02[k2-2pk+p2]DL[k2])]/.{k2->q2/y^2,pk->pq/y,k[m_]->q[m]/y};*)
(**)
(*D302L=Expand[Simplify[Coefficient[Normal[Series[%,{y,0,4}]],y,4]]];*)
(**)
(*Expand[1/2 (d32L D2[k2-2pk+p2]DL[k2])]/.{k2->q2/y^2,pk->pq/y,k[m_]->q[m]/y};*)
(**)
(*D32L=Expand[Simplify[Coefficient[Normal[Series[%,{y,0,4}]],y,4]]];*)
(**)
(*Expand[1/2 (d34L D4[k2-2pk+p2]DL[k2])]/.{k2->q2/y^2,pk->pq/y,k[m_]->q[m]/y};*)
(**)
(*D34L=Expand[Simplify[Coefficient[Normal[Series[%,{y,0,4}]],y,4]]];*)
(**)
(*Expand[1/2 (d3LL D01[k2-2pk+p2]DL[k2])]/.{k2->q2/y^2,pk->pq/y,k[m_]->q[m]/y};*)
(**)
(*D3LL=Expand[Simplify[Coefficient[Normal[Series[%,{y,0,4}]],y,4]]];*)


(* ::Input::Closed:: *)
(*	(*Tadpole diagram*)*)


(* ::Input::Closed:: *)
(*		(*Diagram evaluation*)*)


(* ::Input:: *)
(*d401=ExpandAll[ExpandAll[ExpandAll[V4Sym[\[Mu],\[Nu],p,\[Mu]1,\[Nu]1,q,\[Mu]2,\[Nu]2,-q,\[Rho],\[Sigma],-p,m1,n1,a1,b1,c1,d1,e1]]N01[\[Mu]1,\[Nu]1,\[Mu]2,\[Nu]2,q]]];*)
(**)
(*d402=ExpandAll[ExpandAll[ExpandAll[V4Sym[\[Mu],\[Nu],p,\[Mu]1,\[Nu]1,q,\[Mu]2,\[Nu]2,-q,\[Rho],\[Sigma],-p,m1,n1,a1,b1,c1,d1,e1]]N02[\[Mu]1,\[Nu]1,\[Mu]2,\[Nu]2,q]]];*)
(**)
(*d42=ExpandAll[ExpandAll[ExpandAll[V4Sym[\[Mu],\[Nu],p,\[Mu]1,\[Nu]1,q,\[Mu]2,\[Nu]2,-q,\[Rho],\[Sigma],-p,m1,n1,a1,b1,c1,d1,e1]]N2[\[Mu]1,\[Nu]1,\[Mu]2,\[Nu]2,q]]];*)
(**)
(*d44=ExpandAll[ExpandAll[ExpandAll[V4Sym[\[Mu],\[Nu],p,\[Mu]1,\[Nu]1,q,\[Mu]2,\[Nu]2,-q,\[Rho],\[Sigma],-p,m1,n1,a1,b1,c1,d1,e1]]N4[\[Mu]1,\[Nu]1,\[Mu]2,\[Nu]2,q]]];*)
(**)
(*d4L=ExpandAll[ExpandAll[ExpandAll[V4Sym[\[Mu],\[Nu],p,\[Mu]1,\[Nu]1,q,\[Mu]2,\[Nu]2,-q,\[Rho],\[Sigma],-p,m1,n1,a1,b1,c1,d1,e1]]NL[\[Mu]1,\[Nu]1,\[Mu]2,\[Nu]2,q]]];*)


(* ::Input::Closed:: *)
(*		(*UV expansion and divergent parts*)*)


(* ::Input:: *)
(*Expand[1/2 (d401 D01[q2])]/.{q2->q2/y^2,pq->pq/y,q[m_]->q[m]/y};*)
(**)
(*D401=Expand[Simplify[Coefficient[Normal[Series[%,{y,0,4}]],y,4]]];*)
(**)
(*Expand[1/2 (d402 D02[q2])]/.{q2->q2/y^2,pq->pq/y,q[m_]->q[m]/y};*)
(**)
(*D402=Expand[Simplify[Coefficient[Normal[Series[%,{y,0,4}]],y,4]]];*)
(**)
(*Expand[1/2 (d42 D2[q2])]/.{q2->q2/y^2,pq->pq/y,q[m_]->q[m]/y};*)
(**)
(*D42=Expand[Simplify[Coefficient[Normal[Series[%,{y,0,4}]],y,4]]];*)
(**)
(*Expand[1/2 (d44 D4[q2])]/.{q2->q2/y^2,pq->pq/y,q[m_]->q[m]/y};*)
(**)
(*D44=Expand[Simplify[Coefficient[Normal[Series[%,{y,0,4}]],y,4]]];*)
(**)
(*Expand[1/2 (d4L DL[q2])]/.{q2->q2/y^2,pq->pq/y,q[m_]->q[m]/y};*)
(**)
(*D4L=Expand[Simplify[Coefficient[Normal[Series[%,{y,0,4}]],y,4]]];*)
(**)


(* ::Input::Closed:: *)
(*	(*Ghost loop*)*)


(* ::Input::Closed:: *)
(*		(*Diagram evaluation and divergent part*)*)


(* ::Input:: *)
(*Expand[Expand[Vgh[\[Mu]1,\[Mu]2,-k,\[Mu],\[Nu],p,n1]]Expand[Ngh[\[Mu]1,\[Nu]2,p-k,a1]]Expand[Vgh[\[Nu]1,\[Nu]2,p-k,\[Rho],\[Sigma],-p,n2]]Expand[Ngh[\[Mu]2,\[Nu]1,k,a2]]];*)
(**)
(*ExpandAll[Expand[-(%/(k2^2 (p2+k2-2 pk)^2))]/.{k2->q2/y^2,pk->pq/y,k[m_]->q[m]/y}];*)
(**)
(*Expand[Simplify[%]];*)
(**)
(*ExpandAll[Coefficient[Normal[Series[%,{y,0,4}]],y,4]];*)
(**)
(*Dgh=Expand[Simplify[ExpandAll[%]]];*)


(* ::Input::Closed:: *)
(*	(*Partial result*)*)


(* ::Input::Closed:: *)
(*		(*In terms of tensors*)*)


(* ::Input:: *)
(*(*Sum of all the pieces and symmetric integration*)*)
(*DivS=Expand[Simplify[Expand[D30101+2D30102+D30202+2D3012+2D3022+D322+2D3014+2D3024+2D324+D344+(D401+D402+D42+D44+D4L)+2D301L+2D302L+2D32L+2D34L+D3LL+Dgh]]];*)
(*Expand[%/.{rp106}];*)
(*Expand[%/.{rp84,rp85,rp86,rp87,rp88}];*)
(*Expand[%/.{rp62,rp63,rp64,rp65,rp66}];*)
(*Expand[%/.{rp40,rp41,rp42,rp43,rp44}];*)
(*Expand[%/.{rp20,rp21,rp22}];*)
(*ris=Expand[%/.{1/q2^2->2/((4 Pi)^2 \[Epsilon])}];*)


(* ::Input::Closed:: *)
(*		(*In terms of spin-2 projectors*)*)


(* ::Input:: *)
(*Expand[ris/.{\[Eta][\[Mu],\[Rho]]\[Eta][\[Nu],\[Sigma]]->2 P1+2P2+2P0+2 PP0-\[Eta][\[Mu],\[Sigma]]\[Eta][\[Nu],\[Rho]]}];*)
(*Expand[%/.{p[\[Mu]]p[\[Nu]]p[\[Rho]]p[\[Sigma]]->p2^2 PP0}];*)
(*Expand[%/.{\[Eta][\[Mu],\[Nu]]\[Eta][\[Rho],\[Sigma]]->(3 P0+PP0+PPP0)}];*)
(*Expand[%/.{\[Eta][\[Mu],\[Rho]]p[\[Nu]]p[\[Sigma]]->2p2 P1+4 p2 PP0-\[Eta][\[Mu],\[Sigma]]p[\[Rho]]p[\[Nu]]-\[Eta][\[Nu],\[Sigma]]p[\[Mu]]p[\[Rho]]-\[Eta][\[Nu],\[Rho]]p[\[Mu]]p[\[Sigma]]}];*)
(*Expand[%/.{\[Eta][\[Mu],\[Nu]]p[\[Rho]]p[\[Sigma]]->p2 PPP0+2 p2 PP0-\[Eta][\[Rho],\[Sigma]]p[\[Mu]]p[\[Nu]]}];*)
(*Ris=Simplify[Coefficient[%,P1]]P1+Simplify[Coefficient[%,P0]]P0+Simplify[Coefficient[%,P2]]P2+Simplify[Coefficient[%,PP0]]PP0+Simplify[Coefficient[%,PPP0]]PPP0;*)
(**)


(* ::Input::Closed:: *)
(*	(*Terms proportional to the equations of motion*)*)


(* ::Input::Closed:: *)
(*		(*Parameters obtained from the file QGFieldRedefinitions.nb (.m)*)*)


(* ::Input:: *)
(*t1=(-Aa (9-8 \[Omega]+2 \[Omega]^2+\[Lambda] (12-9 \[Omega]+\[Omega]^2))+Bb (5 \[Lambda] (8-6 \[Omega]+\[Omega]^2)+3 (9-8 \[Omega]+2 \[Omega]^2)))/(24 Aa (Aa-3 Bb) \[Pi]^2 \[Epsilon] \[Lambda] (-2+\[Omega])^2);*)
(*t2=(Aa (-21+20 \[Omega]-5 \[Omega]^2+2 \[Lambda] (12-9 \[Omega]+\[Omega]^2))+Bb (63-60 \[Omega]+15 \[Omega]^2-10 \[Lambda] (8-6 \[Omega]+\[Omega]^2)))/(192 Aa (Aa-3 Bb) \[Pi]^2 \[Epsilon] \[Lambda] (-2+\[Omega])^2);*)
(*t3=(-2 Aa (3-4 \[Omega]+\[Omega]^2+\[Lambda] (37-24 \[Omega]+3 \[Omega]^2))+Bb (6 (3-4 \[Omega]+\[Omega]^2)+5 \[Lambda] (48-32 \[Omega]+5 \[Omega]^2)))/(192 Aa (Aa-3 Bb) \[Pi]^2 \[Epsilon] \[Lambda] (-2+\[Omega])^2);*)
(*t4=(-5 Bb (48-32 \[Omega]+5 \[Omega]^2)+Aa (74-48 \[Omega]+6 \[Omega]^2))/(384 Aa (Aa-3 Bb) \[Pi]^2 \[Epsilon] (-2+\[Omega])^2);*)
(*t5=(2 Aa (42-40 \[Omega]+10 \[Omega]^2+\[Lambda] (17-16 \[Omega]+7 \[Omega]^2))-Bb (12 (21-20 \[Omega]+5 \[Omega]^2)+5 \[Lambda] (16-16 \[Omega]+9 \[Omega]^2)))/(768 Aa (Aa-3 Bb) \[Pi]^2 \[Epsilon] \[Lambda] (-2+\[Omega])^2);*)
(*t6=(-2 Aa (27-20 \[Omega]+5 \[Omega]^2)+5 Bb (32-24 \[Omega]+7 \[Omega]^2))/(1536 Aa (Aa-3 Bb) \[Pi]^2 \[Epsilon] (-2+\[Omega])^2);*)


(* ::Input::Closed:: *)
(*		(*Field redefinitions and equations of motion*)*)


(* ::Input:: *)
(*(*Field redefinition linear in the graviton*)*)
(*deltaG1[m_,n_,r_,s_,a_]:=Expand[(t1 f1[m,n]+t2 \[Eta][m,n]f1[a,a])/.{f1[x_,y_]:>1/2 (\[Eta][x,r]\[Eta][y,s]+\[Eta][x,s]\[Eta][y,r])}]*)
(*(*Field redefinition quadratic in the graviton*)*)
(*deltaG2[\[Mu]_,\[Nu]_,m_,n_,r_,s_,a_,b_]:=Expand[((t3)(f1[\[Mu],a]f2[a,\[Nu]])+t4(f1[a,a]f2[\[Mu],\[Nu]])+t5(\[Eta][\[Mu],\[Nu]]f1[a,b]f2[a,b])+(t6)\[Eta][\[Mu],\[Nu]]f1[a,a]f2[b,b])/.{f1[x_,y_]:>1/2 (\[Eta][x,m]\[Eta][y,n]+\[Eta][x,n]\[Eta][y,m]),f2[z_,u_]:>1/2 (\[Eta][z,r]\[Eta][u,s]+\[Eta][z,s]\[Eta][u,r])}]*)
(*(*Linear equations of motions of the graviton*)*)
(*EE1[m_,n_,r_,s_,p_,p2_,a_,b_]:=Expand[((-Aa p2+Cc)(Ric1[m,n,f1,p,a]-1/2 \[Eta][m,n]R1[f1,p,a,b])+Bb(-p2 \[Eta][m,n]R1[f1,p,a,b]+p[m]p[n]R1[f1,p,a,b])+ \[CapitalLambda](sqrtg1[f1,a]\[Eta][m,n]+ginv1[m,n,f1]))/.{f1[x_,y_]:>1/2 (\[Eta][x,r]\[Eta][y,s]+\[Eta][x,s]\[Eta][y,r])}]*)
(*(*Trace of covariant equations of motion, quadratic in the graviton*)*)
(*EEC[m_,n_,r_,s_,p_,p2_,a_,b_,c_]:=Expand[(-AA( Cc (sqrtg1[f1,a]R1[f2,-p,b,c]+sqrtg1[f2,a]R1[f1,p,b,c]+R2[f1,p,f2,-p,a,b,c]+R2[f2,-p,f1,p,a,b,c])-8\[CapitalLambda] sqrtg2[f1,f2,a,b]))/.{f1[x_,y_]:>1/2 (\[Eta][x,m]\[Eta][y,n]+\[Eta][x,n]\[Eta][y,m]),f2[z_,u_]:>1/2 (\[Eta][z,r]\[Eta][u,s]+\[Eta][z,s]\[Eta][u,r])}]*)
(*(*Lagrangian terms*)*)
(*Expand[EEC[\[Mu],\[Nu],\[Rho],\[Sigma],p,p2,a3,b3,c3]+deltaG1[m,n,\[Mu],\[Nu],a1]EE1[m,n,\[Rho],\[Sigma],p,p2,a2,b2]+deltaG1[m,n,\[Rho],\[Sigma],a1]EE1[m,n,\[Mu],\[Nu],p,p2,a2,b2]+\[CapitalLambda] \[Eta][m,n](deltaG2[m,n,\[Mu],\[Nu],\[Rho],\[Sigma],a4,b4]+deltaG2[m,n,\[Rho],\[Sigma],\[Mu],\[Nu],a4,b4])];*)
(*Expand[%/.{\[Eta][\[Mu],\[Rho]]\[Eta][\[Nu],\[Sigma]]->2 P1+2P2+2P0+2 PP0-\[Eta][\[Mu],\[Sigma]]\[Eta][\[Nu],\[Rho]]}];*)
(*Expand[%/.{p[\[Mu]]p[\[Nu]]p[\[Rho]]p[\[Sigma]]->p2^2 PP0}];*)
(*Expand[%/.{\[Eta][\[Mu],\[Nu]]\[Eta][\[Rho],\[Sigma]]->(3 P0+PP0+PPP0)}];*)
(*Expand[%/.{\[Eta][\[Mu],\[Rho]]p[\[Nu]]p[\[Sigma]]->2p2 P1+4 p2 PP0-\[Eta][\[Mu],\[Sigma]]p[\[Rho]]p[\[Nu]]-\[Eta][\[Nu],\[Sigma]]p[\[Mu]]p[\[Rho]]-\[Eta][\[Nu],\[Rho]]p[\[Mu]]p[\[Sigma]]}];*)
(*Expand[%/.{\[Eta][\[Mu],\[Nu]]p[\[Rho]]p[\[Sigma]]->p2 PPP0+2 p2 PP0-\[Eta][\[Rho],\[Sigma]]p[\[Mu]]p[\[Nu]]}];*)
(*EEN=Simplify[Coefficient[%,P1]]P1+Simplify[Coefficient[%,P0]]P0+Simplify[Coefficient[%,P2]]P2+Simplify[Coefficient[%,PP0]]PP0+Simplify[Coefficient[%,PPP0]]PPP0;*)
(**)
(**)


(* ::Input::Closed:: *)
(*	(*Final result*)*)


(* ::Input:: *)
(*Tt=Expand[1/2 (Ris+EEN)];*)


(* ::Input::Closed:: *)
(*(*BETA FUNCTIONS*)*)


(* ::Input::Closed:: *)
(*	(*Beta functions, program notation*)*)


(* ::Input::Closed:: *)
(*\[CapitalDelta]Aa=Simplify[Coefficient[-2(32 \[Pi]^2 \[Epsilon]) Tt/p2^2/.{Cc->0,\[CapitalLambda]->0},P2]]*)
(**)
(*\[CapitalDelta]Bb=Simplify[-6Coefficient[-(1/6)(32 \[Pi]^2 \[Epsilon])Tt/.{Cc->0,\[CapitalLambda]->0},p2^2P0]]*)
(*\[CapitalDelta]Cc=Simplify[-2Cc(32 \[Pi]^2 \[Epsilon]) Coefficient[Tt,Cc,1]/(p2 (2P0-P2))]*)
(*\[CapitalDelta]\[CapitalLambda]=Simplify[-2(32 \[Pi]^2 \[Epsilon])Cc^2 Coefficient[Tt,Cc,2]/(P0-2 P1-2 P2-PP0+PPP0)]+Simplify[2 \[CapitalLambda] (32 \[Pi]^2 \[Epsilon])Coefficient[Tt/(P0-2 P1-2 P2-PP0+PPP0),\[CapitalLambda],1]]*)
(*(*To obtain the beta functions multiply by -1/(32\[Pi]^2) these results*)*)


(* ::Input:: *)
(*Simplify[Cc \[CapitalDelta]\[CapitalLambda]-2 \[CapitalLambda] \[CapitalDelta]\[Zeta]]*)
(**)


(* ::Input::Closed:: *)
(*	(*Beta functions, paper notation*)*)


(* ::Input::Closed:: *)
(*\[CapitalDelta]\[Alpha]=\[CapitalDelta]Aa*)
(*\[CapitalDelta]\[Xi]=Expand[Simplify[\[CapitalDelta]Bb/.{Cc->\[Zeta],Aa->\[Alpha],Bb->-\[Eta],\[Omega]->2\[Omega]+2,\[CapitalLambda]->Subscript[\[CapitalLambda], C]}/.\[Eta]->(\[Xi]-\[Alpha])/3]]*)
(*\[CapitalDelta]\[Zeta]=Expand[Simplify[\[CapitalDelta]Cc/.{Cc->\[Zeta],Aa->\[Alpha],Bb->-\[Eta],\[Omega]->2\[Omega]+2,\[CapitalLambda]->Subscript[\[CapitalLambda], C]}/.\[Eta]->(\[Xi]-\[Alpha])/3/.{AA->-((-AA-3/(2\[Alpha] \[Lambda])-1/(8\[Alpha] \[Lambda] \[Omega]^2)+3/(8\[Xi] \[Omega]^2)+3/(2\[Xi] \[Omega]))/(16\[Pi]^2\[Epsilon]))}]]*)
(*Subscript[\[CapitalDelta]\[CapitalLambda], C]=Expand[Simplify[\[CapitalDelta]\[CapitalLambda]/.{Cc->\[Zeta],Aa->\[Alpha],Bb->-\[Eta],\[Omega]->2\[Omega]+2,\[CapitalLambda]->Subscript[\[CapitalLambda], C]}/.\[Eta]->(\[Xi]-\[Alpha])/3/.{AA->-((-AA-3/(2\[Alpha] \[Lambda])-1/(8\[Alpha] \[Lambda] \[Omega]^2)+3/(8\[Xi] \[Omega]^2)+3/(2\[Xi] \[Omega]))/(16\[Pi]^2\[Epsilon]))}]]*)
(*(*To obtain the beta functions multiply by -2\[Kappa]^2/(4\[Pi])^2 these results*)*)


(* ::Input:: *)
(*(*Gauge independent quantities, i.e. independent on A*)*)
(*Simplify[\[Zeta] Subscript[\[CapitalDelta]\[CapitalLambda], C]-2Subscript[\[CapitalLambda], C] \[CapitalDelta]\[Zeta]]*)