(* ::Package:: *) (* ::Input:: *) (*(* The ultraviolet behavior of quantum gravity - One-loop renormalization *)*) (* ::Input:: *) (*(* Beta functions *)*) (* ::Input:: *) (*(** A - Definitions and general rules **)*) (* ::Input:: *) (*(*** A.1 - Definitions ***)*) (* ::Input:: *) (*SetAttributes[delta,Orderless]*) (*SetAttributes[h,Orderless]*) (*Unprotect[Power,Times,Plus,Integer];*) (*delta[mu_,nu_]^2:=4*) (*delta[mu_,mu_]:=4*) (*delta[mu_,nu_]A_[B___,mu_,Cc___]:=A[B,nu,Cc]*) (*delta[mu_,nu_]A_[B___,mu_,Cc___][Dd___]:=A[B,nu,Cc][Dd]*) (*delta[mu_,nu_]A_[B___][Dd___,mu_,Cc___]:=A[B][Dd,nu,Cc]*) (*p[mu_]^2:=p2*) (*q[mu_]^2:=q2*) (*k[a_]^2:=k2*) (*p[mu_]q[mu_]:=pq*) (*p[a_]k[a_]:=pk*) (*q[a_]k[a_]:=qk*) (*kappa^m_:=0/;m>4*) (*(a_+b_)[c_]:=a[c]+b[c]*) (*(-a_)[b_]:=-a[b]*) (*h[a_,b_][A___,c_,d_,B___]:=h[a,b][A,d,c,B]/;Sort[{c,d}]=!={c,d}*) (*Der[h[a_,b_][A___],m_]:=h[a,b][A,m]*) (*Der[A_+B_,m_]:=Der[A,m]+Der[B,m]*) (*Der[A_ B_,m_]:=Der[A,m]B+A Der[B,m]*) (*Der[A_^n_,m_]:=n Der[A,m]A^(n-1)*) (*Der[A_,m_]:=0/;NumberQ[A]=!=False*) (*Der[A_,m_]:=0/;A==kappa||A==Pi*) (*Der[delta[m_,n_],r_]:=0*) (*ginv[m_,n_,a_,b_]=ExpandAll[delta[m,n]-2 kappa h[m,n][]+4kappa^2 h[m,a][]h[a,n][]-8 kappa^3 h[m,a][]h[a,b][]h[b,n][]];*) (* ::Input:: *) (*sqrtg[a_,b_,c_]=ExpandAll[1+h[a,a][]kappa+((h[a,a][]h[b,b][])/2-h[a,b][]h[b,a][]) kappa^2+1/6 (h[a,a][]h[b,b][]h[c,c][]-6 h[a,a][] h[b,c][]h[c,b][]+8 h[a,b][]h[b,c][]h[c,a][]) kappa^3+1/24 (h[a,a][]h[b,b][]h[c,c][]h[d,d][]-12 h[a,a][]h[b,b][] h[c,d][]h[d,c][]+12 h[a,b][]h[b,a][] h[c,d][]h[d,c][]+32 h[a,b][]h[b,c][]h[c,a][]h[d,d][]-48 h[a,b][]h[b,c][]h[c,d][]h[d,a][]) kappa^4];*) (*Gammat[m_,n_,r_]=ExpandAll[kappa (h[n,r][m]+h[m,r][n]-h[m,n][r])];*) (*Riem[m_,n_,r_,s_,a_,b_,c_,d_]=ExpandAll[kappa (h[m,s][n,r]-h[n,s][m,r]+h[n,r][m,s]-h[m,r][n,s])+ginv[a,b,c,d]Gammat[m,s,a]Gammat[n,r,b]-ginv[a,b,c,d]Gammat[m,r,a]Gammat[n,s,b]];*) (*Ric[m_,n_,a_,b_,c_,d_,e_,f_,g_,i_]=ExpandAll[Riem[m,a,n,b,e,f,g,i]ginv[a,b,c,d]];*) (*CDRic[m_,n_,t_,a_,b_,c_,d_,e1_,e2_,e3_,e4_,e5_,e6_,e7_,e8_]=ExpandAll[Der[Ric[m,n,e1,e2,e3,e4,e5,e6,e7,e8],t]-Gammat[m,t,a]ginv[a,b,c,d]Ric[b,n,e1,e2,e3,e4,e5,e6,e7,e8]-Gammat[n,t,a]ginv[a,b,c,d]Ric[m,b,e1,e2,e3,e4,e5,e6,e7,e8]];*) (* ::Input:: *) (*(*** A.2 - Symmetric integration rules ***)*) (* ::Input:: *) (*rul1=p[a_] :>0;*) (*rul2=p[a_] p[b_] :>p2/4 delta[a,b];*) (*rul3=p[a_] p[b_] p[c_]:>0;*) (*delta4[a_,b_,c_,d_]:=delta[a,b] delta[c,d]+delta[a,c] delta[b,d]+delta[a,d] delta[b,c];*) (*rul4=p[a_] p[b_] p[c_] p[d_]:>p2^2/24 delta4[a,b,c,d];*) (*rul5=p[a_] p[b_] p[c_] p[d_]p[e_]:>0;*) (*delta6[a_,b_,c_,d_,e_,f_]=Expand[delta[a,b] delta4[c,d,e,f]+delta[a,c] delta4[b,d,e,f]+delta[a,d] delta4[c,b,e,f]+delta[a,e] delta4[c,d,b,f]+delta[a,f] delta4[c,d,e,b]];*) (*rul6=p[a_] p[b_] p[c_] p[d_]p[e_]p[f_]:>p2^3/192 delta6[a,b,c,d,e,f];*) (*rul7=p[a_] p[b_] p[c_] p[d_]p[e_]p[f_]p[g_]:>0;*) (*delta8[a_,b_,c_,d_,e_,f_,g_,h_]=Expand[delta[a,b] delta6[c,d,e,f,g,h]+delta[a,c] delta6[b,d,e,f,g,h]+delta[a,d] delta6[c,b,e,f,g,h]+delta[a,e] delta6[c,d,b,f,g,h]+delta[a,f] delta6[c,d,e,b,g,h]+delta[a,g] delta6[c,d,e,f,b,h]+delta[a,h] delta6[c,d,e,f,g,b]];*) (*rul8=p[a_] p[b_] p[c_] p[d_]p[e_]p[f_]p[g_]p[h_]:>p2^4/1920 delta8[a,b,c,d,e,f,g,h];*) (*r44=pk^4 p[a_]p[b_]p[c_]p[d_]:>1/640 p2^4 (k2^2 delta[a,b] delta[c,d]+4 k2 delta[c,d] k[a] k[b]+4 k2 delta[b,d] k[a] k[c]+k2 delta[a,d] (k2 delta[b,c]+4 k[b] k[c])+4 k2 delta[b,c] k[a] k[d]+4 k2 delta[a,b] k[c] k[d]+8 k[a] k[b] k[c] k[d]+k2 delta[a,c] (k2 delta[b,d]+4 k[b] k[d]));*) (*r43=pk^4 p[a_]p[b_]p[c_]:>0;*) (*r42=pk^4 p[a_]p[b_]:>1/64 k2 p2^3 (k2 delta[a,b]+4 k[a] k[b]);*) (*r41=pk^4 p[a_]:>0;*) (*r40=pk^4:>(k2^2 p2^2)/8;*) (*r34=pk^3 p[a_]p[b_]p[c_]p[d_]:>0;*) (*r33=pk^3 p[a_]p[b_]p[c_]:>1/64 p2^3 (k2 delta[b,c] k[a]+k2 delta[a,c]k[b]+(k2 delta[a,b]+2 k[a]k[b]) k[c]);*) (*r32=pk^3 p[a_]p[b_]:>0;*) (*r31=pk^3 p[a_]:>1/8 k2 p2^2 k[a];*) (*r30=pk^3:>0;*) (*r24=pk^2 p[a_]p[b_]p[c_]p[d_]:>1/192 p2^3 (k2 delta[a,b] delta[c,d]+2 delta[c,d] k[a] k[b]+2 delta[b,d] k[a] k[c]+delta[a,d] (k2 delta[b,c]+2 k[b] k[c])+2 delta[b,c] k[a] k[d]+2 delta[a,b] k[c] k[d]+delta[a,c] (k2 delta[b,d]+2 k[b] k[d]));*) (*r23=pk^2 p[a_]p[b_]p[c_]:>0;*) (*r22=pk^2 p[a_]p[b_]:>1/24 p2^2 (k2 delta[a,b]+2 k[a] k[b]);*) (*r21=pk^2 p[a_]:>0;*) (*r20=pk^2:>(k2 p2)/4;*) (*r14=pk p[a_]p[b_]p[c_]p[d_]:>0;*) (*r13=pk p[a_]p[b_]p[c_]:>1/24 p2^2 (delta[b,c] k[a]+delta[a,c] k[b]+delta[a,b] k[c]);*) (*r12=pk p[a_]p[b_]:>0;*) (*r11=pk p[a_]:>1/4 p2 k[a];*) (*r10=pk:>0;*) (*r04=rul4;*) (*r03=rul3;*) (*r02=rul2;*) (*r01=rul1;*) (* ::Input:: *) (*(*** A.3 - Lagrangian invariants ***)*) (* ::Input:: *) (*Ic=ExpandAll[sqrtg[vv1,vv2,vv3]];*) (*Ic=Expand[2I kappa^2 Coefficient[Ic,kappa,2]];*) (*Ic/.{A___ h[a_,b_][]:>A delta[a,zp]delta[b,wp],A___ h[a_,b_][m_]:>-I A p[m]delta[a,zp]delta[b,wp],A___ h[a_,b_][m_,n_]:>- A p[m]p[n] delta[a,zp]delta[b,wp],h[a_,b_][]^2:>h[a,b][] delta[a,zp]delta[b,wp],h[a_,b_][m_]^2:>-I h[a,b][m] p[m]delta[a,zp]delta[b,wp],h[a_,b_][m_,n_]^2:>- h[a,b][m,n] p[m]p[n] delta[a,zp]delta[b,wp]};*) (*%/.{h[a_,b_][]:>delta[a,zq]delta[b,wq],h[a_,b_][m_]:>-I q[m]delta[a,zq]delta[b,wq],h[a_,b_][m_,n_]:>- q[m]q[n] delta[a,zq]delta[b,wq]};*) (*InvC0[zp_,wp_,zq_,wq_,p_,q_,p2_,q2_,pq_]=Expand[%];*) (*InvCa[m_,n_,r_,s_,p_,p2_]=Expand[InvC0[m,n,r,s,p,-p,p2,p2,-p2]];*) (*InvCb[m_,n_,r_,s_,p_,p2_]=Expand[1/2(InvCa[m,n,r,s,p,p2]+InvCa[n,m,r,s,p,p2])];*) (*InvCc[m_,n_,r_,s_,p_,p2_]=Expand[1/2(InvCb[m,n,r,s,p,p2]+InvCb[m,n,s,r,p,p2])];*) (*InvC[m_,n_,r_,s_,p_,p2_]=Expand[1/2(InvCc[m,n,r,s,p,p2]+InvCc[s,r,m,n,-p,p2])];*) (*I0=ExpandAll[sqrtg[vv1,vv2,vv3]ginv[n,r,n2,n3]Ric[n,r,c1,c2,c3,c4,c5,c6,c7,c8]];*) (*I0=Expand[2I kappa^2 Coefficient[I0,kappa,2]];*) (*I0/.{A___ h[a_,b_][]:>A delta[a,zp]delta[b,wp],A___ h[a_,b_][m_]:>-I A p[m]delta[a,zp]delta[b,wp],A___ h[a_,b_][m_,n_]:>- A p[m]p[n] delta[a,zp]delta[b,wp],h[a_,b_][]^2:>h[a,b][] delta[a,zp]delta[b,wp],h[a_,b_][m_]^2:>-I h[a,b][m] p[m]delta[a,zp]delta[b,wp],h[a_,b_][m_,n_]^2:>- h[a,b][m,n] p[m]p[n] delta[a,zp]delta[b,wp]};*) (*%/.{h[a_,b_][]:>delta[a,zq]delta[b,wq],h[a_,b_][m_]:>-I q[m]delta[a,zq]delta[b,wq],h[a_,b_][m_,n_]:>- q[m]q[n] delta[a,zq]delta[b,wq]};*) (*Inv0[zp_,wp_,zq_,wq_,p_,q_,p2_,q2_,pq_]=Expand[%];*) (*Inv0a[m_,n_,r_,s_,p_,p2_]=Expand[Inv0[m,n,r,s,p,-p,p2,p2,-p2]];*) (*Inv0b[m_,n_,r_,s_,p_,p2_]=Expand[1/2(Inv0a[m,n,r,s,p,p2]+Inv0a[n,m,r,s,p,p2])];*) (*Inv0c[m_,n_,r_,s_,p_,p2_]=Expand[1/2(Inv0b[m,n,r,s,p,p2]+Inv0b[m,n,s,r,p,p2])];*) (*InvR[m_,n_,r_,s_,p_,p2_]=Expand[1/2(Inv0c[m,n,r,s,p,p2]+Inv0c[s,r,m,n,-p,p2])];*) (*I1=ExpandAll[sqrtg[vv1,vv2,vv3]ginv[m,n1,m2,m3]ginv[n,r,n2,n3]Ric[m,n,bp1,bp2,bp3,b4,b5,b6,b7,b8]Ric[n1,r,c1,c2,c3,c4,c5,c6,c7,c8]];*) (*I1=Expand[2 I kappa^2Coefficient[I1,kappa,2]];*) (*I1/.{A___ h[a_,b_][]:>A delta[a,zp]delta[b,wp],A___ h[a_,b_][m_]:>- I A p[m]delta[a,zp]delta[b,wp],A___ h[a_,b_][m_,n_]:>- A p[m]p[n] delta[a,zp]delta[b,wp],h[a_,b_][]^2:>h[a,b][] delta[a,zp]delta[b,wp],h[a_,b_][m_]^2:>- I h[a,b][m] p[m]delta[a,zp]delta[b,wp],h[a_,b_][m_,n_]^2:>- h[a,b][m,n] p[m]p[n] delta[a,zp]delta[b,wp]};*) (*%/.{h[a_,b_][]:>delta[a,zq]delta[b,wq],h[a_,b_][m_]:>- I q[m]delta[a,zq]delta[b,wq],h[a_,b_][m_,n_]:>- q[m]q[n] delta[a,zq]delta[b,wq]};*) (*Inv1[zp_,wp_,zq_,wq_,p_,q_,p2_,q2_,pq_]=Expand[%];*) (*Inv1a[m_,n_,r_,s_,p_,p2_]=Expand[Inv1[m,n,r,s,p,-p,p2,p2,-p2]];*) (*Inv1b[m_,n_,r_,s_,p_,p2_]=Expand[1/2(Inv1a[m,n,r,s,p,p2]+Inv1a[n,m,r,s,p,p2])];*) (*Inv1c[m_,n_,r_,s_,p_,p2_]=Expand[1/2(Inv1b[m,n,r,s,p,p2]+Inv1b[m,n,s,r,p,p2])];*) (*InvRic2[m_,n_,r_,s_,p_,p2_]=Expand[1/2(Inv1c[m,n,r,s,p,p2]+Inv1c[s,r,m,n,-p,p2])];*) (*I2=ExpandAll[sqrtg[vv1,vv2,vv3]ginv[m,n,m2,m3]ginv[n1,r,n2,n3]Ric[m,n,bp1,bp2,bp3,b4,b5,b6,b7,b8]Ric[n1,r,c1,c2,c3,c4,c5,c6,c7,c8]];*) (*I2=Expand[2 I kappa^2Coefficient[I2,kappa,2]];*) (*I2/.{A___ h[a_,b_][]:>A delta[a,zp]delta[b,wp],A___ h[a_,b_][m_]:>- I A p[m]delta[a,zp]delta[b,wp],A___ h[a_,b_][m_,n_]:>- A p[m]p[n] delta[a,zp]delta[b,wp],h[a_,b_][]^2:>h[a,b][] delta[a,zp]delta[b,wp],h[a_,b_][m_]^2:>- I h[a,b][m] p[m]delta[a,zp]delta[b,wp],h[a_,b_][m_,n_]^2:>- h[a,b][m,n] p[m]p[n] delta[a,zp]delta[b,wp]};*) (*%/.{h[a_,b_][]:>delta[a,zq]delta[b,wq],h[a_,b_][m_]:>- I q[m]delta[a,zq]delta[b,wq],h[a_,b_][m_,n_]:>- q[m]q[n] delta[a,zq]delta[b,wq]};*) (*Inv2[zp_,wp_,zq_,wq_,p_,q_,p2_,q2_,pq_]=Expand[%];*) (*Inv2a[m_,n_,r_,s_,p_,p2_]=Expand[Inv2[m,n,r,s,p,-p,p2,p2,-p2]];*) (*Inv2b[m_,n_,r_,s_,p_,p2_]=Expand[1/2(Inv2a[m,n,r,s,p,p2]+Inv2a[n,m,r,s,p,p2])];*) (*Inv2c[m_,n_,r_,s_,p_,p2_]=Expand[1/2(Inv2b[m,n,r,s,p,p2]+Inv2b[m,n,s,r,p,p2])];*) (*InvR2[m_,n_,r_,s_,p_,p2_]=Expand[1/2(Inv2c[m,n,r,s,p,p2]+Inv2c[s,r,m,n,-p,p2])];*) (* ::Input:: *) (*(*** A.4 - Lagrangian ***)*) (* ::Input:: *) (*Lagra1kappa2=ExpandAll[-1/2 2 LamC sqrtg[a1,a2,a3]-zeta/2 sqrtg[a1,a2,a3] ginv[m,n,a4,a5]Ric[m,n,b1,b2,b3,b4,b5,b6,b7,b8]]+xi/12 sqrtg[vv1,vv2,vv3]ginv[m,n,m2,m3]ginv[n1,r,n2,n3]Ric[m,n,b1,b2,b3,b4,b5,b6,b7,b8]Ric[n1,r,c1,c2,c3,c4,c5,c6,c7,c8];*) (* ::Input:: *) (*Lagra2gkappa2=Expand[-alpha/2sqrtg[a1,a2,a3] ginv[m,r,a6,a7]ginv[n,s,a8,a9]*) (*(Ric[m,n,b1,b2,b3,b4,b5,b6,b7,b8]Ric[r,s,c1,c2,c3,c4,c5,c6,c7,c8]-1/3Ric[m,r,b1,b2,b3,b4,b5,b6,b7,b8]Ric[n,s,c1,c2,c3,c4,c5,c6,c7,c8])];*) (*Lagra2gkappa2=ExpandAll[Lagra2gkappa2];*) (* ::Input:: *) (*Lagra1=Expand[Lagra1kappa2/kappa^2];*) (*Lagra2g=Expand[Lagra2gkappa2/kappa^2];*) (* ::Input:: *) (*(** B - Vertices and propagators **)*) (* ::Input:: *) (*(*** B.1 - Ghost propagator and vertices ***)*) (* ::Input:: *) (*pgh[m_,n_,p_,p2_]:=-I/p2(delta[m,n]-(1+1/(2 omega))p[m]p[n]/p2)*) (*Lgh=Expand[-2 kappa (I (p[n]+k[n])Cbar[m]-(omega+1) delta[m,n]I (p[r]+k[r])Cbar[r])(-I p[m]h[s,n][]-I p[n] h[s,m][]-I k[s] h[m,n][])C[s] ];*) (*Lgh/.{Cbar[m_]:>delta[m,a]};*) (*%/.{C[m_]:>delta[m,b]};*) (*%/.{A___ h[a_,b_][]:>A delta[a,zk]delta[b,wk],A___ h[a_,b_][m_]:>-I A k[m]delta[a,zk]delta[b,wk]};*) (*V3gh1[a_,zk_,wk_,b_,k_,p_,k2_,p2_,pk_]=Expand[I %];*) (*V3gh[a_,m_,n_,b_,k_,p_,k2_,p2_,pk_]=Expand[1/2(V3gh1[a,m,n,b,k,p,k2,p2,pk]+V3gh1[a,n,m,b,k,p,k2,p2,pk])];*) (*(* In V3gh[a,m,n,b,k,p,k2,p2,pk], a is the index of the antighost leg, m and n are the indices of the graviton leg, b is the index of the ghost leg. Moreover, k is the incoming momentum of the graviton leg, p is the incoming momentum of the ghost leg *)*) (* ::Input:: *) (*(*** B.2 - Graviton propagator ***)*) (* ::Input:: *) (*Lgf=Expand[Lagra1+Lagra2g+ lamb (h[m,n][n]-(omega+1) h[n,n][m])(h[m,r][r]-(omega+1) h[r,r][m])];*) (* ::Input:: *) (*Q2=Coefficient[Lgf,kappa,0];*) (*Q2=Q2/.{A___ h[a_,b_][]:>A delta[a,zp]delta[b,wp],A___ h[a_,b_][m_]:>- I A p[m]delta[a,zp]delta[b,wp],A___ h[a_,b_][m_,n_]:>- A p[m]p[n] delta[a,zp]delta[b,wp],A___ h[a_,b_][m_,n_,r_]:>I A p[m]p[n] p[r] delta[a,zp]delta[b,wp],h[a_,b_][]^2:>h[a,b][] delta[a,zp]delta[b,wp],h[a_,b_][m_]^2:>- I h[a,b][m] p[m]delta[a,zp]delta[b,wp],h[a_,b_][m_,n_]^2:>- h[a,b][m,n] p[m]p[n] delta[a,zp]delta[b,wp], h[a_,b_][m_,n_,r_]^2:>I h[a,b][m,n,r] p[m]p[n] p[r] delta[a,zp]delta[b,wp]};*) (*Q2=Q2/.{h[a_,b_][]:>delta[a,zq]delta[b,wq],A___ h[a_,b_][m_]:>- I A q[m]delta[a,zq]delta[b,wq],h[a_,b_][m_,n_]:>- q[m]q[n] delta[a,zq]delta[b,wq],h[a_,b_][m_,n_,r_]:>I q[m]q[n] q[r] delta[a,zq]delta[b,wq]};*) (*QQ[zp_,wp_,zq_,wq_,p_,q_,p2_,q2_,pq_]=Q2;*) (*QQ2[m_,n_,r_,s_,p_,p2_]=QQ[m,n,r,s,p,-p,p2,p2,-p2];*) (*QQ3[m_,n_,r_,s_,p_,p2_]=1/2(QQ2[m,n,r,s,p,p2]+QQ2[n,m,r,s,p,p2]);*) (*QQ4[m_,n_,r_,s_,p_,p2_]=1/2(QQ3[m,n,r,s,p,p2]+QQ3[m,n,s,r,p,p2]);*) (*Qu[m_,n_,r_,s_,p_,p2_]=Expand[QQ4[m,n,r,s,p,p2]+QQ4[r,s,m,n,-p,p2]];*) (* ::Input:: *) (*PP[r_,s_,m_,n_,p_,p2_]=aa (delta[m,s] delta[n,r]+delta[m,r] delta[n,s])+bb delta[m,n] delta[r,s]+cc (delta[r,s] p[m] p[n]+ delta[m,n] p[r] p[s])+dd (delta[m,r] p[n] p[s]+ delta[m,s] p[n] p[r]+delta[n,r] p[m] p[s]+ delta[n,s] p[m] p[r])+ee p[m] p[n] p[r] p[s];*) (*riss=Simplify[Expand[PP[m,n,a,b,p,p2]Qu[a,b,r,s,p,p2]]];*) (*cc1=Simplify[Coefficient[riss,delta[m,n] delta[r,s]]];*) (*cc2=Simplify[Coefficient[riss,delta[m,r] delta[n,s]]];*) (*cc3=Simplify[Coefficient[riss,delta[m,r] p[n] p[s]]];*) (*cc4=Simplify[Coefficient[riss,delta[m,n] p[r] p[s]]];*) (*cc5=Simplify[Coefficient[riss,p[m] p[n] p[r] p[s]]];*) (*sol=Simplify[Solve[{cc1==0,cc2==I/2,cc3==0,cc4==0,cc5==0},{aa,bb,cc,dd,ee}]];*) (*sol=Simplify[Expand[sol]];*) (*ppp=PP[m,n,r,s,p,p2]/.sol[[1]];*) (*P[m_,n_,r_,s_,p_,p2_]=Simplify[ppp/.{lamb->lambda (sigma zeta-alpha p2)}];*) (* ::Input:: *) (*(*** B.3 - Graviton vertices ***)*) (* ::Input:: *) (*(**** B.1.a - Relevant portions of the Lagrangian ****)*) (* ::Input:: *) (*Lagra=Expand[Lagra1+Lagra2g];*) (*Vert3=kappa Coefficient[Lagra,kappa,1];*) (*Vert4=kappa^2 Coefficient[Lagra,kappa,2];*) (*Vert3=Expand[Vert3];*) (*Vert4=Expand[Vert4];*) (* ::Input:: *) (*(**** B.1.b - Three graviton vertex ****) *) (* ::Input:: *) (*Expand[Vert3/.{A___ h[a_,b_][]:>A delta[a,zp]delta[b,wp],A___ h[a_,b_][m_]:>-I A p[m]delta[a,zp]delta[b,wp],A___ h[a_,b_][m_,n_]:>- A p[m]p[n] delta[a,zp]delta[b,wp],A___ h[a_,b_][m_,n_,r_]:> I A p[m]p[n] p[r] delta[a,zp]delta[b,wp],A___ h[a_,b_][]^2:>A h[a,b][] delta[a,zp]delta[b,wp],A___ h[a_,b_][m_]^2:>-I A h[a,b][m] p[m]delta[a,zp]delta[b,wp],A___ h[a_,b_][m_,n_]^2:>- A h[a,b][m,n] p[m]p[n] delta[a,zp]delta[b,wp], A___ h[a_,b_][m_,n_,r_]^2:> I A h[a,b][m,n,r] p[m]p[n] p[r] delta[a,zp]delta[b,wp]}];*) (*Expand[%/.{A___ h[a_,b_][]:>A delta[a,zq]delta[b,wq],A___ h[a_,b_][m_]:>-I A q[m]delta[a,zq]delta[b,wq],A___ h[a_,b_][m_,n_]:>- A q[m]q[n] delta[a,zq]delta[b,wq],A___ h[a_,b_][m_,n_,r_]:> I A q[m]q[n] q[r] delta[a,zq]delta[b,wq],h[a_,b_][]^2:>h[a,b][] delta[a,zq]delta[b,wq],h[a_,b_][m_]^2:>-I h[a,b][m] q[m]delta[a,zq]delta[b,wq],h[a_,b_][m_,n_]^2:>- h[a,b][m,n] q[m]q[n] delta[a,zq]delta[b,wq], h[a_,b_][m_,n_,r_]^2:> I h[a,b][m,n,r] q[m]q[n] q[r] delta[a,zq]delta[b,wq]}];*) (*Expand[%/.{h[a_,b_][]:>delta[a,z]delta[b,w],h[a_,b_][m_]:>I (p[m]+q[m])delta[a,z]delta[b,w],h[a_,b_][m_,n_]:>- (p[m]+q[m])(p[n]+q[n]) delta[a,z]delta[b,w],h[a_,b_][m_,n_,r_]:>-I (p[m]+q[m])(p[n]+q[n])(p[r]+ q[r]) delta[a,z]delta[b,w]}];*) (* ::Input:: *) (*V1[z_,w_,zp_,wp_,zq_,wq_,p_,q_,p2_,q2_,pq_]=ExpandAll[%];*) (*V1a[z_,w_,zp_,wp_,zq_,wq_,p_,q_,p2_,q2_,pq_]=ExpandAll[I V1[z,w,zp,wp,zq,wq,p,q,p2,q2,pq]];*) (*V2[z_,w_,m_,n_,r_,s_,p_,q_,p2_,q2_,pq_]=ExpandAll[1/2(V1a[z,w,m,n,r,s,p,q,p2,q2,pq]+V1a[w,z,m,n,r,s,p,q,p2,q2,pq])];*) (*V3[z_,w_,m_,n_,r_,s_,p_,q_,p2_,q2_,pq_]=ExpandAll[1/2(V2[z,w,m,n,r,s,p,q,p2,q2,pq]+V2[z,w,n,m,r,s,p,q,p2,q2,pq])];*) (*V4[z_,w_,m_,n_,r_,s_,p_,q_,p2_,q2_,pq_]=Expand[1/2(V3[z,w,m,n,r,s,p,q,p2,q2,pq]+V3[z,w,m,n,s,r,p,q,p2,q2,pq])];*) (*V[z_,w_,m_,n_,r_,s_,p_,q_,p2_,q2_,pq_]=ExpandAll[V4[z,w,m,n,r,s,p,q,p2,q2,pq]+V4[m,n,z,w,r,s,-p-q,q,p2+q2+2 pq,q2,-pq -q2]+V4[r,s,m,n,z,w,p,-p-q,p2,p2+q2+2 pq,-p2-pq]+V4[z,w,r,s,m,n,q,p,q2,p2,pq]+V4[r,s,z,w,m,n,-p-q,p,p2+q2+2 pq,p2,-p2-pq]+V4[m,n,r,s,z,w,q,-p-q,q2,p2+q2+2 pq,-pq-q2]];*) (*(* The three graviton vertex V[z,w,m,n,r,s,p,q,p2,q2,pq] has an external leg with indices m and n and incoming momentum p, an external leg with indices r and s and incoming momentum q, an external leg with indices z and w (and incoming momentum -p-q) *)*) (* ::Input:: *) (*(**** B.1.c - Four graviton vertex ****) *) (* ::Input:: *) (*Expand[Vert4/.{A___ h[a_,b_][]:>A delta[a,zp]delta[b,wp],A___ h[a_,b_][m_]:>-I A p[m]delta[a,zp]delta[b,wp],A___ h[a_,b_][m_,n_]:>- A p[m]p[n] delta[a,zp]delta[b,wp],A___ h[a_,b_][m_,n_,r_]:>I A p[m]p[n] p[r] delta[a,zp]delta[b,wp],A___ h[a_,b_][]^2:>A h[a,b][] delta[a,zp]delta[b,wp],A___ h[a_,b_][m_]^2:>-A I h[a,b][m] p[m]delta[a,zp]delta[b,wp],A___ h[a_,b_][m_,n_]^2:>- A h[a,b][m,n] p[m]p[n] delta[a,zp]delta[b,wp], A___ h[a_,b_][m_,n_,r_]^2:> I A h[a,b][m,n,r] p[m]p[n] p[r] delta[a,zp]delta[b,wp]}];*) (*Expand[%/.{A___ h[a_,b_][]:>A delta[a,zq]delta[b,wq],A___ h[a_,b_][m_]:>-I A q[m]delta[a,zq]delta[b,wq],A___ h[a_,b_][m_,n_]:>- A q[m]q[n] delta[a,zq]delta[b,wq],A___ h[a_,b_][m_,n_,r_]:> I A q[m]q[n] q[r] delta[a,zq]delta[b,wq],A___ h[a_,b_][]^2:>A h[a,b][] delta[a,zq]delta[b,wq],A___ h[a_,b_][m_]^2:>-I A h[a,b][m] q[m]delta[a,zq]delta[b,wq],A___ h[a_,b_][m_,n_]^2:>- A h[a,b][m,n] q[m]q[n] delta[a,zq]delta[b,wq], A___ h[a_,b_][m_,n_,r_]^2:> I A h[a,b][m,n,r] q[m]q[n] q[r] delta[a,zq]delta[b,wq]}];*) (*Expand[%/.{A___ h[a_,b_][]:>A delta[a,zk]delta[b,wk],A___ h[a_,b_][m_]:>-I A k[m]delta[a,zk]delta[b,wk],A___ h[a_,b_][m_,n_]:>- A k[m]k[n] delta[a,zk]delta[b,wk],A___ h[a_,b_][m_,n_,r_]:> I A k[m]k[n] k[r] delta[a,zk]delta[b,wk],h[a_,b_][]^2:>h[a,b][] delta[a,zk]delta[b,wk],h[a_,b_][m_]^2:>-I h[a,b][m] k[m]delta[a,zk]delta[b,wk],h[a_,b_][m_,n_]^2:>- h[a,b][m,n] k[m]k[n] delta[a,zk]delta[b,wk], h[a_,b_][m_,n_,r_]^2:> I h[a,b][m,n,r] k[m]k[n] k[r] delta[a,zk]delta[b,wk]}];*) (*Expand[%/.{h[a_,b_][]:>delta[a,z]delta[b,w],h[a_,b_][m_]:>I (p[m]+q[m]+k[m])delta[a,z]delta[b,w],h[a_,b_][m_,n_]:>- (p[m]+q[m]+k[m])(p[n]+q[n]+k[n]) delta[a,z]delta[b,w],h[a_,b_][m_,n_,r_]:>-I (p[m]+q[m]+k[m])(p[n]+q[n]+k[n])(p[r]+ q[r]+k[r]) delta[a,z]delta[b,w]}];*) (* ::Input:: *) (*VV1[z_,w_,zp_,wp_,zq_,wq_,zk_,wk_,p_,q_,k_,p2_,q2_,k2_,pq_,pk_,qk_]=ExpandAll[%];*) (*VV1a[z_,w_,zp_,wp_,zq_,wq_,zk_,wk_,p_,q_,k_,p2_,q2_,k2_,pq_,pk_,qk_]=Expand[I VV1[z,w,zp,wp,zq,wq,zk,wk,p,q,k,p2,q2,k2,pq,pk,qk]];*) (*VV2[z_,w_,zp_,wp_,zq_,wq_,zk_,wk_,p_,q_,k_,p2_,q2_,k2_,pq_,pk_,qk_]=Expand[1/2(VV1a[z,w,zp,wp,zq,wq,zk,wk,p,q,k,p2,q2,k2,pq,pk,qk]+VV1a[w,z,zp,wp,zq,wq,zk,wk,p,q,k,p2,q2,k2,pq,pk,qk])];*) (*VV3[z_,w_,zp_,wp_,zq_,wq_,zk_,wk_,p_,q_,k_,p2_,q2_,k2_,pq_,pk_,qk_]=Expand[1/2(VV2[z,w,zp,wp,zq,wq,zk,wk,p,q,k,p2,q2,k2,pq,pk,qk]+VV2[z,w,wp,zp,zq,wq,zk,wk,p,q,k,p2,q2,k2,pq,pk,qk])];*) (*VV4[z_,w_,zp_,wp_,zq_,wq_,zk_,wk_,p_,q_,k_,p2_,q2_,k2_,pq_,pk_,qk_]=Expand[1/2(VV3[z,w,zp,wp,zq,wq,zk,wk,p,q,k,p2,q2,k2,pq,pk,qk]+VV3[z,w,zp,wp,wq,zq,zk,wk,p,q,k,p2,q2,k2,pq,pk,qk])];*) (*VV5[z_,w_,zp_,wp_,zq_,wq_,zk_,wk_,p_,q_,k_,p2_,q2_,k2_,pq_,pk_,qk_]=Expand[1/2(VV4[z,w,zp,wp,zq,wq,zk,wk,p,q,k,p2,q2,k2,pq,pk,qk]+VV4[z,w,zp,wp,zq,wq,wk,zk,p,q,k,p2,q2,k2,pq,pk,qk])];*) (* ::Input:: *) (*VV6[s_,s1_,m_,m1_,n_,n1_,r_,r1_,p_,q_,k_,p2_,q2_,k2_,pq_,pk_,qk_]=Expand[VV5[s,s1,m,m1,n,n1,r,r1,p,q,k,p2,q2,k2,pq,pk,qk]+VV5[s,s1,m,m1,r,r1,n,n1,p,k,q,p2,k2,q2,pk,pq,qk]+VV5[s,s1,n,n1,m,m1,r,r1,q,p,k,q2,p2,k2,pq,qk,pk]+VV5[s,s1,n,n1,r,r1,m,m1,q,k,p,q2,k2,p2,qk,pq,pk]+VV5[s,s1,r,r1,m,m1,n,n1,k,p,q,k2,p2,q2,pk,qk,pq]+VV5[s,s1,r,r1,n,n1,m,m1,k,q,p,k2,q2,p2,qk,pk,pq]];*) (* ::Input:: *) (*VV7[s_,s1_,m_,m1_,n_,n1_,r_,r1_,p_,q_,k_,p2_,q2_,k2_,pq_,pk_,qk_]=Expand[VV6[s,s1,m,m1,n,n1,r,r1,p,q,k,p2,q2,k2,pq,pk,qk]+VV6[m,m1,s,s1,n,n1,r,r1,-p-q-k,q,k,p2+q2+k2+2pq+2pk+2qk,q2,k2,-pq-q2-qk,-pk-qk-k2,qk]+VV6[n,n1,m,m1,s,s1,r,r1,p,-p-q-k,k,p2,p2+q2+k2+2pq+2pk+2qk,k2,-p2-pq-pk,pk,-pk-qk-k2]+VV6[r,r1,m,m1,n,n1,s,s1,p,q,-p-q-k,p2,q2,p2+q2+k2+2pq+2pk+2qk,pq,-p2-pq-pk,-pq-q2-qk]];*) (*(* The four graviton vertex VV7[z,w,m,n,r,s,a,b,p,q,k,p2,q2,k2,pq,pk,qk] has an external leg with indices m and n and incoming momentum p, an external leg with indices r and s and incoming momentum q, an external leg with indices a and b and incoming momentum k, an external leg with indices z and w (and incoming momentum -p-q-k) *)*) (* ::Input:: *) (*(** C - Coefficients of the solution **)*) (* ::Input:: *) (*s1=1/(64 alpha lambda omega^2 \[Pi]^2);*) (*s2=-1/(12 alpha lambda \[Pi]^2)-1/(24 alpha lambda omega^2 \[Pi]^2);*) (*s3=1/(48 alpha lambda \[Pi]^2)-1/(192 alpha lambda omega^2 \[Pi]^2);*) (*t0=3/(16 alpha lambda \[Pi]^2)+1/(64 alpha lambda omega^2 \[Pi]^2)-3/(64 omega^2 \[Pi]^2 xi)-3/(16 omega \[Pi]^2 xi)+A/(8Pi^2);*) (*t1=-5/(18 alpha \[Pi]^2)-1/(3 alpha lambda \[Pi]^2)-1/(24 alpha lambda omega^2 \[Pi]^2)+5/(18 alpha omega \[Pi]^2)+1/(9 \[Pi]^2 xi)+1/(12 omega^2 \[Pi]^2 xi)+5/(36 omega \[Pi]^2 xi);*) (*t2=5/(72 alpha \[Pi]^2)-5/(48 alpha lambda \[Pi]^2)-1/(192 alpha lambda omega^2 \[Pi]^2)-5/(72 alpha omega \[Pi]^2)-1/(36 \[Pi]^2 xi)-1/(48 omega^2 \[Pi]^2 xi)-5/(144 omega \[Pi]^2 xi);*) (*t3=-25/(72 alpha \[Pi]^2)-1/(12 alpha lambda \[Pi]^2)-5/(72 alpha omega^2 \[Pi]^2)+1/(48 alpha lambda omega^2 \[Pi]^2)+5/(12 alpha omega \[Pi]^2)+7/(72 \[Pi]^2 xi)+7/(144 omega^2 \[Pi]^2 xi)+1/(12 omega \[Pi]^2 xi);*) (*t4=25/(144 alpha \[Pi]^2)+5/(144 alpha omega^2 \[Pi]^2)-5/(24 alpha omega \[Pi]^2)-7/(144 \[Pi]^2 xi)-7/(288 omega^2 \[Pi]^2 xi)-1/(24 omega \[Pi]^2 xi);*) (*t5=5/(32 alpha \[Pi]^2)+5/(24 alpha lambda \[Pi]^2)+25/(288 alpha omega^2 \[Pi]^2)+1/(96 alpha lambda omega^2 \[Pi]^2)+25/(144 alpha omega \[Pi]^2)-1/(96 \[Pi]^2 xi)-11/(576 omega^2 \[Pi]^2 xi)-7/(144 omega \[Pi]^2 xi);*) (*t6=-35/(576 alpha \[Pi]^2)-5/(192 alpha omega^2 \[Pi]^2)-5/(288 alpha omega \[Pi]^2)+5/(576 \[Pi]^2 xi)+1/(128 omega^2 \[Pi]^2 xi)+5/(288 omega \[Pi]^2 xi);*) (*DeltaC=2 A LamC-(5 LamC)/alpha-(5 zeta^2)/(4 alpha^2)-(-8 LamC xi+zeta^2)/(4 xi^2);*) (*Deltazeta=A zeta+(5 zeta)/(6 xi)+(5 xi zeta)/(3 alpha^2);*) (*Deltaalpha=-133/10;*) (*Deltaxi=5/6+(5 xi)/alpha+(5 xi^2)/(3 alpha^2);*) (*B=-(A kappa^2)/(16 \[Pi]^2)-(3 kappa^2)/(32 \[Pi]^2 xi);*) (*(* See below for the definitions of t1, t2, t3, t4, t5, t6, s1, s2 and s3 *)*) (* ::Input:: *) (*(** E - Renormalization of the graviton sector **)*) (* ::Input:: *) (*(*** E.1 - One-point tadpole ***)*) (* ::Input:: *) (*tadone=Expand[1/2 V[m,n,z,w,r,s,p,-p,p2,p2,-p2]P[z,w,r,s,p,p2]];*) (*tadone=Expand[tadone];*) (*tadone=Expand[tadone/.rul2];*) (*tadone=Expand[tadone/.rul1];*) (*tadone=Expand[tadone];*) (*tadone=Expand[tadone/.{zeta->lam^2 zeta,LamC->lam^4 LamC}];*) (*tadone=Expand[1/4!D[tadone,{lam,4}]/.{lam->0}];*) (*tadone=Expand[Simplify[tadone]];*) (*tadone=Expand[I/(8Pi^2)Coefficient[tadone,p2,-2]];*) (*tadone=Expand[Simplify[tadone]];*) (* ::Input:: *) (*(*** E.2 - Two-point tadpole ***)*) (* ::Input:: *) (*ris1=Expand[1/2 P[a,b,c,d,p,p2]];ris2=Expand[VV7[m,n,a,b,c,d,r,s,p,-p,k,p2,p2,k2,-p2,pk,-pk]];*) (*len=10;*) (*in=IntegerPart[Length[ris1]/len]+1;*) (*For[j=1,jlam^2 zeta,LamC->lam^4 LamC,k[m_]:>lam k[m],k2->lam^2 k2,pk->lam pk}];ris=Expand[1/4!D[ris,{lam,4}]/.{lam->0}];*) (*ris=Expand[ris/.r44];ris=Expand[ris/.r43];*) (*ris=Expand[ris/.r42];ris=Expand[ris/.r41];ris=Expand[ris/.r40];ris=Expand[ris/.r34];ris=Expand[ris/.r33];ris=Expand[ris/.r32];ris=Expand[ris/.r31];ris=Expand[ris/.r30];ris=Expand[ris/.r24];ris=Expand[ris/.r23];ris=Expand[ris/.r22];ris=Expand[ris/.r21];ris=Expand[ris/.r20];ris=Expand[ris/.r14];ris=Expand[ris/.r13];ris=Expand[ris/.r12];ris=Expand[ris/.r11];ris=Expand[ris/.r10];ris=Expand[ris/.r04];ris=Expand[ris/.r03];ris=Expand[ris/.r02];ris=Expand[ris/.r01];ris=Expand[Simplify[ris]];ris=Expand[I/(8 Pi^2)Coefficient[ris,p2,-2]];bo[j]=Expand[Simplify[ris]];]*) (*tad2div=Sum[bo[j],{j,1,in}];*) (* ::Input:: *) (*(*** E.3 - Bubble diagram ***)*) (* ::Input:: *) (*(* *)*) (*Unprotect[Times,Power];*) (*LamC^m_:=0/;m>1*) (*zeta^m_:=0/;m>2*) (*LamC zeta:=0*) (*LamC zeta^2:=0*) (*k2^m_:=0/;m>2*) (*pk^m_:=0/;m>4*) (*k2^2 pk^m_:=0/;m>0*) (*k2^2 pk:=0*) (*k2^2 k[m_]:=0*) (*k2 pk^m_:=0/;m>2*) (*k2 pk^m_ k[n_]:=0/;m>1*) (*k2 pk^m_ k[n_]k[r_]:=0/;m>0*) (*k2 pk k[n_]k[r_]:=0*) (*k2 k[m_]k[n_]k[r_]:=0*) (*pk^4 k[m_]:=0*) (*pk^3 k[m_]k[n_]:=0*) (*pk^2 k[m_]k[n_]k[r_]:=0*) (*pk k[m_]k[n_]k[r_]k[s_]:=0*) (*LamC pk^m_:=0/;m>0*) (*LamC pk:=0*) (*LamC k2^m_:=0/;m>0*) (*LamC k2:=0*) (*LamC k[m_]:=0*) (*zeta^2 pk^m_:=0/;m>0*) (*zeta^2 pk:=0*) (*zeta^2 k2^m_:=0/;m>0*) (*zeta^2 k2:=0*) (*zeta^2 k[m_]:=0*) (*zeta k2^m_:=0/;m>1*) (*zeta k2 pk^m_:=0/;m>0*) (*zeta k2 pk:=0*) (*zeta k2 k[m_]:=0*) (*zeta pk^m_:=0/;m>2*) (*zeta pk^2 k[m_]:=0*) (*zeta pk k[m_]k[n_]:=0*) (*zeta k[m_]k[n_]k[r_]:=0*) (*(* *)*) (* ::Input:: *) (*prop=ExpandAll[P[m,n,r,s,p,p2]];*) (*prop=ExpandAll[prop];*) (*co[0]=prop/.{zeta->0};*) (*co[1]=D[prop,{zeta,1}]/.{zeta->0};*) (*co[2]=*) (*D[prop,{zeta,2}]/.{zeta->0};*) (*prop=co[0]+zeta co[1]+1/2 zeta^2 co[2];*) (*coe[0]=prop/.{LamC->0};*) (*coe[1]=D[prop,{LamC,1}]/.{LamC->0};*) (*prop=coe[0]+LamC coe[1];*) (*prop=Expand[prop];*) (*prop=Simplify[prop];*) (*prop=Expand[prop];*) (*P[m_,n_,r_,s_,p_,p2_]=prop;*) (* ::Input:: *) (*ris1=Expand[V[c,d,m,n,a,b,k,-p,k2,p2,-pk]P[a,b,ap,bp,p,p2]];*) (*ris1=Expand[ris1];*) (* ::Input:: *) (*pp=P[c,d,cp,dp,-p+k,p2+k2-2pk];*) (*pp=pp/.{LamC->lam^4 LamC,zeta->lam^2 zeta,k[m_]:>lam k[m],pk->lam pk, k2->lam^2 k2};*) (*co[0]=pp/.{lam->0};*) (*co[1]=D[pp,{lam,1}]/.{lam->0};*) (*co[2]=D[pp,{lam,2}]/.{lam->0};*) (*co[3]=D[pp,{lam,3}]/.{lam->0};*) (*co[4]=D[pp,{lam,4}]/.{lam->0};*) (*pp=co[0]+co[1]+1/2 co[2]+1/3! co[3]+ 1/4! co[4];*) (*pp=Expand[pp];*) (*pp=Simplify[pp];*) (*pp=Expand[pp];*) (* ::Input:: *) (*ris2=Expand[1/2 V[cp,dp,ap,bp,r,s,p,-k,p2,k2,-pk]];*) (*ris2=Expand[ris2 pp];*) (*ris2=Expand[ris2];*) (* ::Input:: *) (*ris1=Expand[ris1/.{LamC->lam^4 LamC,zeta->lam^2 zeta,k[m_]:>lam k[m],pk->lam pk, k2->lam^2 k2}];*) (*ris2=Expand[ris2/.{LamC->lam^4 LamC,zeta->lam^2 zeta,k[m_]:>lam k[m],pk->lam pk, k2->lam^2 k2}];*) (* ::Input:: *) (*a[0]=Coefficient[ris1,lam,0];*) (*a[1]=Coefficient[ris1,lam,1];*) (*a[2]=Coefficient[ris1,lam,2];*) (*a[3]=Coefficient[ris1,lam,3];*) (*a[4]=Coefficient[ris1,lam,4];*) (*b[0]=Coefficient[ris2,lam,0];*) (*b[1]=Coefficient[ris2,lam,1];*) (*b[2]=Coefficient[ris2,lam,2];*) (*b[3]=Coefficient[ris2,lam,3];*) (*b[4]=Coefficient[ris2,lam,4];*) (* ::Input:: *) (*r5=Expand[a[4]b[0]];*) (*r4=Expand[a[3]b[1]];*) (*r3=Expand[a[2]b[2]];*) (*r2=Expand[a[1]b[3]];*) (*r1=Expand[a[0]b[4]];*) (* ::Input:: *) (*bolladiv=Expand[r1+r2+r3+r4+r5];*) (* ::Input:: *) (*ris=Expand[bolladiv/.r44];*) (*ris=Expand[ris/.r43];*) (*ris=Expand[ris/.r42];*) (*ris=Expand[ris/.r41];*) (*ris=Expand[ris/.r40];*) (*ris=Expand[ris/.r34];*) (*ris=Expand[ris/.r33];*) (*ris=Expand[ris/.r32];*) (*ris=Expand[ris/.r31];*) (*ris=Expand[ris/.r30];*) (*ris=Expand[ris/.r24];*) (*ris=Expand[ris/.r23];*) (*ris=Expand[ris/.r22];*) (*ris=Expand[ris/.r21];*) (*ris=Expand[ris/.r20];*) (*ris=Expand[ris/.r14];*) (*ris=Expand[ris/.r13];*) (*ris=Expand[ris/.r12];*) (*ris=Expand[ris/.r11];*) (*ris=Expand[ris/.r10];*) (*ris=Expand[ris/.r04];*) (*ris=Expand[ris/.r03];*) (*ris=Expand[ris/.r02];*) (*ris=Expand[ris/.r01];*) (*ris=Expand[Simplify[ris]];*) (*ris=Expand[I/(8 Pi^2)Coefficient[ris,p2,-2]];bolla=Expand[Simplify[ris]];*) (* ::Input:: *) (*(** F - Renormalization of the ghost sector **)*) (* ::Input:: *) (*(*** F.1 - Ghost loop contribution to the graviton self energy ***)*) (* ::Input:: *) (*selfgh=Expand[-V3gh[a,m,n,e,-k,p,k2,p2,-pk]pgh[e,f,p,p2]V3gh[f,r,s,c,k,p-k,k2,p2+k2-2 pk,pk-k2]pgh[a,c,p-k,p2+k2-2 pk]];*) (*selfgh=Expand[selfgh/.{k[m_]:>lam k[m],k2->lam^2 k2,pk->lam pk}];*) (*selfgh=Expand[Normal[Series[selfgh,{lam,0,4}]]/.{lam->1}];*) (*selfgh=Expand[selfgh/.r44];*) (*selfgh=Expand[selfgh/.r43];*) (*selfgh=Expand[selfgh/.r42];*) (*selfgh=Expand[selfgh/.r41];*) (*selfgh=Expand[selfgh/.r40];*) (*selfgh=Expand[selfgh/.r34];*) (*selfgh=Expand[selfgh/.r33];*) (*selfgh=Expand[selfgh/.r32];*) (*selfgh=Expand[selfgh/.r31];*) (*selfgh=Expand[selfgh/.r30];*) (*selfgh=Expand[selfgh/.r24];*) (*selfgh=Expand[selfgh/.r23];*) (*selfgh=Expand[selfgh/.r22];*) (*selfgh=Expand[selfgh/.r21];*) (*selfgh=Expand[selfgh/.r20];*) (*selfgh=Expand[selfgh/.r14];*) (*selfgh=Expand[selfgh/.r13];*) (*selfgh=Expand[selfgh/.r12];*) (*selfgh=Expand[selfgh/.r11];*) (*selfgh=Expand[selfgh/.r10];*) (*selfgh=Expand[selfgh/.r04];*) (*selfgh=Expand[selfgh/.r03];*) (*selfgh=Expand[selfgh/.r02];*) (*selfgh=Expand[selfgh/.r01];*) (*selfgh=Expand[Simplify[selfgh]];*) (*selfgh=Expand[I/(8 Pi^2)Coefficient[selfgh,p2,-2]];*) (* ::Input:: *) (*(** G - Analysis of the result **)*) (* ::Input:: *) (*(*** G.1 - One-point function ***)*) (* ::Input:: *) (*Lagra=Expand[Lagra1+Lagra2g];*) (*Vert1=1/kappa Coefficient[Lagra,kappa,-1];*) (*Vert2=Coefficient[Lagra,kappa,0];*) (* ::Input:: *) (*Expand[Vert1/.{h[a_,b_][]:>delta[a,z]delta[b,w],h[a_,b_][m_]:>0,h[a_,b_][m_,n_]:>0,h[a_,b_][m_,n_,r_]:>0}];*) (*V1a[z_,w_]=ExpandAll[I %];*) (*V1[m_,n_]=ExpandAll[1/2(V1a[m,n]+V1a[n,m])];*) (*Ic=ExpandAll[sqrtg[vv1,vv2,vv3]];*) (*Ic=Expand[I kappa Coefficient[Ic,kappa,1]];*) (*Ic/.{A___ h[a_,b_][]:>A delta[a,zp]delta[b,wp],A___ h[a_,b_][m_]:>-I A p[m]delta[a,zp]delta[b,wp],A___ h[a_,b_][m_,n_]:>- A p[m]p[n] delta[a,zp]delta[b,wp],h[a_,b_][]^2:>h[a,b][] delta[a,zp]delta[b,wp],h[a_,b_][m_]^2:>-I h[a,b][m] p[m]delta[a,zp]delta[b,wp],h[a_,b_][m_,n_]^2:>- h[a,b][m,n] p[m]p[n] delta[a,zp]delta[b,wp]};*) (*InvCa[zp_,wp_,p_,p2_]=Expand[%];*) (*InvCone[m_,n_,p_,p2_]=Expand[1/2(InvCa[m,n,p,p2]+InvCa[n,m,p,p2])];*) (* ::Input:: *) (*risone=Expand[Simplify[tadone+(2DeltaC/(16 Pi^2)-2 LamC t0) InvCone[m,n,k,k2]+kappa^2/2 V1[mm,nn](t1/2(delta[mm,m]delta[nn,n]+delta[mm,n]delta[nn,m])+t2 delta[mm,nn]delta[m,n])]]*) (* ::Input:: *) (*(*** G.2 - Two-point function ***)*) (* ::Input:: *) (*Expand[Vert2/.{A___ h[a_,b_][]:>A delta[a,zp]delta[b,wp],A___ h[a_,b_][m_]:>-I A p[m]delta[a,zp]delta[b,wp],A___ h[a_,b_][m_,n_]:>- A p[m]p[n] delta[a,zp]delta[b,wp],A___ h[a_,b_][]^2:>A h[a,b][] delta[a,zp]delta[b,wp],A___ h[a_,b_][m_]^2:>-I A h[a,b][m] p[m]delta[a,zp]delta[b,wp],A___ h[a_,b_][m_,n_]^2:>- A h[a,b][m,n] p[m]p[n] delta[a,zp]delta[b,wp]}];*) (*Expand[%/.{h[a_,b_][]:>delta[a,z]delta[b,w],h[a_,b_][m_]:>I p[m]delta[a,z]delta[b,w],h[a_,b_][m_,n_]:>- p[m]p[n] delta[a,z]delta[b,w]}];*) (*V2a[z_,w_,zp_,wp_,p_,p2_]=ExpandAll[I %];*) (*V2b[m_,n_,r_,s_,p_,p2_]=ExpandAll[1/2(V2a[m,n,r,s,p,p2]+V2a[n,m,r,s,p,p2])];*) (*V2c[m_,n_,r_,s_,p_,p2_]=ExpandAll[1/2(V2b[m,n,r,s,p,p2]+V2b[m,n,s,r,p,p2])];*) (*V2[m_,n_,r_,s_,p_,p2_]=ExpandAll[V2c[m,n,r,s,p,p2]+V2c[r,s,m,n,p,p2]];*) (* ::Input:: *) (*ris=Expand[Simplify[bolla+tad2div+selfgh+Deltaalpha/(16 Pi^2) (InvRic2[m,n,r,s,k,k2]-1/3 InvR2[m,n,r,s,k,k2]) -(Deltaxi/6)/(16 Pi^2) InvR2[m,n,r,s,k,k2]+(Deltazeta/(16 Pi^2)- zeta t0/2) InvR[m,n,r,s,k,k2]+(2DeltaC/(16 Pi^2)-2 LamC t0)InvC[m,n,r,s,k,k2]+kappa^2/2 V2[r,s,mm,nn,k,k2](t1/2(delta[mm,m]delta[nn,n]+delta[mm,n]delta[nn,m])+t2 delta[mm,nn]delta[m,n])+kappa^2/2V2[m,n,mm,nn,k,k2](t1/2(delta[mm,r]delta[nn,s]+delta[mm,s]delta[nn,r])+t2 delta[mm,nn]delta[r,s])-(I LamC)/ 2 kappa^2 (t3+4t5)(delta[m,r]delta[n,s]+delta[m,s]delta[n,r])-I LamC kappa^2 (t4+4t6) delta[m,n]delta[r,s]]]*) (* ::Input:: *) (*(*** G.3 - Match with the results of Strumia and Salvio ***)*) (* ::Input:: *) (*Simplify[4/alpha^2 Deltaalpha/.{alpha->2/f2^2,xi->2/f0^2}]*) (*Simplify[4/xi^2 Deltaxi/.{alpha->2/f2^2,xi->2/f0^2}]*) (*ExpandAll[-2 Deltazeta/.{alpha->2/f2^2,xi->2/f0^2,A->-X-3/4 f0^2}]*) (*ExpandAll[-2DeltaC/.{alpha->2/f2^2,xi->2/f0^2,A->-X-3/4 f0^2}]*) (*Together[Expand[-A-3/4 f0^2/.{A->-3/(2 alpha lambda)-1/(8 alpha lambda omega^2)+3/(8 omega^2 xi)+3/(2 omega xi)}]/.{alpha->2/f2^2,xi->2/f0^2,omega->cg/2-1,lambda->-f2^2/xig}]*) (*Together[Expand[B/.{A->-3/(2 alpha lambda)-1/(8 alpha lambda omega^2)+3/(8 omega^2 xi)+3/(2 omega xi)}]/.{alpha->2/f2^2,xi->2/f0^2,omega->cg/2-1,lambda->-f2^2/xig}]*) (* ::Input:: *) (*(** H - Renormalization of scalar fields **)*) (* ::Input:: *) (*(*** H.1 - Vertices ***)*) (* ::Input:: *) (*LL=Expand[-(p[m]q[n]+p[n]q[m])/2 sqrtg[a1,a2,p3] ginv[m,n,a4,a5]];*) (* ::Input:: *) (*Expand[kappa Coefficient[LL,kappa,1]];*) (*Expand[%/.{h[a_,b_][]:>delta[a,z]delta[b,w]}];*) (*Vs31[z_,w_,p_,q_,pq_]=ExpandAll[%];*) (*Vs31a[z_,w_,p_,q_,pq_]=ExpandAll[I Vs31[z,w,p,q,pq]];*) (*Vs3[z_,w_,p_,q_,pq_]=ExpandAll[1/2(Vs31a[z,w,p,q,pq]+Vs31a[w,z,p,q,pq])];*) (* ::Input:: *) (*Expand[kappa^2 Coefficient[LL,kappa,2]];*) (*Expand[%/.{A___ h[a_,b_][]:>A delta[a,zp]delta[b,wp],A___ h[a_,b_][]^2:>A h[a,b][] delta[a,zp]delta[b,wp]}];*) (*Expand[%/.{h[a_,b_][]:>delta[a,z]delta[b,w]}];*) (*Vs41[z_,w_,zp_,wp_,p_,q_,pq_]=ExpandAll[%];*) (*Vs41a[z_,w_,zp_,wp_,p_,q_,pq_]=ExpandAll[I Vs41[z,w,zp,wp,p,q,pq]];*) (*Vs42[z_,w_,m_,n_,p_,q_,pq_]=ExpandAll[1/2(Vs41a[z,w,m,n,p,q,pq]+Vs41a[w,z,m,n,p,q,pq])];*) (*Vs43[z_,w_,m_,n_,p_,q_,pq_]=ExpandAll[1/2(Vs42[z,w,m,n,p,q,pq]+Vs42[z,w,n,m,p,q,pq])];*) (*Vs4[z_,w_,m_,n_,p_,q_,pq_]=Expand[Vs43[z,w,m,n,p,q,pq]+Vs43[m,n,z,w,p,q,pq]];*) (* ::Input:: *) (*Expand[kappa^3 Coefficient[LL,kappa,3]];*) (*Expand[%/.{A___ h[a_,b_][]:>A delta[a,zp]delta[b,wp],A___ h[a_,b_][]^2:>A h[a,b][] delta[a,zp]delta[b,wp]}];*) (*Expand[%/.{A___ h[a_,b_][]:>A delta[a,zq]delta[b,wq],A___ h[a_,b_][]^2:>A h[a,b][] delta[a,zq]delta[b,wq]}];*) (*Expand[%/.{h[a_,b_][]:>delta[a,z]delta[b,w]}];*) (*Vs51[z_,w_,zp_,wp_,zq_,wq_,p_,q_,pq_]=ExpandAll[%];*) (*Vs51a[z_,w_,zp_,wp_,zq_,wq_,p_,q_,pq_]=ExpandAll[I Vs51[z,w,zp,wp,zq,wq,p,q,pq]];*) (*Vs52[z_,w_,m_,n_,r_,s_,p_,q_,pq_]=ExpandAll[1/2(Vs51a[z,w,m,n,r,s,p,q,pq]+Vs51a[w,z,m,n,r,s,p,q,pq])];*) (*Vs53[z_,w_,m_,n_,r_,s_,p_,q_,pq_]=ExpandAll[1/2(Vs52[z,w,m,n,r,s,p,q,pq]+Vs52[z,w,n,m,r,s,p,q,pq])];*) (*Vs54[z_,w_,m_,n_,r_,s_,p_,q_,pq_]=Expand[1/2(Vs53[z,w,m,n,r,s,p,q,pq]+Vs53[z,w,m,n,s,r,p,q,pq])];*) (*Vs5[z_,w_,m_,n_,r_,s_,p_,q_,pq_]=ExpandAll[Vs54[z,w,m,n,r,s,p,q,pq]+Vs54[m,n,z,w,r,s,p,q,pq]+Vs54[r,s,m,n,z,w,p,q,pq]+Vs54[z,w,r,s,m,n,p,q,pq]+Vs54[r,s,z,w,m,n,p,q,pq]+Vs54[m,n,r,s,z,w,p,q,pq]];*) (* ::Input:: *) (*(*** H.2 - Tadpole ***)*) (* ::Input:: *) (*tadsdiv=Expand[1/2 Vs4[m,n,r,s,k,-k,-k2]P[m,n,r,s,p,p2]];*) (*tadsdiv=Expand[Simplify[tadsdiv]/.{zeta->0,lamC->0}];*) (*tadsdiv=Expand[tadsdiv/.r40];*) (*tadsdiv=Expand[tadsdiv/.r30];*) (*tadsdiv=Expand[tadsdiv/.r20];*) (*tadsdiv=Expand[tadsdiv/.r10];*) (*tadsdiv=Expand[Simplify[tadsdiv]];*) (*tadsdiv=Expand[I/(8 Pi^2)Coefficient[tadsdiv,p2,-2]];*) (* ::Input:: *) (*(*** H.3 - Bubble diagram ***)*) (* ::Input:: *) (*bollasdiv=Expand[Vs3[m,n,k,p-k,pk-k2]P[m,n,r,s,p,p2]];*) (*bollasdiv=Expand[bollasdiv I/(p2+k2 -2 pk) Vs3[r,s,k-p,-k,pk-k2]];*) (*bollasdiv=Expand[bollasdiv/.{k[m_]:>lam k[m],k2->lam^2 k2,pk->lam pk}];*) (*bollasdiv=Expand[1/2 D[bollasdiv,{lam,2}]/.{lam->0}];*) (*bollasdiv=Expand[bollasdiv/.r40];*) (*bollasdiv=Expand[bollasdiv/.r30];*) (*bollasdiv=Expand[bollasdiv/.r20];*) (*bollasdiv=Expand[bollasdiv/.r10];*) (*bollasdiv=Expand[Simplify[bollasdiv]];*) (*bollasdiv=Expand[I/(8 Pi^2)Coefficient[bollasdiv,p2,-2]];*) (* ::Input:: *) (*(*** H.4 - Vertex diagram ***)*) (* ::Input:: *) (*vert1div=Expand[Vs3[mm,nn,q,-p,-pq]I/p2 Vs3[rr,ss,p,k,pk]P[mm,nn,a,b,p,p2]P[rr,ss,c,d,p,p2]/.{lamC->0,zeta->0}];*) (*vert1div=Expand[vert1div V[m,n,a,b,c,d, -p,p,p2,p2,-p2]/.{lamC->0,zeta->0}];*) (*vert2div=Expand[1/2 Vs4[mm,nn,rr,ss,k,q,qk]P[mm,nn,a,b,p,p2]P[rr,ss,c,d,p,p2]/.{lamC->0,zeta->0}];*) (*vert2div=Expand[vert2div V[m,n,a,b,c,d,p,-p,p2,p2,-p2]/.{lamC->0,zeta->0}];*) (*vert3div=Expand[Vs3[mm,nn,k,p,pk]P[mm,nn,rr,ss,p,p2]Vs3[rr,ss,-p,q,-pq]I/p2 I/p2 Vs3[m,n,p,-p,-p2]/.{lamC->0,zeta->0}];*) (*vert4div=Expand[1/2Vs5[m,n,mm,nn,rr,ss,k,q,qk]P[mm,nn,rr,ss,p,p2]/.{lamC->0,zeta->0}];*) (*vert5div=Expand[(Vs4[m,n,r,s,k,-p,-pk] Vs3[a,b,p,q,pq]+Vs3[r,s,k,-p,-pk]Vs4[m,n,a,b,p,q,pq]) I/p2 P[r,s,a,b,p,p2]/.{lamC->0,zeta->0}];*) (* ::Input:: *) (*vertsdiv=Expand[Simplify[vert1div+vert2div+vert3div+vert4div+vert5div]];*) (*vertsdiv=Expand[vertsdiv/.{pk^2->p[n3]kk[n3]p[n4]kk[n4],pk pq->p[n5]qq[n5]p[n6]kk[n6],pq^2->p[n7]qq[n7]p[n8]qq[n8]}];*) (*vertsdiv=Expand[vertsdiv/.{pk->p[n1]kk[n1],pq->p[n2]qq[n2]}];*) (*vertsdiv=Expand[vertsdiv];*) (*vertsdiv=Expand[vertsdiv/.rul4];*) (*vertsdiv=Expand[vertsdiv/.rul3];*) (*vertsdiv=Expand[vertsdiv/.rul2];*) (*vertsdiv=Expand[vertsdiv/.rul1];*) (*vertsdiv=Expand[Simplify[vertsdiv]];*) (*vertsdiv=Expand[I/(8 Pi^2)Coefficient[vertsdiv,p2,-2]/.{kk->k,qq->q}];*) (* ::Input:: *) (*Expand[tadsdiv+bollasdiv+ I k2 (2 B + kappa^2 t0)]*) (* ::Input:: *) (*ris=Expand[vertsdiv+(2 B+kappa^2 t0) Vs3[m,n,q,k,qk]+I t1 kappa^3/2 (q[m]k[n]+q[n]k[m])- I (t1+2t2) kappa^3/2 qk delta[m,n]]*) (* ::Input:: *) (*(** I - Ward identities **)*) (* ::Input:: *) (*(*** I.1 - Ward identity for the three graviton vertex ***)*) (* ::Input:: *) (*Expand[V[z,w,m,n,r,s,p,q,p2,q2,pq]p[n]q[s](p[w]+q[w])/.{LamC->0}]*) (* ::Input:: *) (*Q2=Coefficient[Lagra,kappa,0];*) (*Q2=Q2/.{A___ h[a_,b_][]:>A delta[a,zp]delta[b,wp],A___ h[a_,b_][m_]:>- I A p[m]delta[a,zp]delta[b,wp],A___ h[a_,b_][m_,n_]:>- A p[m]p[n] delta[a,zp]delta[b,wp],A___ h[a_,b_][m_,n_,r_]:>I A p[m]p[n] p[r] delta[a,zp]delta[b,wp],h[a_,b_][]^2:>h[a,b][] delta[a,zp]delta[b,wp],h[a_,b_][m_]^2:>- I h[a,b][m] p[m]delta[a,zp]delta[b,wp],h[a_,b_][m_,n_]^2:>- h[a,b][m,n] p[m]p[n] delta[a,zp]delta[b,wp], h[a_,b_][m_,n_,r_]^2:>I h[a,b][m,n,r] p[m]p[n] p[r] delta[a,zp]delta[b,wp]};*) (*Q2=Q2/.{h[a_,b_][]:>delta[a,zq]delta[b,wq],A___ h[a_,b_][m_]:>- I A q[m]delta[a,zq]delta[b,wq],h[a_,b_][m_,n_]:>- q[m]q[n] delta[a,zq]delta[b,wq],h[a_,b_][m_,n_,r_]:>I q[m]q[n] q[r] delta[a,zq]delta[b,wq]};*) (*QQ[zp_,wp_,zq_,wq_,p_,q_,p2_,q2_,pq_]=Q2;*) (*QQ2[m_,n_,r_,s_,p_,p2_]=QQ[m,n,r,s,p,-p,p2,p2,-p2];*) (*QQ3[m_,n_,r_,s_,p_,p2_]=1/2(QQ2[m,n,r,s,p,p2]+QQ2[n,m,r,s,p,p2]);*) (*QQ4[m_,n_,r_,s_,p_,p2_]=1/2(QQ3[m,n,r,s,p,p2]+QQ3[m,n,s,r,p,p2]);*) (*Qu[m_,n_,r_,s_,p_,p2_]=Expand[QQ4[m,n,r,s,p,p2]+QQ4[r,s,m,n,-p,p2]];*) (* ::Input:: *) (*Simplify[Qu[m,n,r,s,p,p2]];*) (*Q[m_,n_,r_,s_,p_,p2_]=%;*) (*T[a_,b_,m_,n_,z_,p_]:=I kappa p[a](delta[b,m]delta[n,z]+delta[b,n]delta[m,z])+I kappa p[b](delta[a,m]delta[n,z]+delta[a,n]delta[m,z])-I kappa p[z](delta[a,m]delta[b,n]+delta[a,n]delta[b,m])*) (* ::Input:: *) (*contr=Expand[V[z,w,m,n,r,s,p,q,p2,q2,pq](p[w]+q[w])+ 1/2 Q[r,s,a1,b1,q,q2]T[a1,b1,m,n,z,p]+1/2 Q[m,n,a1,b1,p,p2]T[a1,b1,r,s,z,q]/.{LamC->0}]*) (* ::Input:: *) (*(*** I.2 - Ward identity for the four graviton vertex ***)*) (* ::Input:: *) (*Expand[(VV7[s,j1,m,m1,n,n1,r,i1,p,q,k,p2,q2,k2,pq,pk,qk](p[j1]+q[j1]+k[j1])-I/2 (V[a,b,n,n1,r,i1,q,k,q2,k2,qk]T[a,b,m,m1,s,p]+V[a,b,m,m1,r,i1,p,k,p2,k2,pk]T[a,b,n,n1,s,q]+V[a,b,n,n1,m,m1,q,p,q2,p2,pq]T[a,b,r,i1,s,k]))k[i1]q[n1]p[m1]/.{LamC->0}]*) (* ::Input:: *) (*Expand[VV7[s,j1,m,m1,n,n1,r,i1,p,q,k,p2,q2,k2,pq,pk,qk](p[j1]+q[j1]+k[j1])-I/2(V[a,b,n,n1,r,i1,q,k,q2,k2,qk]T[a,b,m,m1,s,p]+V[a,b,m,m1,r,i1,p,k,p2,k2,pk]T[a,b,n,n1,s,q]+V[a,b,n,n1,m,m1,q,p,q2,p2,pq]T[a,b,r,i1,s,k])- kappa/2(Q[m,m1,a,b,p,p2](T[a,b,n,n1,r,q]delta[i1,s]+T[a,b,n,n1,i1,q]delta[r,s])+Q[m,m1,a,b,p,p2](T[a,b,r,i1,n,k]delta[n1,s]+T[a,b,r,i1,n1,k]delta[n,s])+Q[n,n1,a,b,q,q2](T[a,b,m,m1,r,p]delta[i1,s]+T[a,b,m,m1,i1,p]delta[r,s])+Q[n,n1,a,b,q,q2](T[a,b,r,i1,m,k]delta[m1,s]+T[a,b,r,i1,m1,k]delta[m,s])+Q[r,i1,a,b,k,k2](T[a,b,m,m1,n,p]delta[n1,s]+T[a,b,m,m1,n1,p]delta[n,s])+Q[r,i1,a,b,k,k2](T[a,b,n,n1,m,q]delta[m1,s]+T[a,b,n,n1,m1,q]delta[m,s]))/.{LamC->0}]*)