(* ::Package:: *)

(* ::Input:: *)
(**)
(*(*ABSORPTIVE PART*)*)


(* ::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]:=0*)
(*\[Lambda]:=1*)


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


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


(* ::Input:: *)
(*F[m_]:=2/\[Pi] ((1+(-1)^m) Sqrt[\[Pi]] Gamma[(1+m)/2])/(4 Gamma[2+m/2])*)
(*F0[m_]:=p2^(m/2)q2^(m/2)F[m]*)
(*F1[m_,\[Mu]_]:=p2^((m+1)/2-1)q2^((m+1)/2)F[m+1]p[\[Mu]]*)
(*F2[m_,\[Mu]_,\[Nu]_]:=Expand[p2^((m+2)/2-2)q2^((m+2)/2) F[m+2]/(m+1) (p2 \[Eta][\[Mu],\[Nu]]+m p[\[Mu]]p[\[Nu]])]*)
(*F3[m_,\[Mu]_,\[Nu]_,\[Rho]_]:=Expand[p2^((m+3)/2-3)q2^((m+3)/2) F[m+3]/(m+2) (p2 (p[\[Rho]] \[Eta][\[Mu],\[Nu]]+p[\[Mu]] \[Eta][\[Rho],\[Nu]]+p[\[Nu]] \[Eta][\[Mu],\[Rho]])+(m-1)p[\[Mu]]p[\[Nu]]p[\[Rho]])]*)
(*F4[m_,r_,s_,t_,u_]:=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:: *)
(*(*Symmetric tensors built with \[Eta] and external momentum p, times monomials in the integrated momentum q*)*)
(**)


(* ::Input:: *)
(*D6[m_,n_,r_,s_]:=1/64 q2^5 p2 p[m] p[n] p[r] p[s]+1/256 q2^5 p2^2 p[r] p[s] \[Eta][m,n]+1/256 q2^5 p2^2 p[n] p[s] \[Eta][m,r]+1/256 q2^5 p2^2 p[n] p[r] \[Eta][m,s]+1/256 q2^5 p2^2 p[m] p[s] \[Eta][n,r]+(q2^5 p2^3 \[Eta][m,s] \[Eta][n,r])/1536+1/256 q2^5 p2^2 p[m] p[r] \[Eta][n,s]+(q2^5 p2^3 \[Eta][m,r] \[Eta][n,s])/1536+1/256 q2^5 p2^2 p[m] p[n] \[Eta][r,s]+(q2^5 p2^3 \[Eta][m,n] \[Eta][r,s])/1536*)
(*A4[m_,n_,r_,s_]:=1/80 q2^4 p[m] p[n] p[r] p[s]+1/160 q2^4 p2 p[r] p[s] \[Eta][m,n]+1/160 q2^4 p2 p[n] p[s] \[Eta][m,r]+1/160 q2^4 p2 p[n] p[r] \[Eta][m,s]+1/160 q2^4 p2 p[m] p[s] \[Eta][n,r]+1/640 q2^4 p2^2 \[Eta][m,s] \[Eta][n,r]+1/160 q2^4 p2 p[m] p[r] \[Eta][n,s]+1/640 q2^4 p2^2 \[Eta][m,r] \[Eta][n,s]+1/160 q2^4 p2 p[m] p[n] \[Eta][r,s]+1/640 q2^4 p2^2 \[Eta][m,n] \[Eta][r,s]*)
(*A5[m_,n_,r_]:=1/32 q2^4 p2 p[m] p[n] p[r]+1/128 q2^4 p2^2 p[r] \[Eta][m,n]+1/128 q2^4 p2^2 p[n] \[Eta][m,r]+1/128 q2^4 p2^2 p[m] \[Eta][n,r]*)
(*A6[m_,n_]:=3/64 q2^4 p2^2 p[m] p[n]+1/128 q2^4 p2^3 \[Eta][m,n]*)
(*A7[m_]:=7/128 q2^4 p2^3 p[m]*)
(*A8:=(7 p2^4 q2^4)/128;*)
(*B2[m_,n_,r_,s_]:=1/96 q2^3 p[r] p[s] \[Eta][m,n]+1/96 q2^3 p[n] p[s] \[Eta][m,r]+1/96 q2^3 p[n] p[r] \[Eta][m,s]+1/96 q2^3 p[m] p[s] \[Eta][n,r]+1/192 q2^3 p2 \[Eta][m,s] \[Eta][n,r]+1/96 q2^3 p[m] p[r] \[Eta][n,s]+1/192 q2^3 p2 \[Eta][m,r] \[Eta][n,s]+1/96 q2^3 p[m] p[n] \[Eta][r,s]+1/192 q2^3 p2 \[Eta][m,n] \[Eta][r,s]*)
(*B3[m_,n_,r_]:=1/32 q2^3 p[m] p[n] p[r]+1/64 q2^3 p2 p[r] \[Eta][m,n]+1/64 q2^3 p2 p[n] \[Eta][m,r]+1/64 q2^3 p2 p[m] \[Eta][n,r]*)
(*B4[m_,n_]:=1/16 q2^3 p2 p[m] p[n]+1/64 q2^3 p2^2 \[Eta][m,n]*)
(*B5[m_]:=5/64 q2^3 p2^2 p[m]*)
(*B6:=(5 q2^3 p2^3)/64;*)
(*C0[m_,n_,r_,s_]:=1/24 q2^2 \[Eta][m,s] \[Eta][n,r]+1/24 q2^2 \[Eta][m,r] \[Eta][n,s]+1/24 q2^2 \[Eta][m,n] \[Eta][r,s]*)
(*C1[m_,n_,r_]:=1/24 q2^2 p[r] \[Eta][m,n]+1/24 q2^2 p[n] \[Eta][m,r]+1/24 q2^2 p[m] \[Eta][n,r]*)
(*C2[m_,n_]:=1/12 q2^2 p[m] p[n]+1/24 q2^2 p2 \[Eta][m,n]*)
(*C3[m_]:=1/8 q2^2 p2 p[m]*)
(*C4:=(q2^2 p2^2)/8;*)


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


