Computation for SRW integrals

Computions for the Analysis of Section 3.5

Robert Fitzner

This is a  supplementary document to the PhD-thesis of Robert Fitzner. In this thesis a technique, called non-backtracking lace expansion (NoBLE) is derived. The NoBLE was created by Remco van der Hofstad and the author to prove mean-field behavior for self-avoiding walk, lattice tree (LT), lattice animals (LA) and percolation. The proof is computer-assisted and this file is part of the implementation of the computation neccessary for the analysis explained in Section 3.5 of the thesis of the author. For the analysis of Section 3.5 we create two files. One file contains simple random walk (SRW) integrals and another file uses these bounds to compute the bounds required for the analysis. In this file we implement the computation of the SRW- integrals and give functions to perform the improvement of bounds, explained in Section 3.6.

We will uses this file for LT, LA and percolation. Each of these models has a seperate notebook that performs the estimates on the lace expansion coefficients, that together with this file, complete numerical part of the proof. In this document we compute SRW-integrals that depend only on the dimension, so that the only input is the dimension. These computations of SRW-integrals are explain in Section 5.2 and are based uppon techniques of Takashi Hara and Gordon Slade “The lace expansion for self-avoiding walk in five or more dimensions.” (1991). A the end of the document we further implement methods/functions that compute the bounds of Section 3.6.4.

24.1.2014

Input

The dimension in which we perfrom the computations

d=20;
param=4; (*param=4, percolation , param=5 LT and LA*)

We compute the SRW-Bubbles, SRW-triangle, SRW-square and SRW-pentagon, and prescribe a precision of 20 digits. The SRW-pentagon is only finite for dimensions d≥11 and Mathematica guarantees the prescibed precision only for d≥17. This is sufficient for LT and LA as the NoBLE works for these models only in d≥20. For percolation we do not require the SRW-pentagons. So we choose for percolation param=5, then the pentagon are not computed and the precision is garanteed by Mathematica for d≥15.

Simple Random Walk integral (Subscript[I, n,l])(x)

We compute the two-point function of the simple random walk,

(Subscript[I, n,l])(x)=(∫_([ -ℼ,ℼ]))(e^(ik x))((((OverHat[D])^l) (k))/(((1-(OverHat[D])(k)))^n))(((d^d)k)/(((2π))^d))

see Section 5.2, using that

