SetAttributes[ϵ,Constant];
SetAttributes[M,Constant];
SetAttributes[κ,Constant];
ordn=-4;
ordk=4;

c={2,2,4,4};

c1={r,θ,ϕ,t};
c2={r2,θ2,ϕ2,t2};

(Subscript[v, 1]):=c1[[c[[1]]]];
(Subscript[v, 2]):=c1[[c[[2]]]];
(Subscript[v, 3]):=c2[[c[[3]]]];
(Subscript[v, 4]):=c2[[c[[4]]]];

h[r_]:=1;
f[r_]:=1/b[r]^2;
p[r_]:=r^2/b[r];

(*b[r_]:=1-2*M/r;*)

<< Sigma.m
S2=S;
Clear[S];

Clear[i,j,k]
For[i=0,i≤ordn+10,i++,
For[j=0,j≤ordn+10,j++,
For[k=0,k≤(ordn+10)/2,k++,
Subscript[S,i,j,k]=S2[[i+1,j+1,k+1]];
];
];
];

σ[t,r,η]=Sum[If[i+j+2k≤ordn+10,Subscript[S,i,j,k]*dt[t/ϵ]^i*dr[r/ϵ]^j*η^k*ϵ^(i+j+2*k),0],{i,0,ordn+10},{j,0,ordn+10},{k,0,(ordn+10)/2}]//Expand;

σ2[t,r,η]=Series[σ[t,r,η],{ϵ,0,2}]//Normal//Expand;

σ3[t,r,η]=σ[t,r,η]-σ2[t,r,η]//Expand;

<< Delta.m

Clear[i,j,k]
For[i=0,i≤ordn+8,i++,
For[j=0,j≤ordn+8,j++,
For[k=0,k≤(ordn+8)/2,k++,
Subscript[c,i,j,k]=cs[[i+1,j+1,k+1]];
];
];
];

lDel[t,r,η]=Sum[If[i+j+2k≤ordn+8,Subscript[c,i,j,k]*dt[t/ϵ]^i*dr[r/ϵ]^j*η^k*ϵ^(i+j+2*k),0],{i,0,ordn+8},{j,0,ordn+8},{k,0,(ordn+8)/2}]//Expand;

Dim=Dimensions[lDel[t,r,η]][[1]]

uprule={dr[r/ϵ]->dr[r],dt[t/ϵ]->dt[t],dr[r/ϵ-r2/ϵ]->dr[r-r2],dt[t/ϵ-t2/ϵ]->dt[t-t2],x[t/ϵ,t2/ϵ,r/ϵ,r2/ϵ,η]->x[t,t2,r,r2,η],θ/ϵ->θ,θ2/ϵ->θ2,ϕ/ϵ->ϕ,ϕ2/ϵ->ϕ2}
dnrule={dr[r]->dr[r/ϵ],dt[t]->dt[t/ϵ],dr[r-r2]->dr[r/ϵ-r2/ϵ],dt[t-t2]->dt[t/ϵ-t2/ϵ],x[t,t2,r,r2,η]->x[t/ϵ,t2/ϵ,r/ϵ,r2/ϵ,η],θ->θ/ϵ,θ2->θ2/ϵ,ϕ->ϕ/ϵ,ϕ2->ϕ2/ϵ}

Clear[i];
Us=Table[0,{i,Dim}];
For[i=1,i≤Dim,i++,
Us[[i]]=Series[Exp[lDel[t,r,η][[i]]/.uprule],{ϵ,0,ordn+8}]/.dnrule//Normal;
];

Clear[U]

U[t,r,η]=Us[[1]];
For[i=2,i≤Dim,i++,
temp=Series[Expand[U[t,r,η]*Us[[i]]],{ϵ,0,ordn+8}]//Normal;
U[t,r,η]=temp//Expand;
];

R[r_]:=(4b[r]-4b[r]^2+4*r*b[r]*b'[r]-3*r^2*b'[r]^2+4*r^2*b[r]*b''[r])/(2*r^2)

R[r]//Expand

prule={dr[r/ϵ]->dr[r/ϵ-r2/ϵ],dt[t/ϵ]->dt[t/ϵ-t2/ϵ]}
(*drule={D[dt[t/ϵ-t2/ϵ]*ϵ,t]->1,D[dr[r/ϵ-r2/ϵ]*ϵ,r]->1,D[dt[t/ϵ-t2/ϵ]*ϵ^2,{t,2}]->0,D[dr[r/ϵ-r2/ϵ]*ϵ^2,{r,2}]->0,D[dt[t/ϵ-t2/ϵ]*ϵ,t2]->-1,D[dr[r/ϵ-r2/ϵ]*ϵ,r2]->-1,D[dt[t/ϵ-t2/ϵ]*ϵ^2,{t2,2}]->0,D[dr[r/ϵ-r2/ϵ]*ϵ^2,{r2,2}]->0}*)
drule={D[dt[t/ϵ-t2/ϵ]*ϵ,t]->1,D[dr[r/ϵ-r2/ϵ]*ϵ,r]->1,D[dt[t/ϵ-t2/ϵ]*ϵ^2,{t,2}]->0,D[dr[r/ϵ-r2/ϵ]*ϵ^2,{r,2}]->0,D[dt[t/ϵ-t2/ϵ]*ϵ^3,{t,3}]->0,D[dr[r/ϵ-r2/ϵ]*ϵ^3,{r,3}]->0,D[dt[t/ϵ-t2/ϵ]*ϵ^4,{t,4}]->0,D[dr[r/ϵ-r2/ϵ]*ϵ^4,{r,4}]->0}
erule={ϵ->1}