(* ::Input:: *)
(*r1410=q[m_]q[n_]q[r_]q[s_]pq^10:>F4[10,m,n,r,s];*)
(*r1411=q[m_]q[n_]q[r_]pq^11:>F3[11,m,n,r];*)
(*r1412=q[m_]q[n_]pq^12:>F2[12,m,n];*)
(*r1413=q[m_]pq^13:>F1[13,m];*)
(*r1414=pq^14:>F0[14];*)
(*r128=q[m_]q[n_]q[r_]q[s_]pq^8:>F4[8,m,n,r,s];*)
(*r129=q[m_]q[n_]q[r_]pq^9:>F3[9,m,n,r];*)
(*r1210=q[m_]q[n_]pq^10:>F2[10,m,n];*)
(*r1211=q[m_]pq^11:>F1[11,m];*)
(*r1212=pq^12:>F0[12];*)
(*r106=q[m_]q[n_]q[r_]q[s_]pq^6:>F4[6,m,n,r,s];*)
(*r107=q[m_]q[n_]q[r_]pq^7:>F3[7,m,n,r];*)
(*r108=q[m_]q[n_]pq^8:>F2[8,m,n];*)
(*r109=q[m_]pq^9:>F1[9,m];*)
(*r1010=pq^10:>F0[10];*)
(*ra4=q[m_]q[n_]q[r_]q[s_]pq^4:>A4[m,n,r,s];*)
(*ra5=q[m_]q[n_]q[r_]pq^5:>A5[m,n,r];*)
(*ra6=q[m_]q[n_]pq^6:>A6[m,n];*)
(*ra7=q[m_]pq^7:>A7[m];*)
(*ra8=pq^8:>A8;*)
(*rb2=q[m_]q[n_]q[r_]q[s_]pq^2:>B2[m,n,r,s];*)
(*rb3=q[m_]q[n_]q[r_]pq^3:>B3[m,n,r];*)
(*rb4=q[m_]q[n_]pq^4:>B4[m,n];*)
(*rb5=q[m_]pq^5:>B5[m];*)
(*rb6=pq^6:>B6;*)
(*rc=q[m_]q[n_]q[r_]q[s_]:>C0[m,n,r,s];*)
(*rc1=q[m_]q[n_]q[r_]pq:>C1[m,n,r];*)
(*rc2=q[m_]q[n_]pq^2:>C2[m,n];*)
(*rc3=q[m_]pq^3:>C3[m];*)
(*rc4=pq^4:>C4;*)
(*r0=q[m_]q[n_]:>(q2/4)\[Eta][m,n];*)
(*r1=q[m_]pq:>(q2/4)p[m];*)
(*r2=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:: *)
(*(*VERTICES IN THE EUCLIDEAN*)*)