(Subscript[I, n,l])(x)=(Subscript[I, n,(l-1)])(x)-(Subscript[I, (n-1),(l-1)])(x)
(Subscript[I, n,0])(x)=(1/((n-1)!))(∫_0^∞)(t^(n-1))(∏_(i=1)^d)(∫_(-π)^π)(e^(-t/d(1-cos((Subscript[k, i]))))(e^((Subscript[ιk, i])(Subscript[x, i])))(dk/(2π)) =(1/((n-1)!))(∫_0^∞)(t^(n-1))(∏_(i=1)^d)F(t,d,(Abs[(Subscript[x, i])]))

where F(t,d,n) is the modified Besselfunction. We implement the Besselfunciton and a function to compute (Subscript[I, n,0])(x).

F[t_,d_,N_]:= (E^(-(t/d))) BesselI[N,(t/d)];
NIntproto[n_,d_,T_]:=1/((n-1)!)*NIntegrate[t^(n-1)*(F[t,d,0])^(d),{t,0,T},WorkingPrecision->20];
NIntproto2[n_,d_,T_,vecn_]:=1/((n-1)!)*NIntegrate[t^(n-1)*(F[t,d,0])^(d-Sum[vecn[[i]],{i,1,4}])*(F[t,d,1])^(vecn[[1]])*(F[t,d,2])^(vecn[[2]])*(F[t,d,3])^(vecn[[3]])*(F[t,d,4])^vecn[[4]],{t,0,T},WorkingPrecision->10];
SRWInt[n_,dim_,vecn_]:=If[vecn=={0,0,0,0},NIntproto[n,dim,∞],NIntproto2[n,dim,∞,vecn]];

We compute the value of (Subscript[I, n,l])(x) for the following values of x:

NvecZero={0,0,0,0};(* x=0 *)
Nvecei={1,0,0,0}; (* x= (Subscript[e, 1]) *)
Nvectwoei={0,1,0,0}; (* x=2 (Subscript[e, 1]) *)
Nvectthreeei={0,0,1,0}; (* x=3 (Subscript[e, 1]) *)
Nvectfourei={0,0,0,1}; (* x=4 (Subscript[e, 1]) *)
Nveceiek={2,0,0,0}; (* x= (Subscript[e, 1])+(Subscript[e, 2]) *)
Nvectwoeitwoek={0,2,0,0}; (* x=2 (Subscript[e, 1])+2 (Subscript[e, 2]) *)
Nvectwoeiek={1,1,0,0}; (* x=2 (Subscript[e, 1])+(Subscript[e, 2]) *)
Nvecthreeeiek={1,0,1,0}; (* x=3 (Subscript[e, 1])+(Subscript[e, 2]) *)
Nvectwoeiekep={2,1,0,0}; (* x=2 (Subscript[e, 1])+(Subscript[e, 2])+(Subscript[e, 3]) *)
Nvecteiekepej={4,0,0,0};(* x= (Subscript[e, 1])+(Subscript[e, 2])+(Subscript[e, 3])+(Subscript[e, 4]) *)
NVecAll={NvecZero,Nvecei,Nvectwoei,Nvectthreeei,Nvectfourei,Nveceiek,Nvectwoeiekep,Nvectwoeitwoek,Nvectwoeiek,Nvecthreeeiek,Nvecteiekepej};

You will notice that we save the coordinates of x not in the usual vector. Instead we only remember the number of entries with a given value. For example we save x=2(Subscript[e, 1])+(Subscript[e, 2])+(Subscript[e, 3]) as {2,1,0,0} as it has two entries/dimension with a factor 1 and one entry with a value of 2. We choose this format for the points x as the value of (Subscript[I, n,l])(x) only depends on this information, see definition of NIntproto2[n_,d_,T_,vecn_] above.

We compute the number of n-step SRW ending at these points as explain in Section 5.2.2

Do[Do[sv[m,v]=0,{m,0,12}],{v,NVecAll}]
(* s_n(0) *)
sv[0,{0,0,0,0}]=1;
sv[2,{0,0,0,0}]=N[2d];
sv[4,{0,0,0,0}]=N[(d*((4!)/(2 2))+((d(d-1))/2)*4!)];
sv[6,{0,0,0,0}]=N[(d*((6!)/(3!3!))+d*(d-1)*((6!)/(2 2))+((d(d-1)(d-2))/(3!))*6!)];
sv[8,{0,0,0,0}]=N[(d*((8!)/(4!4!))+d*(d-1)*(((8!)/(3!3!))+((8!)/(2^5)))+((d(d-1)(d-2))/2)*((8!)/(2 2))+((d(d-1)(d-2)(d-3))/(4!))*8!)];
sv[10,{0,0,0,0}]=
N[(d*((10!)/(5!5!))+d*(d-1)*(((10!)/(4!4!))+((10!)/(3!3!2!2!)))+d(d-1)(((d-2))/2)(((10!)/(3! 3!))+((10!)/(((2!))^4)))+((d(d-1)(d-2)(d-3))/(3!))*((10!)/(2!2!))+((d(d-1)(d-2)(d-3)(d-4))/(5!))10!)];
sv[12,{0,0,0,0}]=N[(d*((12!)/(6!6!))+d*(d-1)*12!((1/(5!5!))+(1/(4!4!2!2!))+(1/((((3!))^4)2!)))+d(d-1)(d-2)12!((1/(4! 4!2!))+(1/((((3!))^2)(((2!))^2)))+(1/((((2!))^6)3!)))+d(d-1)(d-2)(d-3)12!((1/(3!3!3!))+(1/((((2!))^4)2!2!)))+d(d-1)(d-2)(d-3)(d-4)((12!)/(2!2!4!))+12!((d(d-1)(d-2)(d-3)(d-4)(d-5))/(6!)))];

(* s_n((Subscript[e, 1])) *)
Do[sv[m,{1,0,0,0}]=((sv[m+1,{0,0,0,0}])/(2d)),{m,{1,3,5,7,9,11}}]
(* s_n(2(Subscript[e, 1])) *)
sv[2,{0,1,0,0}]=1;
sv[4,{0,1,0,0}]=((4!)/(3!))+(d-1)((4!)/(2!));
sv[6,{0,1,0,0}]=((6!)/(4!2!))+(d-1)6!((1/(((2!))^3))+(1/(3!)))+(((d-1)(d-2))/2)((6!)/(2!));
sv[8,{0,1,0,0}]=((8!)/(5!3!))+(d-1)8!((1/(3!3!2!))+(1/(2!2!3!))+(1/(4!2!)))+(d-1)(d-2)8!((1/(((2!))^3))+(1/(2 3!)))+(((d-1)(d-2)(d-3))/(3!))((8!)/(2!));
sv[10,{0,1,0,0}]=((10!)/(6!4!))+(d-1)10!((1/(4!4!2!))+(1/(3!3!3!))+(1/(2!2!4!2!))+(1/(5!3!)))+(d-1)(d-2)10!((1/(3!3!2!))+(1/(2!2!))((1/((((2!))^3)2))+(1/(3!)))+(1/(4!2!2)))+(d-1)(d-2)(d-3)10!((1/((((2!))^3)2!))+(1/(3!3!)))+(((d-1)(d-2)(d-3)(d-4))/(4!))((10!)/(2!));
sv[12,{0,1,0,0}]=((12!)/(7!5!))+(d-1)12!((1/(5!5!2!))+(1/(4!4!3!))+(1/(3!3!4!2!))+(1/(2!2!5!3!))+(1/(6!4!)))+(d-1)(d-2)12!((1/(4!4!2!))+(1/(3!3!))((1/(2!2!2!))+(1/(3!)))+(1/(2!2!))((1/((((2!))^3)3!))+(1/(4!2!)))+(1/(2!))(1/(5!3!)))+(d-1)(d-2)(d-3)12!((1/(3!3!2!2!))+(1/(2!2!))((1/((((2!))^3)2!))+(1/(3!2!)))+(1/(3!))(1/(4!2!)))+(d-1)(d-2)(d-3)(d-4)12!((1/(2!2!3!2!))+(1/(4!3!)))+(((d-1)(d-2)(d-3)(d-4)(d-5))/(5!))((12!)/(2!));
(* s_n(3(Subscript[e, 1])) *)
sv[3,{0,0,1,0}]=1;
sv[5,{0,0,1,0}]=((5!)/(4!))+(d-1)((5!)/(3!));
sv[7,{0,0,1,0}]=((7!)/(5!2!))+(d-1)(((7!)/(2!2!3!))+((7!)/(4!)))+(d-1)(d-2)((7!)/(3!2!));
sv[9,{0,0,1,0}]=((9!)/(6!3!))+(d-1)(((9!)/(3!3!3!))+((9!)/(2!2!4!1!))+((9!)/(1!1!5!2!)))+(d-1)(d-2)(((9!)/(2!2!3!))+((9!)/(4!2!)))+(d-1)(d-2)(((d-3)9!)/(3!3!));
sv[11,{0,0,1,0}]=((11!)/(7!4!))+(d-1)11!((1/(4!4!3!))+(1/(3!3!4!1!))+(1/(2!2!5!2!))+(1/(1!1!6!3!)))+(d-1)(d-2)11!((1/(3!3!3!))+(1/(2!2!))((1/(2!2!2!3!))+(1/(4!)))+(1/(2!5!2!)))+(d-1)(d-2)(d-3)11!((1/(2!2!2!3!))+(1/(3!4!)))+(d-1)(d-2)(d-3)(((d-4)11!)/(4!3!));
(* s_n(4(Subscript[e, 1])) *)
sv[4,{0,0,0,1}]=1;
sv[6,{0,0,0,1}]=((6!)/(5!1!))+(d-1)((6!)/(4!));
sv[8,{0,0,0,1}]=((8!)/(6!2!))+(d-1)8!((1/((((2!))^2)4!))+(1/(5!)))+(((d-1)(d-2))/2)((8!)/(4!));
sv[10,{0,0,0,1}]=((10!)/(7!3!))+(d-1)10!((1/(3!3!4!))+(1/(2!2!5!))+(1/(6!2!)))+(d-1)(d-2)10!((1/((((2!))^2)4!))+(1/(2 5!)))+(((d-1)(d-2)(d-3))/(3!))((10!)/(4!));
sv[12,{0,0,0,1}]=((12!)/(8!4!))+(d-1)12!((1/(4!4!4!))+(1/(3!3!5!))+(1/(2!2!6!2!))+(1/(7!3!)))+(d-1)(d-2)12!((1/((((3!))^2)4!))+(1/((((2!))^5)4!))+(1/(2!2!5!))+(1/(2 6!2!)))+(d-1)(d-2)(d-3)12!((1/(2!2!2!4!))+(1/(3!5!)))+(((d-1)(d-2)(d-3)(d-4))/(4!))((12!)/(4!));
(* s_n((Subscript[e, 1])+(Subscript[e, 2])) *)
sv[2,{2,0,0,0}]=2;
sv[4,{2,0,0,0}]=2*((4!)/(2!))+(d-2)4!;
sv[6,{2,0,0,0}]=6!((2/(3!2!))+(1/(((2!))^2)))+(d-2)6!((1/(2!2!))+(2/(2!)))+(d-2)(((d-3))/2)6!;
sv[8,{2,0,0,0}]=2*8!((1/(4!3!))+(1/(3!2!2!1!)))+(d-2)8!((1/(3!3!))+(2/(2!2!2!1!1!))+(1/(((2!1!))^2))+(2/(3!2!)))+(d-2)(d-3)8!((1/(2!2!))+(2/(2!2!)))+(((d-2)(d-3)(d-4))/(3!))8!;
sv[10,{2,0,0,0}]=2*10!((1/(5!4!))+(1/(4!3!2!))+(1/((((3!2!))^2)2!)))+(d-2)10!((1/(4!4!))+(2/(3!3!2!1!1!))+(1/(2!2!2!2!))+(2/(2!2!3!2!))+(2/(4!3!))+(2/(3!2!2!)))+(d-2)(d-3)10!((1/(3!3!))+(1/(((2!))^5))+(2/(2!2!2!))+(2/(2!3!2!))+(1/(2!2!2!)))+(d-2)(d-3)(d-4)10!((1/(2!2!2!))+(2/(3!2!)))+(d-2)(d-3)(d-4)(d-5)((10!)/(4!));
sv[12,{2,0,0,0}]=2*12!((1/(6!5!))+(1/(5!4!2!))+(1/(4!3!3!2!)))+(d-2)12!((1/(5!5!))+(2/(4!4!2!))+(2/(3!3!3!2!))+(1/(3!3!2!2!))+(2/(2!2!4!3!))+(2/(2!2!2!3!2!))+(2/(5!4!))+(2/(4!3!2!))+(1/(3!2!3!2!)))+(d-2)(d-3)12!((1/(4!4!))+(1/(3!3!2!2!))+(2/(3!3!2!))+(2/((((2!))^5)2!))+(1/(((2!))^4))+(2/(2!2!3!2!))+(2/(4!3!2!))+(2/(3!2!2!2!)))+(d-2)(d-3)(d-4)12!((1/(3!3!2!))+(1/(((2!))^5))+(2/(((2!))^4))+(2/(3!2!3!))+(1/(3!2!2!)))+(d-2)(d-3)(d-4)(d-5)12!((1/(2!2!3!))+(2/(4!2!)))+(d-2)(d-3)(d-4)(d-5)(d-6)((12!)/(5!));
(* s_n(2(Subscript[e, 1])+2(Subscript[e, 2])) *)
sv[4,{0,2,0,0}]=((4!)/(2!2!));
sv[6,{0,2,0,0}]=2((6!)/(2!3!))+(d-2)((6!)/(2!2!));
sv[8,{0,2,0,0}]=(((8!)/(3!3!))+((2 8!)/(4!2!2!)))+(d-2)8!((1/(2!2!2!2!))+(2/(3!2!)))+(((d-2)(d-3))/2)((8!)/(2!2!));
sv[10,{0,2,0,0}]=10!((2/(5!3!2!))+(2/(4!2!3!1!)))+(d-2)10!((2/(4!2!2!))+(2/(2!2!3!2!))+(1/(3!3!)))+(d-2)(d-3)10!((1/(((2!))^4))+(2/(3!2!2)))+(d-2)(d-3)(((d-4))/(3!))((10!)/(2!2!));
sv[12,{0,2,0,0}]=12!((2/(5!5!2!))+(2/(4!4!3!))+(1/((4!2!)2!)))+(d-2)12!((1/(4!4!2!2!))+(2/(3!3!3!2!))+(2/(2!2!4!2!))+(1/(2!2!3!3!))+(2/(5!3!2!))+(2/(4!2!3!)))+(d-2)(d-3)12!((1/(2!2!3!2!))+(1/((((2!))^5)2!2!))+(1/(2!2!3!2!))+(2/(4!2!2!))+(1/(3!3!)))+(d-2)(d-3)(d-4)12!((2/(3!2!3!))+(1/(((2!))^5)))+(d-2)(d-3)(d-4)(((d-5))/(4!))((12!)/(2!2!));
(* s_n(2(Subscript[e, 1])+(Subscript[e, 2])) *)
sv[3,{1,1,0,0}]=((3!)/(2!));
sv[5,{1,1,0,0}]=((5!)/(3!))+((5!)/(2!2!))+(d-2)((5!)/(2!));
sv[7,{1,1,0,0}]=7!((1/(4!2!))+(1/(3!2!))+(1/(2!3!2!)))+(d-2)7!((1/(2!2!2!))+(1/(3!))+(1/(2!2!)))+(((d-2)(d-3))/2)((7!)/(2!));
sv[9,{1,1,0,0}]=9!((1/(5!3!))+(1/(4!2!2!))+(1/(3!3!2!))+(1/(2!4!3!)))+(d-2)9!((1/(3!3!2!))+(1/(2!2!3!))+(1/(2!2!2!2!))+(1/(4!2!))+(1/(3!2!))+(1/(2!3!2!)))+(d-2)(d-3)9!((1/(2!2!2!))+(1/(3!2!))+(1/(2!2!2!)))+(((d-2)(d-3)(d-4))/(3!))((9!)/(2!));
sv[11,{1,1,0,0}]=11!((1/(6!4!))+(1/(5!3!2!))+(1/(4!2!3!2!))+(1/(3!4!3!))+(1/(2!5!4!)))+(d-2)11!((1/(4!4!2!))+(1/(3!3!))((1/(3!))+(1/(2!2!)))+(1/(2!2!))((1/(4!2!))+(1/(3!2!))+(1/(2!3!2!)))+(1/(5!3!))+(1/(4!2!2!))+(1/(3!3!2!))+(1/(2!4!3!)))+(d-2)(d-3)11!((1/(3!3!2!))+(1/((((2!))^5)2!))+(1/(2!2!3!))+(1/(2!2!2!2!))+(1/(2!4!2!))+(1/(2!3!2!))+(1/(2!2!3!2!)))+(d-2)(d-3)(d-4)11!((1/(((2!))^4))+(1/(3!3!))+(1/(3!2!2!)))+(((d-2)(d-3)(d-4)(d-5))/(4!))((11!)/(2!));
(* s_n(3(Subscript[e, 1])+(Subscript[e, 2])) *)
sv[4,{1,0,1,0}]=((4!)/(3!));
sv[6,{1,0,1,0}]=6!((1/(4!))+(1/(3!2!)))+(d-2)((6!)/(3!));
sv[8,{1,0,1,0}]=8!((1/(5!2!))+(1/(4!1!2!))+(1/(3!3!2!)))+(d-2)8!((1/(2!2!3!))+(1/(4!))+(1/(3!2!)))+(((d-2)(d-3))/2)((8!)/(3!));
sv[10,{1,0,1,0}]=10!((1/(6!3!))+(1/(5!2!2!))+(1/(4!3!2!))+(1/(3!4!3!)))+(d-2)10!((1/(3!3!3!))+(1/(2!2!4!))+(1/(2!2!3!2!))+(1/(5!2!))+(1/(4!2!))+(1/(3!3!2!)))+(d-2)(d-3)10!((1/(2!2!3!))+(1/(4!2!))+(1/(3!2!2!)))+(d-2)(d-3)(((d-4))/(3!))((10!)/(3!));
sv[12,{1,0,1,0}]=12!((1/(7!4!))+(1/(6!3!2!))+(1/(5!2!3!2!))+(1/(4!1!4!3!))+(1/(3!5!4!)))+(d-2)12!((1/(4!4!3!))+(1/(3!3!))((1/(4!))+(1/(3!2!)))+(1/(2!2!))((1/(5!2!))+(1/(4!2!))+(1/(3!3!2!)))+(1/(6!3!))+(1/(5!2!2!))+(1/(4!3!2!))+(1/(3!4!3!)))+(d-2)(d-3)12!((1/(3!3!3!))+(1/((((2!))^5)3!))+(1/(2!2!))((1/(4!))+(1/(3!2!)))+(1/(2!))((1/(5!2!))+(1/(4!2!))+(1/(3!3!2!))))+(d-2)(d-3)(d-4)12!((1/((((2!))^3)3!))+(1/(3!4!))+(1/(3!3!2!)))+(((d-2)(d-3)(d-4)(d-5))/(4!))((12!)/(3!));
(* s_n(2(Subscript[e, 1])+(Subscript[e, 2])+(Subscript[e, 3])) *)
sv[4,{2,1,0,0}]=((4!)/(2!));
sv[6,{2,1,0,0}]=6!((2/(2!2!))+(1/(3!)))+(d-2)((6!)/(2!));
sv[8,{2,1,0,0}]=8!((2/(3!2!2!))+(1/(2!2!2!))+(2/(2!3!))+(1/(4!2!)))+(d-2)8!((2/(2!2!))+(1/(3!))+(1/(2!2!2!)))+(((d-2)(d-3))/2)((8!)/(2!));
sv[10,{2,1,0,0}]=10!((2/(4!3!2!))+(2/(3!2!2!2!))+(2/(3!3!2!))+(1/(2!2!3!))+(2/(2!4!2!))+(1/(5!3!)))+(d-3)10!((2/(3!2!2!))+(1/(2!2!2!))+(2/(2!3!))+(2/(2!2!2!2!))+(1/(4!2!))+(1/(3!2!2!))+(1/(2!3!3!)))+(d-3)(d-4)10!((2/(2!2!2!))+(1/(3!2!))+(1/(2!2!2!)))+(((d-3)(d-4)(d-5))/(3!))((10!)/(2!));
sv[12,{2,1,0,0}]=12!((1/(6!4!))+(2/(5!3!2!))+(2/(4!2!3!2!))+(1/(4!2!2!2!))+(2/(3!4!3!))+(2/(3!3!2!2!))+(2/(2!5!4!))+(2/(2!4!3!2!))+(1/(2!(((3!2!))^2))))+(d-3)12!((1/(4!4!2!))+(1/(3!3!3!))+(2/(3!3!2!2!))+(1/(2!2!4!2!))+(2/(2!2!3!2!))+(2/((((2!))^3)3!2!))+(1/(((2!))^5))+(1/(5!3!))+(2/(4!2!2!))+(2/(3!3!2!))+(1/(3!2!2!))+(2/(2!4!3!))+(2/(2!3!2!2!)))+(d-3)(d-4)12!((1/(3!3!2!))+(1/(2^6))+(1/(2!2!3!))+(2/(2!2!2!2!))+(1/(2!4!2!))+(2/(2!3!2!))+(2/(2!2!3!2!))+(1/(2!2!2!2!)))+(d-3)(d-4)(d-5)12!((1/(2!2!2!2!))+(1/(3!3!))+(2/(2!2!3!)))+(((d-3)(d-4)(d-5)(d-6))/(4!))((12!)/(2!));
(* s_n((Subscript[e, 1])+(Subscript[e, 2])+(Subscript[e, 3])+(Subscript[e, 4])) *)
sv[4,{4,0,0,0}]=4!;
sv[6,{4,0,0,0}]=6!(4/(2!))+(d-4)6!;
sv[8,{4,0,0,0}]=8!((4/(3!2!))+((4!)/(2!2!))(1/(2!2!)))+(d-4)8!((4/(2!))+(1/(2!2!)))+(d-4)(((d-5))/2)8!;
sv[10,{4,0,0,0}]=10!((4/(4!3!))+4*3*(1/(3!2!2!))+4 (1/(((2!))^3)))+(d-4)10!((4/(3!2!))+((4!)/(2!2!))(1/(2!2!))+(4/(2!2!2!))+(1/(3!3!)))+(d-4)(d-5)10!((4/(2!2!))+(1/(2!2!)))+(((d-4)(d-5)(d-6))/(3!))10!;
sv[12,{4,0,0,0}]=12!((4/(5!4!))+4*3(1/(4!3!2!))+((4*3)/2)(1/(((3!2!))^2))+4*((3*2)/2)(1/(3!2!2!2!))+(1/(((2!))^4)))+(d-4)12!((1/(4!4!))+(4/(3!3!2!))+(4/(2!2!3!2!))+((4*3)/2)(1/(((2!))^4))+4(1/(4!3!))+4*3(1/(3!2!2!))+(4/(((2!))^3)))+(d-4)(d-5)12!((1/(3!3!))+(1/(((2!))^5))+(4/(2!2!2!))+(4/(3!2!2!))+((4*3)/2)(1/(2!2!2!)))+(d-4)(d-5)(d-6)12!((1/(((2!))^3))+(4/(3!2!)))+(((d-4)(d-5)(d-6)(d-7))/(4!))12!;

Then we compute the values of (Subscript[I, n,l])(x) for the different x using  (Subscript[I, n,l])(x)=(Subscript[I, n,(l-1)])(x)-(Subscript[I, (n-1),(l-1)])(x)

Do[
tabletmp=Table[0,{s,1,14},{t,1,2+param}]; (*creating an empty table*)
tabletmp[[1,1]]=Text["l \\ n"];(*formating top/left entry*)
Do[tabletmp[[1,n+2]]=n,{n,0,param}]; (*formating first row of table*)
Do[tabletmp[[l+2,1]]=l,{l,0,12}];(*formating first coloumn of table*)
Do[tabletmp[[2,n+2]]=SRWInt[n,d,v];,{n,1,param}];(*compute second row*)
Do[tabletmp[[l+2,2]]=((sv[l,v])/(((2d))^l));,{l,0,12}];(*fill second coloumn*)
Do[
Do[tabletmp[[l+3,n+2]]=tabletmp[[l+2,n+2]]-tabletmp[[l+2,n+1]],{n,1,param}];(*fill these rest of the table using, (Subscript[I, n,l])(x)=(Subscript[I, n,(l-1)])(x)-(Subscript[I, (n-1),(l-1)])(x)*)
,{l,0,11}];
SRWTwoPointFunctionTable[v]=tabletmp;
Clear[n,l,s,t,tabletmp];
,{v,NVecAll}]

Print-Out of (Subscript[I, n,l])(x)

and print out the result:

Do[
NForm[a_]:=NumberForm[N[a] ,5];
OutputTable=Map[NForm,SRWTwoPointFunctionTable[v],{2}];Print[Labeled[Grid[OutputTable, Alignment -> {{Left, Center}, Baseline, {{2, 14}, {2, param+2}} -> {"."}}, Frame -> True, Dividers -> {{2 -> True, -1 -> True}, {2 -> True}}, Spacings -> {1.5, {1.5, 1, {0.5}}}, ItemStyle -> {1 -> Bold, 1 -> Bold}, Background -> {Automatic, Automatic, {{2, 14}, {2, param+2}} -> GrayLevel[0.9]}], Style["Value of the SRW two-point function in dimension "Text[d]Text[v], Bold], Top] // Text]
Clear[OutputTable];
,{v,NVecAll}]

For better readablity of the code we define the following function to acces the values of (Subscript[I, n,l])(x) :

Ivalue[n_,l_,v_]:=
Module[ {value},
value=SRWTwoPointFunctionTable[v][[l+2,n+2]];
value
];

Then we define the quantities we use to compute values on the unweighted diagrams:

I10=Ivalue[1,0,{0,0,0,0}];
I11=Ivalue[1,1,{0,0,0,0}];
I12=Ivalue[1,2,{0,0,0,0}];
I14=Ivalue[1,4,{0,0,0,0}];
I16=Ivalue[1,6,{0,0,0,0}];
I18=Ivalue[1,8,{0,0,0,0}];
I110=Ivalue[1,10,{0,0,0,0}];
I20=Ivalue[2,0,{0,0,0,0}];
I21=Ivalue[2,1,{0,0,0,0}];
I22=Ivalue[2,2,{0,0,0,0}];
I24=Ivalue[2,4,{0,0,0,0}];
I26=Ivalue[2,6,{0,0,0,0}];
I28=Ivalue[2,8,{0,0,0,0}];
I210=Ivalue[2,10,{0,0,0,0}];
I30=Ivalue[1,1,{0,0,0,0}];
I31=Ivalue[3,1,{0,0,0,0}];
I32=Ivalue[3,2,{0,0,0,0}];
I33=Ivalue[3,3,{0,0,0,0}];
I34=Ivalue[3,4,{0,0,0,0}];
I36=Ivalue[3,6,{0,0,0,0}];
I38=Ivalue[3,8,{0,0,0,0}];
I310=Ivalue[3,10,{0,0,0,0}];
I40=Ivalue[4,0,{0,0,0,0}];
I42=Ivalue[4,2,{0,0,0,0}];
I44=Ivalue[4,4,{0,0,0,0}];
I46=Ivalue[4,6,{0,0,0,0}];
I48=Ivalue[4,8,{0,0,0,0}];
I410=Ivalue[4,10,{0,0,0,0}];

Bounds on (Subscript[L, n])(x),(Subscript[K, n,l])(x), (Subscript[U, n,l])(x) and (Subscript[T, n,l])(x)

Now we use the computed values of (Subscript[I, n,l])(x) to bound the other SRW integrals, see Section 5.2.3. We begin with (Subscript[L, n])(x) which we can compute explicitly, see (5.2.24)-(5.2.27)

(Subscript[L, n])(x)

Do[
L[n,{1,0,0,0}]=(1/(2d))Ivalue[n,0,{0,0,0,0}]+(1/(2d))Ivalue[n,0,{0,1,0,0}]+((d-1)/d)Ivalue[n,0,{2,0,0,0}];
L[n,{0,1,0,0}]=(1/(2d))Ivalue[n,0,{0,0,0,0}]+(1/(2d))Ivalue[n,0,{0,0,0,1}]+((d-1)/d)Ivalue[n,0,{0,2,0,0}];
L[n,{2,0,0,0}]=(((d-2)(d-3))/(d(d-1)))Ivalue[n,0,{4,0,0,0}]+(((d-2))/(2d(d-1)))(Ivalue[n,0,{2,0,0,0}]+Ivalue[n,0,{2,1,0,0}])+(1/(4d(d-1)))(Ivalue[n,0,{0,0,0,0}]+Ivalue[n,0,{0,2,0,0}]+2Ivalue[n,0,{0,1,0,0}]);
,{n,0,param}]

(Subscript[K, n,l])(x)

Then we bound (Subscript[K, n,l])(x) as in described in (5.2.15), and then improve the bound using comment (5.2.21)

Do[Do[
K[n,l,{1,0,0,0}]=Min[((Ivalue[n,2l,{0,0,0,0}])^(1/2))((L[n,{1,0,0,0}])^(1/2)),Ivalue[n,l+1,{0,0,0,0}]];
K[n,l,{0,1,0,0}]=((Ivalue[n,2l,{0,0,0,0}])^(1/2))((L[n,{0,1,0,0}])^(1/2));
K[n,l,{2,0,0,0}]=((Ivalue[n,2l,{0,0,0,0}])^(1/2))((L[n,{2,0,0,0}])^(1/2));
,{l,0,6}]
Do[
K[n,l,{1,0,0,0}]=Min[((Ivalue[n,12,{0,0,0,0}])^(1/2))((L[n,{1,0,0,0}])^(1/2)),Ivalue[n,l+1,{0,0,0,0}]];
K[n,l,{0,1,0,0}]=((Ivalue[n,12,{0,0,0,0}])^(1/2))((L[n,{0,1,0,0}])^(1/2));
K[n,l,{2,0,0,0}]=((Ivalue[n,12,{0,0,0,0}])^(1/2))((L[n,{2,0,0,0}])^(1/2));
,{l,7,10}]
,{n,0,param}];

Do[Do[
K[n,0,v]=K[n-1,0,v]+((Ivalue[n-1,4,{0,0,0,0}])^(1/2))((L[n-1,v])^(1/2))+((Ivalue[n,4,{0,0,0,0}])^(1/2))((L[n,v])^(1/2));
,{n,1,param}],{v,{{1,0,0,0},{0,1,0,0},{2,0,0,0}}}];

For x=0 we bound as given in (5.2.41)

Do[
Do[
K[n,2l,{0,0,0,0}]=Ivalue[n,2l,{0,0,0,0}];
,{l,0,6}];
Do[
K[n,2l+1,{0,0,0,0}]=(Sqrt[Ivalue[n,2l,{0,0,0,0}]Ivalue[n,2l+2,{0,0,0,0}]]);
,{l,0,5}];
,{n,0,param}];

(Subscript[T, n,l])(x)

We bound (Subscript[T, n,l])(x) as stated in (5.2.23):

Do[Do[Do[
T[n,l,v]=K[n,l+1,v]+Min[(4/d)K[n,l,v],(2/d)K[n+1,l,v]];
,{n,1,param-1}];
T[param,l,v]=K[param,l+1,v]+(4/d)K[param,l,v];
,{l,0,12}],{v,{{0,0,0,0},{1,0,0,0},{0,1,0,0},{2,0,0,0}}}];

(Subscript[V, n,l])

We compute the bounds on (Subscript[V, n,l]) using (5.2.33)

Do[Do[
V[n,l]=(1/(((2d))^2))(Ivalue[n,l,{0,0,0,0}]-2 Ivalue[n,l,{0,1,0,0}]+((d-1)/d)Ivalue[n,l,{0,2,0,0}]+(1/(2d))Ivalue[n,l,{0,0,0,0}]+(1/(2d))Ivalue[n,l,{0,0,0,1}]);
,{n,0,param}]
,{l,0,12}];

(Subscript[U, n,l])(x)

Then we compute (Subscript[U, n,l])(x) as given in (5.2.16) and (5.2.42):

Do[Do[Do[
U[n,l,v]=((V[n,2l])^(1/2))((L[n,v])^(1/2));
,{v,{{0,1,0,0},{2,0,0,0}}}];
If[Mod[l, 2]==0,U[n,l,{0,0,0,0}]=(1/(2d))(Ivalue[n,l,{0,0,0,0}]-Ivalue[n,l,{0,1,0,0}]),U[n,l,{0,0,0,0}]=(1/d)K[n,l,{0,0,0,0}]];
,{n,0,param}],{l,0,6}];
Do[Do[
U[n,l,{1,0,0,0}]=Min[((V[n,2l])^(1/2))((L[n,{1,0,0,0}])^(1/2)),U[n,l+1,{0,0,0,0}]];
,{l,0,5}];
U[n,6,{1,0,0,0}]=((V[n,12])^(1/2))((L[n,{1,0,0,0}])^(1/2));
,{n,0,param}];

Print-out of the used values

TableSup=Table[0,{s,1,5},{t,1,4}];
n=2;
l=4;
TableSup[[1,2]]={1,0,0,0};
TableSup[[1,3]]={0,1,0,0};
TableSup[[1,4]]={2,0,0,0};
TableSup[[2,1]]=Text[Lnm];
TableSup[[2,2]]=L[n,{1,0,0,0}];
TableSup[[2,3]]=L[n,{0,1,0,0}];
TableSup[[2,4]]=L[n,{2,0,0,0}];
TableSup[[3,1]]=Text[Knm];
TableSup[[3,2]]=K[n,l,{1,0,0,0}];
TableSup[[3,3]]=K[n,l,{0,1,0,0}];
TableSup[[3,4]]=K[n,l,{2,0,0,0}];
TableSup[[4,1]]=Text[Unm];
TableSup[[4,2]]=U[n,l,{1,0,0,0}];
TableSup[[4,3]]=U[n,l,{0,1,0,0}];
TableSup[[4,4]]=U[n,l,{2,0,0,0}];
TableSup[[5,1]]=Text[Tnm];
TableSup[[5,2]]=T[n,l,{1,0,0,0}];
TableSup[[5,3]]=T[n,l,{0,1,0,0}];
TableSup[[5,4]]=T[n,l,{2,0,0,0}];

Print[Labeled[Grid[Map[NForm,TableSup,{2}], Alignment -> {{Left, Center}, Baseline, {{2, 5}, {2, 4}} -> {"."}}, Frame -> True, Dividers -> {{2 -> True, -1 -> True}, {2 -> True}}, Spacings -> {1.5, {1.5, 1, {0.5}}}, ItemStyle -> {1 -> Bold, 1 -> Bold}, Background -> {Automatic, Automatic, {{2, 5}, {2, 4}} -> GrayLevel[0.9]}], Style["Bounds of the SRW two-point function "Text[d], Bold], Top] // Text]
Clear[n,l]

We define the following functions to acces the value of the supremum of the functions for x≠0:

(*SupremumTnotZero[n_,l_]:=Max[T[n,l,v],{v,{{1,0,0,0},{0,1,0,0},{2,0,0,0}}}]
SupremumTnotei[n_,l_]:=Max[T[n,l,v],{v,{{0,1,0,0},{2,0,0,0}}}]
SupremumUnotZero[n_,l_]:=Max[U[n,l,v],{v,{{1,0,0,0},{0,1,0,0},{2,0,0,0}}}]
SupremumUnotei[n_,l_]:=Max[U[n,l,v],{v,{{0,1,0,0},{2,0,0,0}}}]
SupremumKnotZero[n_,l_]:=Max[K[n,l,v],{v,{{1,0,0,0},{0,1,0,0},{2,0,0,0}}}]
SupremumKnotei[n_,l_]:=Max[K[n,l,v],{v,{{0,1,0,0},{2,0,0,0}}}]*)

Improvement of bounds

The inital point

Then we implement the bounds on (Subscript[(OverBar[f]), 3,n,l]) and (Subscript[(OverBar[f]), 4,n,l]) (see (3.8.8)). We begin with the initial point using (3.6.20). Thereby we include the parameter rho, that allows us to improve the bound sightly for lattice trees and animals.

(*First we define the integral given in (3.6.18)*)IM[n_,l_,v_]:=Ivalue[n+2,l+1,v]-(1/d)Ivalue[n+3,l,v]+(1/(2(d^2))) Switch[v,{0,0,0,0},2d Ivalue[n+3,l,{0,1,0,0}],{1,0,0,0},Ivalue[n+3,l,{1,0,0,0}]+Ivalue[n+3,l,{0,0,1,0}]+(2d-2)Ivalue[n+3,l,{1,1,0,0}],{0,1,0,0},Ivalue[n+3,l,{0,0,0,0}]+Ivalue[n+3,l,{0,0,0,1}]+(2d-2)Ivalue[n+3,l,{0,2,0,0}],{2,0,0,0},2Ivalue[n+3,l,{2,0,0,0}]+2Ivalue[n+3,l,{1,0,1,0}]+(2d-4)Ivalue[n+3,l,{2,1,0,0}]];
(*Then we compute the bound as given in (3.6.20)*)
BoundFThreeBarInitial[n_,l_,rho_]:=rho (((((2d-2)/(2d-1))))^(n+1))( Max[IM[n,l,{1,0,0,0}],IM[n,l,{2,0,0,0}],IM[n,l,{0,1,0,0}]]);
BoundFFourBarInitial[n_,l_,rho_]:=rho (((((2d-2)/(2d-1))))^(n+1))(IM[n,l,{0,0,0,0}]);

IM[1,6,{0,0,0,0}]/IM[1,8,{0,0,0,0}]
IM[1,4,{0,0,0,0}]/IM[1,6,{0,0,0,0}]
IM[1,2,{0,0,0,0}]/IM[1,4,{0,0,0,0}]
IM[1,0,{0,0,0,0}]*2d
N[(Sqrt[15])]

Bound on the integral (Subscript[H, i])

In this section we implement funciton to bound on

(∫_(((-π,π))^d))(Subscript[(OverHat[H]), i])(k)((OverHat[D])^l)(k)(Subscript[(OverHat[G]), z]^n)(k) ((OverHat[D])^((x)))(k) dk

for x=0 and (sup_(x:|x|>1)) as described in Section 3.6.4. We do not compute that value for x=(Subscript[e, 1]) as it equalt the case x=0 with l+1.

BoundH[1,n_,l_,v_,Gamma2dash_,cp_,af_,ap_,bRf_,bRp_,bRfDelta_,bRpDelta_,Kunderline_]:=If[n==0, af cp IM[0,l,v]+af ap IM[0,l+1,v]+ap IM[-1,l,v], If[n==1, 
af (cp^2)IM[1,l,v]+cp ap IM[0,l,v]+2af ap cp IM[1,l+1,v]+(ap^2)IM[0,l+1,v]+af (ap^2)IM[1,l+2,v]+(bRp+bRfDelta Gamma2dash)(cp af  T[3,l,v]+ap af  T[3,l+1,v]+ap  T[2,l,v]), If[n==2,af (cp^3)IM[2,l,v]+(cp^2) ap IM[1,l,v]+3af ap (cp^2) IM[2,l+1,v]+2(cp^2) ap IM[1,l+1,v]+3af (ap^2) cp IM[2,l+2,v]+(ap^3)IM[1,l+2,v]+af (ap^3)IM[2,l+3,v]+(bRp+bRfDelta Gamma2dash)(cp+ Gamma2dash)(af cp  T[4,l,v] +ap  T[3,l,v])+(bRp+bRfDelta Gamma2dash)(af ap (2 cp+ Gamma2dash)  T[4,l+1,v] +(ap^2)  T[3,l+1,v]+af (ap^(2 )) T[4,l+2,v]),-1]]];
BoundH[2,n_,l_,v_,Gamma2dash_,cp_,af_,ap_,bRf_,bRp_,bRfDelta_,bRpDelta_,Kunderline_]:= af bRfDelta  (Gamma2dash^n)Kunderline ((cp T[n+2,l,v]+ap T[n+2,l+1,v])(1+Kunderline)+ap T[n+1,l,v])+af bRpDelta (Kunderline^2)  T[n+2,l,v];
BoundH[3,n_,l_,v_,Gamma2dash_,cp_,af_,ap_,bRf_,bRp_,bRfDelta_,bRpDelta_,Kunderline_]:=2(Kunderline^2)(Gamma2dash^n)(bRfDelta+Abs[af-1]) (ap U[n+2,l,v]+af Kunderline((cp+bRp) U[n+3,l,v]+ap  U[n+3,l+1,v]));BoundH[4,n_,l_,v_,Gamma2dash_,cp_,af_,ap_,bRf_,bRp_,bRfDelta_,bRpDelta_,Kunderline_]:=Kunderline(bRpDelta K[n,l,v]+bRfDelta K[n+1,l,v]); (*ch*)BoundH[5,n_,l_,v_,Gamma2dash_,cp_,af_,ap_,bRf_,bRp_,bRfDelta_,bRpDelta_,Kunderline_]:=2 (Kunderline^2)(Gamma2dash^(n+1))(2 af bRfDelta+(bRfDelta^2))U[n+3,l,v]+2 (Kunderline^2)(Gamma2dash^n)(af bRpDelta+(ap +bRpDelta)bRfDelta)U[n+2,l,v];

Improvement of bounds

We compute the bound on  (Subscript[(OverBar[f]), 3,n,l]) and (Subscript[(OverBar[f]), 4,n,l]) for  z ϵ ((Subscript[z, I]),(Subscript[z, c])). The input are the bounds of Assumption 3.5.3, the functions implemented above, and the comment at the end of Section 5.2.3.

BoundFThreeBar[n_,l_,Gamma2dash_,cp_,af_,ap_,bRf_,bRp_,bRfDelta_,bRpDelta_,Kunderline_]:=Max[
Sum[BoundH[i,n,l+1,{0,0,0,0},Gamma2dash,cp,af,ap,bRf,bRp,bRfDelta,bRpDelta,Kunderline],{i,1,5}],Sum[BoundH[i,n,l,{0,1,0,0},Gamma2dash,cp,af,ap,bRf,bRp,bRfDelta,bRpDelta,Kunderline],{i,1,5}],Sum[BoundH[i,n,l,{2,0,0,0},Gamma2dash,cp,af,ap,bRf,bRp,bRfDelta,bRpDelta,Kunderline],{i,1,5}]];
BoundFFourBar[n_,l_,Gamma2dash_,cp_,af_,ap_,bRf_,bRp_,bRfDelta_,bRpDelta_,Kunderline_]:=Sum[BoundH[i,n,l,{0,0,0,0},Gamma2dash,cp,af,ap,bRf,bRp,bRfDelta,bRpDelta,Kunderline],{i,1,5}];