x2[t/ϵ,t2/ϵ,r/ϵ,r2/ϵ,η]=σ2[t,r,η]/ϵ^2/.prule;

xrule={D[x[t/ϵ,t2/ϵ,r/ϵ,r2/ϵ,η]*ϵ,t]:>D[x2[t/ϵ,t2/ϵ,r/ϵ,r2/ϵ,η]*ϵ,t],D[x[t/ϵ,t2/ϵ,r/ϵ,r2/ϵ,η]*ϵ^2,{t,2}]:>D[x2[t/ϵ,t2/ϵ,r/ϵ,r2/ϵ,η]*ϵ^2,{t,2}],D[x[t/ϵ,t2/ϵ,r/ϵ,r2/ϵ,η]*ϵ,t2]:>D[x2[t/ϵ,t2/ϵ,r/ϵ,r2/ϵ,η]*ϵ,t2],D[x[t/ϵ,t2/ϵ,r/ϵ,r2/ϵ,η]*ϵ^2,{t2,2}]:>D[x2[t/ϵ,t2/ϵ,r/ϵ,r2/ϵ,η]*ϵ^2,{t2,2}],D[x[t/ϵ,t2/ϵ,r/ϵ,r2/ϵ,η]*ϵ,r]:>D[x2[t/ϵ,t2/ϵ,r/ϵ,r2/ϵ,η]*ϵ,r],D[x[t/ϵ,t2/ϵ,r/ϵ,r2/ϵ,η]*ϵ^2,{r,2}]:>D[x2[t/ϵ,t2/ϵ,r/ϵ,r2/ϵ,η]*ϵ^2,{r,2}],D[x[t/ϵ,t2/ϵ,r/ϵ,r2/ϵ,η]*ϵ,r2]:>D[x2[t/ϵ,t2/ϵ,r/ϵ,r2/ϵ,η]*ϵ,r2],D[x[t/ϵ,t2/ϵ,r/ϵ,r2/ϵ,η]*ϵ^2,{r2,2}]:>D[x2[t/ϵ,t2/ϵ,r/ϵ,r2/ϵ,η]*ϵ^2,{r2,2}],D[x[t/ϵ,t2/ϵ,r/ϵ,r2/ϵ,η],η]:>D[x2[t/ϵ,t2/ϵ,r/ϵ,r2/ϵ,η],η],D[x[t/ϵ,t2/ϵ,r/ϵ,r2/ϵ,η],{η,2}]:>D[x2[t/ϵ,t2/ϵ,r/ϵ,r2/ϵ,η],{η,2}]}

q[r_]:=h[r]*p[r]^2/f[r];

box[A_]:=-1/h[r]*D[A,{t,2}]+1/(2*h[r]*p[r]^2)*D[q[r],r]*D[A,r]+1/f[r]*D[A,{r,2}]-2*(η*ϵ^2+1)/p[r]*D[A,η]/ϵ^2-(2η*ϵ^2+(η*ϵ^2)^2)/p[r]*D[A,{η,2}]/ϵ^4;

box2[A_]:=-1/h[r2]*D[A,{t2,2}]+1/(2*h[r2]*p[r2]^2)*D[q[r2],r2]*D[A,r2]+1/f[r2]*D[A,{r2,2}]-2*(η*ϵ^2+1)/p[r2]*D[A,η]/ϵ^2-(2η*ϵ^2+(η*ϵ^2)^2)/p[r2]*D[A,{η,2}]/ϵ^4;

dAdB[A_,B_]:=-1/h[r]*D[A,t]*D[B,t]+1/f[r]*D[A,r]*D[B,r]-(2*η*ϵ^2+η^2*ϵ^4)/p[r]*D[A,η]*D[B,η]/ϵ^4;

dAdB2[A_,B_]:=-1/h[r2]*D[A,t2]*D[B,t2]+1/f[r2]*D[A,r2]*D[B,r2]-(2*η*ϵ^2+η^2*ϵ^4)/p[r2]*D[A,η]*D[B,η]/ϵ^4;

Mp[A_,B_,s_,k_]:=Sum[(Subscript[A, i,j])*(Subscript[B, s-i,k-j]),{i,-8,-ordn},{j,0,k}]//Expand;