(* ::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 graviton 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:: *)
(*(*Expansion of denominators in powers of Aa and Bb*)*)


(* ::Input:: *)
(*DS01[p2_,n_]:=Simplify[Normal[Series[D01[p2]/.{Aa->u Aa,Bb->u Bb},{u,0,n}]]/.u->1]*)
(*DS02[p2_,n_]:=Simplify[Normal[Series[D02[p2]/.{Aa->u Aa,Bb->u Bb},{u,0,n}]]/.u->1]*)
(*DS2[p2_,n_]:=Simplify[Normal[Series[D2[p2]/.{Aa->u Aa,Bb->u Bb},{u,0,n}]]/.u->1]*)
(*DS4[p2_,n_]:=Simplify[Normal[Series[D4[p2]/.{Aa->u Aa,Bb->u Bb},{u,0,n}]]/.u->1]*)
(**)


(* ::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:: *)
(*(*BUBBLE DIAGRAM*)*)


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


(* ::Input::Closed:: *)
(*(*Diagram evaluation, only numerators. External gravitons indices and momenta (\[Mu],\[Nu],p) and (\[Rho],\[Sigma],-p)*)*)


(* ::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]]]];*)
(**)


(* ::Input::Closed:: *)
(*(*Complete diagram and UV expansion*)*)


(* ::Input:: *)
(*Expand[1/2 (d30101 DS01[k2-2pk+p2,0]DS01[k2,0])]/.{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 DS01[k2-2pk+p2,0]DS02[k2,0])]/.{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 DS02[k2-2pk+p2,0]DS02[k2,0])]/.{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 DS01[k2-2pk+p2,0]DS2[k2,1])]/.{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 DS02[k2-2pk+p2,0]DS2[k2,1])]/.{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 DS2[k2-2pk+p2,1]DS2[k2,1])]/.{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 DS01[k2-2pk+p2,0]DS4[k2,2])]/.{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 DS02[k2-2pk+p2,0]DS4[k2,2])]/.{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 DS2[k2-2pk+p2,1]DS4[k2,2])]/.{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 DS4[k2-2pk+p2,2]DS4[k2,2])]/.{k2->q2/y^2,pk->pq/y,k[m_]->q[m]/y};*)
(**)
(*D344=Expand[Simplify[Coefficient[Normal[Series[%,{y,0,4}]],y,4]]];*)


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


(* ::Input:: *)
(*(*Diagram evaluation, UV expansion, external graviton indices and momenta: (\[Mu],\[Nu],p) and (\[Rho],\[Sigma],-p)*)*)
(*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:: *)
(*(*Complete Bubble diagram*)*)


(* ::Input:: *)
(*DivS=Expand[Simplify[D30101+2D30102+D30202+2D3012+2D3022+D322+2D3014+2D3024+2D324+D344+Dgh]];*)


(* ::Input::Closed:: *)
(*(*Symmetric integration and absoptive part*)*)


(* ::Input:: *)
(*Expand[Simplify[Expand[DivS]]];*)
(*Expand[%/.{r1410,r1411,r1412,r1413,r1414}];*)
(*Expand[%/.{r128,r129,r1210,r1211,r1212}];*)
(*Expand[%/.{r106,r107,r108,r109,r1010}];*)
(*Expand[%/.{ra4,ra5,ra6,ra7,ra8}];*)
(*Expand[%/.{rb2,rb3,rb4,rb5,rb6}];*)
(*Expand[%/.{rc,rc1,rc2,rc3,rc4}];*)
(*Expand[%/.{r0,r1,r2}];*)
(*ris=Expand[%/.{1/q2^2->(-I \[Pi])/(4 Pi)^2}];*)


