The Multiple Zeta Function

DefineNMZ := (
NMZ[s_] := NMZ[s] = NSum[1/n^s, {n, 1, Infinity}];
NMZ[s1_, s2_] := NMZ[s1, s2] = Re[NSum[1/(n1^s1*n2^s2), {n1, 1, Infinity}, {n2, n1+1, Infinity}]];
NMZ[ss__] := NMZ[ss] = Module[
{n,i},
n[0]=0; n[i_] := n[i]= Unique[n];
Re[NSum @@  Join[
{1/Product[n[i]^{ss}[[i]], {i, Length[{ss}]}]},
Table[
{n[i], n[i-1]+1, Infinity},
{i, Length[{ss}]}
]
]]
];
);
DefineNMZ;
MZ /: N[MZ[ss__]] := NMZ[ss]

Sqrt[6*MZ[2]] // N

{MZ[3], Zeta[3]} // N

{MZ[5]*MZ[7], MZ[5,7]+MZ[7,5]+MZ[12]} // N

{MZ[2]*MZ[4, 8], MZ[2,4,8]+MZ[6,8]+MZ[4,2,8]+MZ[4,10]+MZ[4,8,2]} // N

Timing[MZ[2,2,2] // N]

Timing[MZ[2,2,2,2] // N]

From KZ Integrals to Multiple Zeta Values

KZI[] = 1;
KZI2MZV[expr_] := Module[
{slider, t1, t2},
t1 = expr /. KZI[cd__] :> slider[{}, {cd}];
t2 = t1 //. {
slider[{ss___}, {b, cd__}] :> -slider[{ss, 1}, {cd}],
slider[{ss___, n_} , {a, cd___}] :> slider[{ss, n+1}, {cd}]
};
t2 /. slider[{ss__}, {}] :> MZ[ss]
]

KZI[b,a,a,b,b,a] // KZI2MZV

Shuffles[l1_List, {}] = {l1};
Shuffles[{}, l2_List] = {l2};
Shuffles[{x_, l1___}, {y_, l2___}] := Join[
Prepend[#, x]& /@ Shuffles[{l1}, {y, l2}],
Prepend[#, y]& /@ Shuffles[{x, l1}, {l2}]
];
Shuffle[KZI[l1__], KZI[l2__]] := Plus @@ (KZI @@@ Shuffles[{l1}, {l2}]);

Shuffles[{1,2,3}, {4,5}]

t1 = {KZI[b,a]*KZI[b,a,a], Shuffle[KZI[b,a], KZI[b,a,a]]}

t2 = t1 // KZI2MZV

t2 // N

Shuffle[0, _]= 0;
Shuffle[_, 0] = 0;
Shuffle[a_Plus, b_] :=Shuffle[#, b]& /@ a;
Shuffle[a_, b_Plus] :=Shuffle[a, #]& /@ b;
Shuffle[a1_.*kzi1_KZI, a2_.*kzi2_KZI] := Expand[a1 a2 Shuffle[kzi1, kzi2]];
KZIReduce[expr_] := FixedPoint[
(Expand /@ (# //. {
kzi1_KZI*kzi2_KZI :> Shuffle[kzi1, kzi2],
kzi_KZI^p_Integer :> Nest[Shuffle[#, kzi]&, kzi, p-1]
})) &,
expr
];
KZIReduce[KZI[b,a]*KZI[b,a,a]]

{t1 = KZI[b,b,a]+KZI[b,a,a] // KZI2MZV, t1 // N}

SetOptions[NSum, NSumTerms -> 50, NSumExtraTerms -> 25]; Clear[NMZ]; DefineNMZ;
{t1 = KZI[b,b,a]+KZI[b,a,a] // KZI2MZV, t1 // N}

SetOptions[NSum, NSumTerms -> 15, NSumExtraTerms -> 12]; Clear[NMZ]; DefineNMZ;

{t1=KZI[b,b,b,a]-KZI[b,a,a,a] // KZI2MZV, t1 // N}

t1=KZI[b,a,a,b,a,a,a,a] - KZI[b,b,b,b,a,b,b,a]// KZI2MZV

t1 // N

The Naive KZ Associator

Words[alphabeth_List, 0] = {Word[]};
Words[alphabeth_List, n_] := Flatten[Outer[Word, Sequence @@ Table[alphabeth, {n}]]]

Words[{a,b},3]

PhiNaive[n_] := ASeries @@ Table[
Plus @@ (Words[{a,b}, k] /. Word[w___] :> KZI[w]*P[w]),
{k, 0, n}
]

PhiNaive[2]

Some Non-Commutative Algebra

Unprotect[NonCommutativeMultiply];
NonCommutativeMultiply[] := P[];
NonCommutativeMultiply[a_] := a;
0 ** _ = 0;
_ ** 0 = 0;
(a_Plus)**b_ :=(#**b)& /@ a;
a_**(b_Plus) :=(a**#)& /@ b;
(a1_.*p1_P)**(a2_.*p2_P) := Expand[a1 a2 Join[p1, p2]];

ASeries /: a_*ASeries[ps__] := ASeries[Sequence @@ (a*{ps})];
ASeries /: ASeries[ps1__] + ASeries[ps2__] := Module[
{d},
d=Min[Length[{ps1}], Length[{ps2}]];
ASeries[Sequence @@ (Take[{ps1}, d] + Take[{ps2}, d])]
];
ASeries /: ASeries[ps1__]** ASeries[ps2__] := Module[
{d, k, i},
d=Min[Length[{ps1}], Length[{ps2}]]-1;
ASeries[Sequence @@ Table[
Sum[
{ps1}[[1+i]] ** {ps2}[[1+k-i]],
{i, 0, k}
],
{k, 0, d}
]]
];
ASeries /: Expand[as_ASeries] := Expand /@ as

PhiNaive[2]+PhiNaive[3]

PhiNaive[2]**PhiNaive[3]

The Renormalized KZ Associator

Phi[n_] := KZIReduce[
 NonCommutativeMultiply[
ASeries @@ Table[
(-1)^k*(KZI@@Table[a,{k}])(P@@Table[a,{k}]),
{k, 0, n}
],
PhiNaive[n],
ASeries @@ Table[
(-1)^k*(KZI@@Table[b,{k}])(P@@Table[b,{k}]),
{k, 0, n}
]
]
]

Phi[2]

Phi[4]

Phi[5] // KZI2MZV

Phi[3] // KZI2MZV // N

The VS Structure and the Pentagon

Pull[l_List, t[i_,j_]] := Plus @@ (Plus @@ (
Outer[t, Flatten[Position[l, i]], Flatten[Position[l, j]]] /. t[i1_,j1_] /;i1>j1 :> t[j1,i1]
));
Pull[l_List, a] := Pull[l, t[1,2]];Pull[l_List, b] := Pull[l, t[2,3]];
Pull[l_List, expr_] := Expand[expr /. p_P :> NonCommutativeMultiply @@ ((Pull[l, #]& /@ p) /. t[ij__] :> P[t[ij]])]

Pull[{1,2,2, 3},b]

Pull[{1,2,2, 3},Phi[2]] // Expand

Pull[{0,0,2,3},PhiNaive[3]] // Expand

TestPentagon[Phi_] := (
Pull[{1,2,3,0}, Phi]**Pull[{1,2,2,3}, Phi]**Pull[{0,1,2,3}, Phi] - Pull[{1,1,2,3}, Phi]**Pull[{1,2,3,3},Phi]
)

TestPentagon[Phi[2]]

The 4T Relations

Normalize[expr_] := Expand[expr //. {
P[lft___,t[i_,j_],t[k_,l_],rgt___] :>Which[
i==k,P[lft,t[k,l],t[i,j],rgt]+P[lft,t[l,j],t[i,j],rgt]-P[lft,t[i,j],t[l,j],rgt],
i==l,P[lft,t[k,l],t[i,j],rgt]+P[lft,t[k,j],t[i,j],rgt]-P[lft,t[i,j],t[k,j],rgt],
True,P[lft,t[k,l],t[i,j],rgt]
] /;j>l
}]

TestPentagon[Phi[2]] // Normalize

t1 = TestPentagon[Phi[3]]// Normalize

t2 = t1 // KZI2MZV

t2 /. mz_MZ :> N[mz]

Coefficient[Last[t2], #]& /@ Union[Cases[Last[t2], _P, Infinity]]

t1 = TestPentagon[Phi[4]]// Normalize;

t2 = t1 // KZI2MZV;

t2 /. mz_MZ :> N[mz]

Union[Coefficient[Last[t2], #]& /@ Union[Cases[Last[t2], _P, Infinity]]]

Coefficient[Last[t2],P[t[3,4],t[2,4],t[3,4],t[1,4]]]

-3 MZ[4]-MZ[1,3]-MZ[2,2]+4 MZ[1,1,2] // N

SetOptions[NSum, NSumTerms -> 50, NSumExtraTerms -> 25]; Clear[NMZ]; DefineNMZ;

-3 MZ[4]-MZ[1,3]-MZ[2,2]+4 MZ[1,1,2] // N

SetOptions[NSum, NSumTerms -> 15, NSumExtraTerms -> 12]; Clear[NMZ]; DefineNMZ;

A Rational Associator

phi4=ASeries[
P[],0,
P[t[1,3],t[2,3]]/24-P[t[2,3],t[1,3]]/24,0,
-P[t[1,3],t[1,3],t[1,3],t[2,3]]/1440+P[t[1,3],t[1,3],t[2,3],t[1,3]]/480+(7*P[t[1,3],t[1,3],t[2,3],t[2,3]])/5760-P[t[1,3],t[2,3],t[1,3],t[1,3]]/480-P[t[1,3],t[2,3],t[1,3],t[2,3]]/640-P[t[1,3],t[2,3],t[2,3],t[1,3]]/1152-(7*P[t[1,3],t[2,3],t[2,3],t[2,3]])/5760+P[t[2,3],t[1,3],t[1,3],t[1,3]]/1440-P[t[2,3],t[1,3],t[1,3],t[2,3]]/1152+(19*P[t[2,3],t[1,3],t[2,3],t[1,3]])/5760+(7*P[t[2,3],t[1,3],t[2,3],t[2,3]])/1920-(7*P[t[2,3],t[2,3],t[1,3],t[1,3]])/5760-(7*P[t[2,3],t[2,3],t[1,3],t[2,3]])/1920+(7*P[t[2,3],t[2,3],t[2,3],t[1,3]])/5760
]

TestPentagon[phi4] // Normalize

PhiNaive, the Pentagon and the Septagon

Invert[ASeries[P[], ht___]] := Module[
{x, t},
x=-ASeries[0,ht];
t=ASeries[P[], Sequence@@(0*{ht})];
t+Sum[
t=t**x,
{Length[{ht}]}
]
]

Invert[Phi[4]]**Phi[4]

TestPentagon[PhiNaive[2]] // Normalize // KZIReduce

TestPentagon[Phi_] := (
Pull[{1,2,3,0}, Phi]**Pull[{1,2,2,3}, Phi]**Pull[{0,1,2,3}, Phi] - Pull[{1,1,2,3}, Phi]**Pull[{1,2,3,3},Phi]
)

TestSeptagon[Phi_] := Module[
{n=Length[Phi]-1},
NonCommutativeMultiply[
Invert[Pull[{0,1,2,3}, Phi]],
Invert[Pull[{1,2,2,3}, Phi]],
Invert[Pull[{1,2,3,0}, Phi]],
Pull[{1,1,2,3}, Phi],
Pull[{0,0,2,3}, Phi],
Pull[{1,2,0,0}, Phi],
Pull[{1,2,3,3},Phi]
]
]

t1=TestSeptagon[PhiNaive[3]] // Normalize // KZIReduce

(t1 // KZI2MZV) /. mz_MZ :> N[mz]

SetOptions[NSum, NSumTerms -> 15, NSumExtraTerms -> 12]; Clear[NMZ]; DefineNMZ;
Sort[Abs[Cases[(t1 // KZI2MZV) /. mz_MZ :> N[mz], _Real, Infinity]]]

SetOptions[NSum, NSumTerms -> 500, NSumExtraTerms -> 250]; Clear[NMZ]; DefineNMZ;
Sort[Abs[Cases[(t1 // KZI2MZV) /. mz_MZ :> N[mz], _Real, Infinity]]]

SetOptions[NSum, NSumTerms -> 5000, NSumExtraTerms -> 2500]; Clear[NMZ]; DefineNMZ;
Sort[Abs[Cases[(t1 // KZI2MZV) /. mz_MZ :> N[mz], _Real, Infinity]]]

SetOptions[NSum, NSumTerms -> 15, NSumExtraTerms -> 12]; Clear[NMZ]; DefineNMZ;

t2=TestSeptagon[PhiNaive[4]] // Normalize // KZIReduce

Cases[t2, KZI[___, b]|KZI[a,___], Infinity]