u[t_,t2_,r_,r2_,η_]:=Series[U[t,r,η]/.prule,{ϵ,0,ordn+8}]//Normal//Expand;

s[t_,t2_,r_,r2_,η_]:=x[t/ϵ,t2/ϵ,r/ϵ,r2/ϵ,η]*ϵ^2+σ3[t,r,η]/.prule;

(*Initialization*)
For[i=-20,i≤20,i++,
For[j=0,j≤4,j++,
(Subscript[G, i,j])=0;
(Subscript[G1000, i,j])=0;
(Subscript[G0100, i,j])=0;
(Subscript[G1100, i,j])=0;
(Subscript[G0010, i,j])=0;
(Subscript[G0001, i,j])=0;
(Subscript[G0011, i,j])=0;
(Subscript[G1010, i,j])=0;
(Subscript[G1001, i,j])=0;
(Subscript[G1011, i,j])=0;
(Subscript[G0110, i,j])=0;
(Subscript[G0101, i,j])=0;
(Subscript[G0111, i,j])=0;
(Subscript[G1110, i,j])=0;
(Subscript[G1101, i,j])=0;
(Subscript[G1111, i,j])=0;
(Subscript[Gsq, i,j])=0;
(Subscript[bG, i,j])=0;
(Subscript[bpG, i,j])=0;
(Subscript[bbpG, i,j])=0;
];
];