(* ::Input::Closed:: *)
(*(*Result 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:: *)
(*(*FIELD REDEFINITIONS AND TERMS PROPORTIONAL TO THE EQUATIONS OF MOTION*)*)


(* ::Input::Closed:: *)
(*(*Field redefinitions*)*)


(* ::Input:: *)
(*deltaG[m_,n_,r_,s_,p_]:=I \[Pi]/2 (aa/2 (\[Eta][m,r]\[Eta][n,s]+\[Eta][m,s]\[Eta][n,r])+bb \[Eta][m,n]\[Eta][r,s]+cc p[m]p[n]\[Eta][r,s]+dd p[r]p[s]\[Eta][m,n]+ee/2 (p[m]p[r]\[Eta][n,s]+p[m]p[s]\[Eta][n,r])+ff p[m]p[n]p[r]p[s])*)


(* ::Input::Closed:: *)
(*(*Linearized equations of motion*)*)


(* ::Input:: *)
(*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]))/.{f1[x_,y_]:>1/2 (\[Eta][x,r]\[Eta][y,s]+\[Eta][x,s]\[Eta][y,r])}]*)


(* ::Input::Closed:: *)
(*(*Lagrangian terms proportional to the equations of motion in terms of spin-2 projectors*)*)


(* ::Input:: *)
(*CT=ExpandAll[EE1[m,n,\[Mu],\[Nu],p,p2,a,b]deltaG[m,n,\[Rho],\[Sigma],-p]+EE1[m,n,\[Rho],\[Sigma],-p,p2,a,b]deltaG[m,n,\[Mu],\[Nu],p]];*)
(*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]]}];*)
(*CTT=Expand[%/.{\[Eta][\[Mu],\[Nu]]p[\[Rho]]p[\[Sigma]]->p2 PPP0+2 p2 PP0-\[Eta][\[Rho],\[Sigma]]p[\[Mu]]p[\[Nu]]}]*)


(* ::Input::Closed:: *)
(*(*Total*)*)


(* ::Input:: *)
(*Tot=Simplify[Expand[Ris+CTT]];*)


(* ::Input::Closed:: *)
(*(*RESULTS*)*)


(* ::Input::Closed:: *)
(*(*Equations in the functions aa, bb and dd in order to absorb the result Ris*)*)


(* ::Input:: *)
(*sol=Simplify[Solve[Coefficient[Tot,P0]==0&&Coefficient[Tot,P2]==0&&Coefficient[Tot,PPP0]==0,{aa,bb,dd}]]*)


(* ::Input::Closed:: *)
(*(*Functions aa,bb and dd in the case \[Omega]=1*)*)


(* ::Input:: *)
(*ssol=Simplify[sol/.\[Omega]->1]*)


(* ::Input::Closed:: *)
(*(*Functions aa, bb and dd, paper notation*)*)


(* ::Input:: *)
(*a1=Simplify[(-2/p2 aa/.sol[[1]])/.{Cc->\[Zeta],Aa->\[Alpha],Bb->-\[Eta],\[Omega]->2\[Omega]+2}/.\[Eta]->(\[Xi]-\[Alpha])/3]*)
(*a2=Simplify[(-4/p2 bb/.sol[[1]])/.{Cc->\[Zeta],Aa->\[Alpha],Bb->-\[Eta],\[Omega]->2\[Omega]+2}/.\[Eta]->(\[Xi]-\[Alpha])/3]*)
(*a3=Simplify[(-4dd/.sol[[1]])/.{Cc->\[Zeta],Aa->\[Alpha],Bb->-\[Eta],\[Omega]->2\[Omega]+2}/.\[Eta]->(\[Xi]-\[Alpha])/3]*)


(* ::Input::Closed:: *)
(*(*Functions aa, bb and dd, paper notation, case \[Omega]=-1/2*)*)


(* ::Input:: *)
(*aa1=Simplify[a1/.\[Omega]->-1/2]*)
(*aa2=Simplify[a2/.\[Omega]->-1/2]*)
(*aa3=Simplify[a3/.\[Omega]->-1/2]*)