Pensieve Header: Alexander blobs Results.

SetDirectory["C:\\drorbn\\AcademicPensieve\\2011-08\\w-Computations\\Recycling"];
<< "AlexanderBlobs-Program-110820.m"

b[r[1,2],r[1,3]] + b[r[1,2],r[2,3]]

b[r[1,2],r[1,3]] + b[r[1,2],r[2,3]] + b[r[1,3],r[2,3]]

ModDegree[4, R[1,2]]

ModDegree[7, R[1,2]**R[1,3]**R[2,3] - R[2,3]**R[1,3]**R[1,2]]

v[0]=0;

d=1;
ModDegree[d+1,
Print[
v[d]=v[d-1]-(1/2)Diag[1,ar[1,2]]
];
V[d]=DExp[v[d]];
V[d]**DExp[r[1,3]+r[2,3]]-R[1,3]**R[2,3]**V[d]
]

d=2;
ModDegree[d+1,
Print[
v[d]=v[d-1]+(1/24) Diag[h[1],ar[1,2]]+(1/12) Diag[h[2],ar[1,2]]
];
V[d]=DExp[v[d]];
V[d]**DExp[r[1,3]+r[2,3]]-R[1,3]**R[2,3]**V[d]
]

d=3;
ModDegree[d+1,
Print[
v[d]=v[d-1]
];
V[d]=DExp[v[d]];
V[d]**DExp[r[1,3]+r[2,3]]-R[1,3]**R[2,3]**V[d]
]

d=4;
ModDegree[d+1,
Print[
c[d,0]=-1/720; c[d,1]=-1/480; c[d, 2]=-1/720;c[d,3]=-1/2880;
v[d]=v[d-1]+Sum[c[d, k]Diag[h[1]^k*h[2]^(d-1-k),ar[1,2]], {k, 0, d-1}]
];
V[d]=DExp[v[d]];
V[d]**DExp[r[1,3]+r[2,3]]-R[1,3]**R[2,3]**V[d]
]

d=5;
ModDegree[d+1,
Print[
c[5,_] = 0;
v[d]=v[d-1]+Sum[c[d, k]Diag[h[1]^k*h[2]^(d-1-k),ar[1,2]], {k, 0, d-1}]
];
V[d]=DExp[v[d]];
V[d]**DExp[r[1,3]+r[2,3]]-R[1,3]**R[2,3]**V[d]
]

d=6;
ModDegree[d+1,
Print[
c[6,0]=1/30240; c[6,1]=1/12096;c[6,2]=1/9072;c[6,3]=1/12096; c[6,4]=1/30240;c[6,5]=1/181440;
v[d]=v[d-1]+Sum[c[d, k]Diag[h[1]^k*h[2]^(d-1-k),ar[1,2]], {k, 0, d-1}]
];
V[d]=DExp[v[d]];
V[d]**DExp[r[1,3]+r[2,3]]-R[1,3]**R[2,3]**V[d]
]

ModDegree[7, V[6]**Adjoint[V[6]]]

d=7;
ModDegree[d+1,
Print[
c[7,_] = 0;
v[d]=v[d-1]+Sum[c[d, k]Diag[h[1]^k*h[2]^(d-1-k),ar[1,2]], {k, 0, d-1}]
];
V[d]=DExp[v[d]];
V[d]**DExp[r[1,3]+r[2,3]]-R[1,3]**R[2,3]**V[d]
]

d=8;
ModDegree[d+1,
Print[
c[8,0]=-1/1209600; c[8,1]=-1/345600;c[8,2]=-1/172800;c[8,3]=-1/138240; c[8,4]=-1/172800;c[8,5]=-1/345600; c[8,6]=-1/1209600; c[8,7]=-1/9676800;
v[d]=v[d-1]+Sum[c[d, k]Diag[h[1]^k*h[2]^(d-1-k),ar[1,2]], {k, 0, d-1}]
];
V[d]=DExp[v[d]];
V[d]**DExp[r[1,3]+r[2,3]]-R[1,3]**R[2,3]**V[d]
]

ModDegree[9, V[8]**Adjoint[V[8]]]

v[8] /. Diag[hs_, ar[1,2]] :> hs /. {h[1] -> h1, h[2] -> h2}

-1209600*8*Table[c[8,k], {k,0,7}]

Table[Binomial[8,k], {k, 1, 8}]

Clear[Phi];
Phi[d_] := ModDegree[d+1,
V[d] = DExp[v[d]];
Phi[d] = PutOn[{{1,2},3}, Adjoint[V[d]]]**Adjoint[V[d]]**PutOn[{2,3}, V[d]]**PutOn[{1,{2,3}},V[d]]
]

ModDegree[3, V[3]]

V[2]

Phi[2]

Pentagon[d_] := ModDegree[d+1,
Phi[d]**PutOn[{1,{2,3},4}, Phi[d]]**PutOn[{2,3,4}, Phi[d]]-PutOn[{{1,2},3,4}, Phi[d]]**PutOn[{1,2,{3,4}}, Phi[d]]
]

Pentagon[2]

V[3]

Phi[3]

Pentagon[3]

Pentagon[4]

Pentagon[5]

Pentagon[3]

b[Pentagon[3], PutOn[{{1,2,3,4}, 5}, Diag[1, ar[1,2]]]]

b[Pentagon[3], PutOn[{{1,2,3,4}, 5}, Diag[1, ar[2,1]]]]

Phi[3]

b[Phi[3], PutOn[{{1,2,3}, 4}, Diag[1, ar[2,1]]]]

b[Phi[3], PutOn[{{1,2,3}, 4}, Diag[1, ar[1,2]]]]

Phi[2]

b[Phi[2], PutOn[{{1,2,3}, 4}, Diag[1, ar[1,2]]]]

RR[d_] := ModDegree[d+1, DExp[1/2 Diag[1, ar[1,2]]+1/2Diag[1,ar[2,1]]]];
RR[3]

Hexagon[d_] := ModDegree[d+1,
PutOn[{{1,2},3},RR[d]] - Phi[d]**PutOn[{2,3},RR[d]]**PutOn[{1,3,2}, DInvert[Phi[d]]]**PutOn[{1,3},RR[d]]**PutOn[{3,1,2}, Phi[d]]
]

Phi[2]

Y=b[Diag[1, ar[1,2]]+Diag[1,ar[2,1]], Diag[1,ar[2,3]]+Diag[1,ar[3,2]]]

Y+b[Diag[1, ar[1,2]]+Diag[1,ar[2,1]], Diag[1,ar[1,3]]+Diag[1,ar[3,1]]]

PutOn[{2,3,1}, Phi[2]] - Phi[2]

PutOn[{2,1,3}, Phi[2]]

b[Y, PutOn[{{1,2,3}, 4}, Diag[1, ar[1,2]]]]

b[Y, PutOn[{{1,2,3}, 4}, Diag[1, ar[2,1]]]]

Hexagon[2]