Grn=Series[1/(8*Pi^2)*(u[t,t2,r,r2,η]/s[t,t2,r,r2,η]+u[t,t2,r,r2,η]*κ^2/6+u[t,t2,r,r2,η]*κ^4/180*(-2dt[t/ϵ-t2/ϵ]^2*ϵ^2-s[t,t2,r,r2,η]))/.uprule//Expand,{ϵ,0,ordn+6}]/.dnrule//Normal//Expand;

For[i=-2,i≤ordn+6,i++,
For[j=0,j≤4,j++,
(Subscript[G, i,j])=Coefficient[Coefficient[Grn,κ,j],ϵ,i]*κ^j*ϵ^i//Expand;
(*Print[(Subscript[G, i,j])];*)
];
];

y1rule={η->Y[θ/ϵ,θ2/ϵ,ϕ/ϵ,ϕ2/ϵ]};
y2rule={Y[θ/ϵ,θ2/ϵ,ϕ/ϵ,ϕ2/ϵ]->η};

Clear[i,j,k];
For[i=1,i≤4,i++,
For[j=1,j≤4,j++,
For[k=1,k≤4,k++,
(Subscript[A, i,j,k])=0;
(Subscript[Ap, i,j,k])=0;
];
(Subscript[R, i,j])=0;
(Subscript[Rp, i,j])=0;
(Subscript[g, i,j])=0;
(Subscript[gp, i,j])=0;
];
];
(Subscript[A, 1,3,3])=3*M*Sin[θ]^2 - r*Sin[θ]^2;
(Subscript[A, 3,2,3])=Cot[θ];
(Subscript[A, 3,3,2])=Cot[θ];
(Subscript[A, 1,2,2])=3*M - r;
(Subscript[A, 3,3,1])=(3*M - r)/((2*M - r)*r);
(Subscript[A, 3,1,3])=(3*M - r)/((2*M - r)*r);
(Subscript[A, 2,3,3])=-(Cos[θ]*Sin[θ]);
(Subscript[A, 2,2,1])=(3*M - r)/((2*M - r)*r);
(Subscript[A, 2,1,2])=(3*M - r)/((2*M - r)*r);
(Subscript[A, 1,1,1])=(2*M)/((2*M - r)*r);

(Subscript[Ap, 1,3,3])=3*M*Sin[θ2]^2 - r2*Sin[θ2]^2;
(Subscript[Ap, 3,2,3])=Cot[θ2];
(Subscript[Ap, 3,3,2])=Cot[θ2];
(Subscript[Ap, 1,2,2])=3*M - r2;
(Subscript[Ap, 3,3,1])=(3*M - r2)/((2*M - r2)*r2);
(Subscript[Ap, 3,1,3])=(3*M - r2)/((2*M - r2)*r2);
(Subscript[Ap, 2,3,3])=-(Cos[θ2]*Sin[θ2]);
(Subscript[Ap, 2,2,1])=(3*M - r2)/((2*M - r2)*r2);
(Subscript[Ap, 2,1,2])=(3*M - r2)/((2*M - r2)*r2);
(Subscript[Ap, 1,1,1])=(2*M)/((2*M - r2)*r2);

(Subscript[R, 1,1])=(2*(3*M^2 - 2*M*r))/((2*M - r)^2*r^2);
(Subscript[R, 2,2])=(2*(3*M^2 - M*r))/((2*M - r)*r);
(Subscript[R, 3,3])=(2*(3*M^2*Sin[θ]^2 - M*r*Sin[θ]^2))/((2*M - r)*r);

(Subscript[Rp, 1,1])=(2*(3*M^2 - 2*M*r2))/((2*M - r2)^2*r2^2);
(Subscript[Rp, 2,2])=(2*(3*M^2 - M*r2))/((2*M - r2)*r2);
(Subscript[Rp, 3,3])=(2*(3*M^2*Sin[θ2]^2 - M*r2*Sin[θ2]^2))/((2*M - r2)*r2);

(Subscript[g, 1,1])=1/b[r]^2
(Subscript[g, 2,2])=r^2/b[r];
(Subscript[g, 3,3])=r^2*Sin[θ]^2/b[r];
(Subscript[g, 4,4])=-1;

(Subscript[gp, 1,1])=1/b[r2]^2
(Subscript[gp, 2,2])=r2^2/b[r2];
(Subscript[gp, 3,3])=r2^2*Sin[θ2]^2/b[r2];
(Subscript[gp, 4,4])=-1;

Grn1000=D[Grn/.y1rule,(Subscript[v, 1])]/.y2rule/.xrule/.drule//Expand;
Grn0100=D[Grn/.y1rule,(Subscript[v, 2])]/.y2rule/.xrule/.drule//Expand;
Grn1100=(D[Grn1000/.y1rule,(Subscript[v, 2])]-Sum[(Subscript[A, i,c[[1]],c[[2]]])*D[Grn/.y1rule,c1[[i]]],{i,1,4}])/.y2rule/.xrule/.drule//Expand;
Grn0010=D[Grn/.y1rule,(Subscript[v, 3])]/.y2rule/.xrule/.drule//Expand;
Grn0001=D[Grn/.y1rule,(Subscript[v, 4])]/.y2rule/.xrule/.drule//Expand;
Grn0011=(D[Grn0010/.y1rule,(Subscript[v, 4])]-Sum[(Subscript[Ap, i,c[[3]],c[[4]]])*D[Grn/.y1rule,c2[[i]]],{i,1,4}])/.y2rule/.xrule/.drule//Expand;
Grn1010=D[Grn1000/.y1rule,(Subscript[v, 3])]/.y2rule/.xrule/.drule//Expand;
Grn1001=D[Grn1000/.y1rule,(Subscript[v, 4])]/.y2rule/.xrule/.drule//Expand;
Grn1011=(D[Grn1010/.y1rule,(Subscript[v, 4])]-Sum[(Subscript[Ap, i,c[[1]],c[[2]]])*D[Grn1000/.y1rule,c2[[i]]],{i,1,4}])/.y2rule/.xrule/.drule//Expand;
Grn0110=D[Grn0100/.y1rule,(Subscript[v, 3])]/.y2rule/.xrule/.drule//Expand;
Grn0101=D[Grn0100/.y1rule,(Subscript[v, 4])]/.y2rule/.xrule/.drule//Expand;
Grn0111=(D[Grn0110/.y1rule,(Subscript[v, 4])]-Sum[(Subscript[Ap, i,c[[1]],c[[2]]])*D[Grn0100/.y1rule,c2[[i]]],{i,1,4}])/.y2rule/.xrule/.drule//Expand;
Grn1110=D[Grn1100/.y1rule,(Subscript[v, 3])]/.y2rule/.xrule/.drule//Expand;
Grn1101=D[Grn1100/.y1rule,(Subscript[v, 4])]/.y2rule/.xrule/.drule//Expand;
Grn1111=(D[Grn1110/.y1rule,(Subscript[v, 4])]-Sum[(Subscript[Ap, i,c[[1]],c[[2]]])*D[Grn1100/.y1rule,c2[[i]]],{i,1,4}])/.y2rule/.xrule/.drule//Expand;

(*Derivatives*)
For[i=-8,i≤ordn+6,i++,
For[j=0,j≤4,j++,
(Subscript[G1000, i,j])=Coefficient[Coefficient[Grn1000,κ,j],ϵ,i]*κ^j*ϵ^i//Expand;
(Subscript[G0100, i,j])=Coefficient[Coefficient[Grn0100,κ,j],ϵ,i]*κ^j*ϵ^i//Expand;
(Subscript[G1100, i,j])=Coefficient[Coefficient[Grn1100,κ,j],ϵ,i]*κ^j*ϵ^i//Expand;
(Subscript[G0010, i,j])=Coefficient[Coefficient[Grn0010,κ,j],ϵ,i]*κ^j*ϵ^i//Expand;
(Subscript[G0001, i,j])=Coefficient[Coefficient[Grn0001,κ,j],ϵ,i]*κ^j*ϵ^i//Expand;
(Subscript[G0011, i,j])=Coefficient[Coefficient[Grn0011,κ,j],ϵ,i]*κ^j*ϵ^i//Expand;
(Subscript[G1010, i,j])=Coefficient[Coefficient[Grn1010,κ,j],ϵ,i]*κ^j*ϵ^i//Expand;
(Subscript[G1001, i,j])=Coefficient[Coefficient[Grn1001,κ,j],ϵ,i]*κ^j*ϵ^i//Expand;
(Subscript[G1011, i,j])=Coefficient[Coefficient[Grn1011,κ,j],ϵ,i]*κ^j*ϵ^i//Expand;
(Subscript[G0110, i,j])=Coefficient[Coefficient[Grn0110,κ,j],ϵ,i]*κ^j*ϵ^i//Expand;
(Subscript[G0101, i,j])=Coefficient[Coefficient[Grn0101,κ,j],ϵ,i]*κ^j*ϵ^i//Expand;
(Subscript[G0111, i,j])=Coefficient[Coefficient[Grn0111,κ,j],ϵ,i]*κ^j*ϵ^i//Expand;
(Subscript[G1110, i,j])=Coefficient[Coefficient[Grn1110,κ,j],ϵ,i]*κ^j*ϵ^i//Expand;
(Subscript[G1101, i,j])=Coefficient[Coefficient[Grn1101,κ,j],ϵ,i]*κ^j*ϵ^i//Expand;
(Subscript[G1111, i,j])=Coefficient[Coefficient[Grn1111,κ,j],ϵ,i]*κ^j*ϵ^i//Expand;
];
];

(Subscript[G1000, -3,0])

D[1/(x[t/ϵ,t2/ϵ,r/ϵ,r2/ϵ,η]*ϵ^2),t]/.xrule/.drule

For[i=-4,i≤ordn+4,i++,
For[j=0,j≤4,j++,
(Subscript[Gsq, i,j])=Mp[G,G,i,j];
];
];

bGrn=Series[box[Grn]/.xrule/.drule/.uprule//Expand,{ϵ,0,ordn+4}]/.dnrule//Normal//Expand;
bpGrn=Series[box2[Grn]/.xrule/.drule/.uprule//Expand,{ϵ,0,ordn+4}]/.dnrule//Normal//Expand;

bbpGrn=Series[box[bpGrn]/.xrule/.drule/.uprule//Expand,{ϵ,0,ordn+2}]/.dnrule//Normal//Expand;

For[i=-8,i≤ordn+4,i++,
For[j=0,j≤4,j++,
(Subscript[bG, i,j])=Coefficient[Coefficient[bGrn,κ,j],ϵ,i]*κ^j*ϵ^i//Expand;
(Subscript[bpG, i,j])=Coefficient[Coefficient[bpGrn,κ,j],ϵ,i]*κ^j*ϵ^i//Expand;
(Subscript[bbpG, i,j])=Coefficient[Coefficient[bbpGrn,κ,j],ϵ,i]*κ^j*ϵ^i//Expand;
];
];

N4=Table[0,{i,10}]

GsqS=Sum[(Subscript[Gsq, i,ordk]),{i,-8,0}];
N4[[1]]=Series[1/2*box[box2[GsqS]/.xrule/.drule]/.xrule/.drule/.uprule,{ϵ,0,ordn}]/.dnrule//Normal//Expand

N4[[2]]=3*Sum[(Subscript[bG, i,j])*(Subscript[bpG, k-i,ordk-j]),{i,-8,ordn+6},{j,0,4},{k,-8,-4}]//Expand

N4[[3]]=3*Sum[(Subscript[G, i,j])*(Subscript[bbpG, k-i,ordk-j]),{i,-8,ordn+6},{j,0,4},{k,-8,-4}]//Expand

N4[[4]]=Series[-6*Sum[dAdB2[(Subscript[bG, i,j]),(Subscript[G, k-i,ordk-j])],{i,-8,ordn+6},{j,0,4},{k,-6,-2}]/.xrule/.drule/.uprule//Expand,{ϵ,0,ordn}]/.dnrule//Normal//Expand

N4[[5]]=Series[-6*Sum[dAdB[(Subscript[bpG, i,j]),(Subscript[G, k-i,ordk-j])],{i,-8,ordn+6},{j,0,4},{k,-6,-2}]/.xrule/.drule/.uprule//Expand,{ϵ,0,ordn}]/.dnrule//Normal//Expand

N4[[6]]=Series[R[r]*Sum[dAdB2[(Subscript[G, i,j]),(Subscript[G, k-i,ordk-j])],{i,-8,ordn+6},{j,0,4},{k,-6,-2}]/.xrule/.drule/.uprule//Expand,{ϵ,0,ordn}]/.dnrule//Normal//Expand

N4[[7]]=Series[R[r2]*Sum[dAdB[(Subscript[G, i,j]),(Subscript[G, k-i,ordk-j])],{i,-8,ordn+6},{j,0,4},{k,-6,-2}]/.xrule/.drule/.uprule//Expand,{ϵ,0,ordn}]/.dnrule//Normal//Expand

N4[[8]]=-2*R[r]*Sum[(Subscript[G, i,j])*(Subscript[bpG, k-i,ordk-j]),{i,-8,ordn+6},{j,0,4},{k,-8,-4}]//Expand

N4[[9]]=-2*R[r2]*Sum[(Subscript[G, i,j])*(Subscript[bG, k-i,ordk-j]),{i,-8,ordn+6},{j,0,4},{k,-8,-4}]//Expand

N4[[10]]=Series[1/2*R[r]*R[r2]*GsqS/.xrule/.drule/.uprule//Expand,{ϵ,0,ordn}]/.dnrule//Normal//Expand

N2=Table[0,{i,11}]
N2p=Table[0,{i,11}]

N2[[1]]=Series[-8*Sum[dAdB2[(Subscript[G0100, i,j]),(Subscript[G1000, k-i,ordk-j])],{i,-8,ordn+6},{j,0,4},{k,-6,-2}]/.xrule/.drule/.uprule//Expand,{ϵ,0,ordn}]/.dnrule//Normal//Expand

N2p[[1]]=Series[-8*Sum[dAdB[(Subscript[G0010, i,j]),(Subscript[G0001, k-i,ordk-j])],{i,-8,ordn+6},{j,0,4},{k,-6,-2}]
/.xrule/.drule/.uprule//Expand,{ϵ,0,ordn}]/.dnrule//Normal//Expand

N2[[2]]=Series[8*Sum[(Subscript[G0100, i,j])*box2[(Subscript[G1000, k-i,ordk-j])],{i,-8,ordn+6},{j,0,4},{k,-6,-2}]/.xrule/.drule/.uprule//Expand,{ϵ,0,ordn}]/.dnrule//Normal//Expand

N2p[[2]]=Series[8*Sum[(Subscript[G0001, i,j])*box[(Subscript[G0010, k-i,ordk-j])],{i,-8,ordn+6},{j,0,4},{k,-6,-2}]/.xrule/.drule/.uprule//Expand,{ϵ,0,ordn}]/.dnrule//Normal//Expand

N2[[3]]=Series[8*Sum[(Subscript[G1000, i,j])*box2[(Subscript[G0100, k-i,ordk-j])],{i,-8,ordn+6},{j,0,4},{k,-6,-2}]
/.xrule/.drule/.uprule//Expand,{ϵ,0,ordn}]/.dnrule//Normal//Expand

N2p[[3]]=Series[8*Sum[(Subscript[G0010, i,j])*box[(Subscript[G0001, k-i,ordk-j])],{i,-8,ordn+6},{j,0,4},{k,-6,-2}]
/.xrule/.drule/.uprule//Expand,{ϵ,0,ordn}]/.dnrule//Normal//Expand

N2[[4]]=Series[4*Sum[dAdB2[(Subscript[G, i,j]),(Subscript[G1100, k-i,ordk-j])],{i,-8,ordn+6},{j,0,4},{k,-6,-2}]
/.xrule/.drule/.uprule//Expand,{ϵ,0,ordn}]/.dnrule//Normal//Expand

N2p[[4]]=Series[4*Sum[dAdB[(Subscript[G, i,j]),(Subscript[G0011, k-i,ordk-j])],{i,-8,ordn+6},{j,0,4},{k,-6,-2}]
/.xrule/.drule/.uprule//Expand,{ϵ,0,ordn}]/.dnrule//Normal//Expand

N2[[5]]=Series[-4*Sum[box2[(Subscript[G, i,j])]*(Subscript[G1100, k-i,ordk-j]),{i,-8,ordn+6},{j,0,4},{k,-6,-2}]
/.xrule/.drule/.uprule//Expand,{ϵ,0,ordn}]/.dnrule//Normal//Expand

N2p[[5]]=Series[-4*Sum[box[(Subscript[G, i,j])]*(Subscript[G0011, k-i,ordk-j]),{i,-8,ordn+6},{j,0,4},{k,-6,-2}]
/.xrule/.drule/.uprule//Expand,{ϵ,0,ordn}]/.dnrule//Normal//Expand

N2[[6]]=Series[-4*Sum[(Subscript[G, i,j])*box2[(Subscript[G1100, k-i,ordk-j])],{i,-8,ordn+6},{j,0,4},{k,-6,-2}]
/.xrule/.drule/.uprule//Expand,{ϵ,0,ordn}]/.dnrule//Normal//Expand

N2p[[6]]=Series[-4*Sum[(Subscript[G, i,j])*box[(Subscript[G0011, k-i,ordk-j])],{i,-8,ordn+6},{j,0,4},{k,-6,-2}]
/.xrule/.drule/.uprule//Expand,{ϵ,0,ordn}]/.dnrule//Normal//Expand

N2[[7]]=-2*R[r2]*Sum[(Subscript[G1000, i,j])*(Subscript[G0100, k-i,ordk-j]),{i,-8,ordn+6},{j,0,4},{k,-8,-4}]//Expand

N2p[[7]]=-2*R[r]*Sum[(Subscript[G0010, i,j])*(Subscript[G0001, k-i,ordk-j]),{i,-8,ordn+6},{j,0,4},{k,-8,-4}]//Expand

N2[[8]]=2*R[r2]*Sum[(Subscript[G, i,j])*(Subscript[G1100, k-i,ordk-j]),{i,-8,ordn+6},{j,0,4},{k,-8,-4}]//Expand

N2p[[8]]=2*R[r]*Sum[(Subscript[G, i,j])*(Subscript[G0011, k-i,ordk-j]),{i,-8,ordn+6},{j,0,4},{k,-8,-4}]//Expand

N2[[9]]=Series[-2*(Subscript[R, c[[1]],c[[2]]])*Sum[dAdB2[(Subscript[G, i,j]),(Subscript[G, k-i,ordk-j])],{i,-8,ordn+6},{j,0,4},{k,-6,-2}]
/.xrule/.drule/.uprule//Expand,{ϵ,0,ordn}]/.dnrule//Normal//Expand

N2p[[9]]=Series[-2*(Subscript[Rp, c[[3]],c[[4]]])*Sum[dAdB[(Subscript[G, i,j]),(Subscript[G, k-i,ordk-j])],{i,-8,ordn+6},{j,0,4},{k,-6,-2}]
/.xrule/.drule/.uprule//Expand,{ϵ,0,ordn}]/.dnrule//Normal//Expand

N2[[10]]=Series[4*(Subscript[R, c[[1]],c[[2]]])*Sum[(Subscript[G, i,j])*box2[(Subscript[G, k-i,ordk-j])],{i,-8,ordn+6},{j,0,4},{k,-6,-2}]
/.xrule/.drule/.uprule//Expand,{ϵ,0,ordn}]/.dnrule//Normal//Expand

N2[[10]]=Series[4*(Subscript[Rp, c[[3]],c[[4]]])*Sum[(Subscript[G, i,j])*box[(Subscript[G, k-i,ordk-j])],{i,-8,ordn+6},{j,0,4},{k,-6,-2}]
/.xrule/.drule/.uprule//Expand,{ϵ,0,ordn}]/.dnrule//Normal//Expand

N2[[11]]=-R[r2]*(Subscript[R, c[[1]],c[[2]]])*GsqS//Expand

N2p[[11]]=-R[r]*(Subscript[Rp, c[[3]],c[[4]]])*GsqS//Expand

N0=Table[0,{i,13}]

N0[[1]]=4*Sum[(Subscript[G0110, i,j])*(Subscript[G1001, k-i,ordk-j]),{i,-8,ordn+6},{j,0,4},{k,-8,-4}]//Expand

N0[[2]]=4*Sum[(Subscript[G1010, i,j])*(Subscript[G0101, k-i,ordk-j]),{i,-8,ordn+6},{j,0,4},{k,-8,-4}]//Expand//Expand

N0[[3]]=Sum[(Subscript[G1100, i,j])*(Subscript[G0011, k-i,ordk-j]),{i,-8,ordn+6},{j,0,4},{k,-8,-4}]//Expand

N0[[4]]=Sum[(Subscript[G, i,j])*(Subscript[G1111, k-i,ordk-j]),{i,-8,ordn+6},{j,0,4},{k,-8,-4}]//Expand

N0[[5]]=Sum[-2*(Subscript[G0100, i,j])*(Subscript[G1011, k-i,ordk-j]),{i,-8,ordn+6},{j,0,4},{k,-8,-4}]//Expand

N0[[6]]=Sum[-2*(Subscript[G1000, i,j])*(Subscript[G0111, k-i,ordk-j]),{i,-8,ordn+6},{j,0,4},{k,-8,-4}]//Expand

N0[[7]]=Sum[-2*(Subscript[G0001, i,j])*(Subscript[G1110, k-i,ordk-j]),{i,-8,ordn+6},{j,0,4},{k,-8,-4}]//Expand

N0[[8]]=Sum[-2*(Subscript[G0010, i,j])*(Subscript[G1101, k-i,ordk-j]),{i,-8,ordn+6},{j,0,4},{k,-8,-4}]//Expand

N0[[9]]=2*(Subscript[Rp, c[[3]],c[[4]]])*Sum[(Subscript[G1000, i,j])*(Subscript[G0100, k-i,ordk-j]),{i,-8,ordn+6},{j,0,4},{k,-8,-4}]//Expand

N0[[10]]=2*(Subscript[R, c[[1]],c[[2]]])*Sum[(Subscript[G0010, i,j])*(Subscript[G0001, k-i,ordk-j]),{i,-8,ordn+6},{j,0,4},{k,-8,-4}]//Expand

N0[[11]]=-(Subscript[Rp, c[[3]],c[[4]]])*Sum[(Subscript[G1100, i,j])*(Subscript[G, k-i,ordk-j]),{i,-8,ordn+6},{j,0,4},{k,-8,-4}]//Expand

N0[[12]]=-(Subscript[R, c[[1]],c[[2]]])*Sum[(Subscript[G0011, i,j])*(Subscript[G, k-i,ordk-j]),{i,-8,ordn+6},{j,0,4},{k,-8,-4}]//Expand

N0[[13]]=(Subscript[Rp, c[[3]],c[[4]]])*(Subscript[R, c[[1]],c[[2]]])*Sum[(Subscript[G, i,j])*(Subscript[G, k-i,ordk-j]),{i,-8,ordn+6},{j,0,4},{k,-8,-4}]//Expand

aprule={dr[r/ϵ-r2/ϵ]->dr[r/ϵ],dt[t/ϵ-t2/ϵ]->dt[t/ϵ],dt[(t-t2)/ϵ]->dt[t/ϵ],x[t/ϵ,t2/ϵ,r/ϵ,r2/ϵ,η]->x[t/ϵ,r/ϵ,η]}
r2rule={r2->r-ϵ*dr[r/ϵ]}
up2rule={dr[r/ϵ]->dr[r],dt[t/ϵ]->dt[t],x[t/ϵ,r/ϵ,η]->x[t,r,η]}
dn2rule={dr[r]->dr[r/ϵ],dt[t]->dt[t/ϵ],x[t,r,η]->x[t/ϵ,r/ϵ,η]}

b[r_]:=1-2*M/r;

Clear[i]
NKcomp=Sum[N0[[i]]/72,{i,1,13}]+(Subscript[gp, c[[3]],c[[4]]])*Sum[N2[[i]]/288,{i,1,11}]+(Subscript[g, c[[1]],c[[2]]])*Sum[N2p[[i]]/288,{i,1,11}]+(Subscript[g, c[[1]],c[[2]]])*(Subscript[gp, c[[3]],c[[4]]])*Sum[N4[[i]]/288,{i,1,10}]/.aprule/.r2rule/.up2rule/.uprule//Expand

Series[NKcomp,{ϵ,0,ordn}]//Normal//Expand//Simplify

%/.erule//Simplify

x2rule={x[t,r,η]->σ2[t,r,η]/.erule}

NkoottK4den=(414720 (π^4) (((2 M-r))^5) ((x[t,r,η])^5))

NkoottK4num=((r^3) (κ^4) (3 (((-2 M+r))^2) ((dt[t])^4) (-8 (r^2) ((dr[r])^2)+(2 M-r) (-16 (r^3) η+21 (2 M-r) x[t,r,η]))+3 ((dt[t])^2) (8 (r^4) ((dr[r])^4)-(2 M-r) (r^2) ((dr[r])^2) (-8 (r^3) (4 η+((Derivative[1,0,0,0][Y][θ,θ2,ϕ,ϕ2])^2))+(2 M-r) x[t,r,η] (27+2 Derivative[2,0,0,0][Y][θ,θ2,ϕ,ϕ2]))+(((-2 M+r))^2) (16 (r^6) η (2 η+((Derivative[1,0,0,0][Y][θ,θ2,ϕ,ϕ2])^2))+(((-2 M+r))^2) ((x[t,r,η])^2) (30+7 Derivative[2,0,0,0][Y][θ,θ2,ϕ,ϕ2])-(2 M-r) (r^3) x[t,r,η] (54 η+21 ((Derivative[1,0,0,0][Y][θ,θ2,ϕ,ϕ2])^2)+4 η Derivative[2,0,0,0][Y][θ,θ2,ϕ,ϕ2])))-x[t,r,η] (18 (r^4) ((dr[r])^4)-(2 M-r) (r^2) ((dr[r])^2) (-9 (r^3) (8 η+3 ((Derivative[1,0,0,0][Y][θ,θ2,ϕ,ϕ2])^2))+(2 M-r) x[t,r,η] (32+3 Derivative[2,0,0,0][Y][θ,θ2,ϕ,ϕ2]))+2 (((-2 M+r))^2) (3 (((-2 M+r))^2) ((x[t,r,η])^2)+9 (r^6) η (4 η+3 ((Derivative[1,0,0,0][Y][θ,θ2,ϕ,ϕ2])^2))-(2 M-r) (r^3) x[t,r,η] (9 ((Derivative[1,0,0,0][Y][θ,θ2,ϕ,ϕ2])^2)+η (32+3 Derivative[2,0,0,0][Y][θ,θ2,ϕ,ϕ2]))))))/.x2rule//Simplify

NKoottK4simp=NkoottK4num/NkoottK4den//Simplify

brule={M->(1-b)*r/2};

NKoottK4simp/.brule//Simplify