Pensieve Header: Alexander blobs Results.

SetDirectory["C:\\drorbn\\AcademicPensieve\\2011-08\\w-Computations"];
<< "AlexanderBlobs-Program.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]+c1 Diag[1,ar[1,2]]+ c2 Diag[1,ar[2,1]]
];
V[d]=DExp[v[d]];
{R4Eqn[V[d]], TwistEqn[V[d]]}
]

Solve[{-1/2-c1+c2==0, 1/2+c1-c2==0}, {c1,c2}]

d=1; ModDegree[d+1,
Print[
v[d]=v[d-1]+c1 Diag[1,ar[1,2]]+ (1/2+c1) Diag[1,ar[2,1]]
];
V[d]=DExp[v[d]];
{R4Eqn[V[d]], TwistEqn[V[d]]}
]

d=2; ModDegree[d+1,
Print[
v[d]=v[d-1]
];
V[d]=DExp[v[d]];
{R4Eqn[V[d]], TwistEqn[V[d]]}
]

d=2; ModDegree[d+1,
Print[
v[d] = (v[d-1] /. c1->-1/4)
];
V[d]=DExp[v[d]];
{R4Eqn[V[d]], TwistEqn[V[d]]}
]

d=3; ModDegree[d+1,
Print[
v[d] = v[d-1]+c21 r12**r12+c22 r12**r21+c23 r21**r12+c24 r21**r21+c25 Diag[h[1],ar[1,2]]+c26 Diag[h[2], ar[1,2]]+c27 Diag[h[1],ar[2,1]]+c28 Diag[h[2],ar[2,1]]
];
V[d]=DExp[v[d]];
{R4Eqn[V[d]], TwistEqn[V[d]]}
] // PullDiags

Solve[{(-(1/48)-c21+c23-c25+c27) ==0, ((1/48)+c23-c24-c26+c28)==0, (-2 c21+c22+c23)==0, (-c22-c23+2 c24)==0, (-c25+c28)==0, (c22-c23+c26-c27)==0, (c22-c23)==0, (c21-c24)==0}, {c21,c22,c23,c24,c25,c26,c27,c28}]

d=3; ModDegree[d+1,
Print[
v[d] = v[d-1]+0 r12**r12+0 r12**r21+0 r21**r12+0 r21**r21+c25 Diag[h[1],ar[1,2]]+((1/48)+c25) Diag[h[2], ar[1,2]]+((1/48)+c25) Diag[h[1],ar[2,1]]+c25 Diag[h[2],ar[2,1]] /. c25 -> 1/32
];
V[d]=DExp[v[d]];
{R4Eqn[V[d]], TwistEqn[V[d]]}
] // PullDiags

d=4; ModDegree[d+1,
Print[
v[d] = v[d-1]
];
V[d]=DExp[v[d]];
{R4Eqn[V[d]], TwistEqn[V[d]]}
] // PullDiags

d=5; ModDegree[d+1,
Print[
v[d] = v[d-1]+Sum[c[2k]Diag[h[1]^k h[2]^(d-2-k), ar[1,2]]+ c[2k+1]Diag[h[1]^k h[2]^(d-2-k), ar[2,1]], {k,0,d-2}]
];
V[d]=DExp[v[d]];
{R4Eqn[V[d]], TwistEqn[V[d]]}
] // PullDiags

Solve[(#==0)& /@ {((7/23040)-c[6]+c[7]), (1/7680)-c[4]+c[5], (1/7680)+c[2]-c[3], (7/23040)+c[0]-c[1], c[1]-c[6], c[0]-c[7], c[3]-c[4], c[2]-c[5], (11/30720)+((c[0])/2), -(187/276480)-((c[2])/2)}, c /@ Range[0,7]]

LCM[23040, 7680, 2304, 69120, 1728] / 720/24/2

d=5; ModDegree[d+1,
Print[
v[d] = v[d-1]+Sum[c[2k]Diag[h[1]^k h[2]^(d-2-k), ar[1,2]]+ c[2k+1]Diag[h[1]^k h[2]^(d-2-k), ar[2,1]], {k,0,d-2}] /. {c[0]->-(11/15360),c[1]->-(19/46080),c[2]->-(187/138240),c[3]->-(169/138240),c[4]->-(169/138240),c[5]->-(187/138240),c[6]->-(19/46080),c[7]->-(11/15360)}
];
V[d]=DExp[v[d]];
{R4Eqn[V[d]], TwistEqn[V[d]]}
] // PullDiags

d=6; ModDegree[d+1,
Print[
v[d] = v[d-1]
];
V[d]=DExp[v[d]];
{R4Eqn[V[d]], TwistEqn[V[d]]}
] // PullDiags

d=7; ModDegree[d+1,
Print[
v[d] = v[d-1]+Sum[c[2k]Diag[h[1]^k h[2]^(d-2-k), ar[1,2]]+ c[2k+1]Diag[h[1]^k h[2]^(d-2-k), ar[2,1]], {k,0,d-2}] /. {c[0]->(13/1161216),c[1]->(37/4644864),c[2]->(2669/69672960),c[3]->(1279/34836480),c[4]->(2539/34836480),c[5]->(125/1741824),c[6]->(125/1741824),c[7]->(2539/34836480),c[8]->(1279/34836480),c[9]->(2669/69672960),c[10]->(37/4644864),c[11]->(13/1161216)}
];
V[d]=DExp[v[d]];
{R4Eqn[V[d]], TwistEqn[V[d]]}
] // PullDiags

Solve[(#==0)& /@ {-((c[1])/4)+((c[10])/4),-((c[3])/4)+((c[8])/4),  -((3 c[0])/4)+((3 c[11])/4), -((3 c[2])/4)+((3 c[9])/4), -((c[5])/4)+((c[6])/4),-((3 c[4])/4)+((3 c[7])/4), (59/18579456)-((3 c[10])/4)+((c[11])/4), (143/7962624)+((c[2])/4)-((3 c[3])/4), (4961/139345920)+((c[4])/4)-((3 c[5])/4),(2539/52254720)-((2 c[4])/3),(2669/104509440)-((2 c[2])/3),-(13/1741824)+((2 c[0])/3)}, c /@ Range[0,11]]

d=8; ModDegree[d+1,
Print[
v[d] = v[d-1]
];
V[d]=DExp[v[d]];
{R4Eqn[V[d]], TwistEqn[V[d]]}
] // PullDiags

Return[]

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]]
]

Phi[2]

Pentagon[Phi_] := Phi**PutOn[1,{2,3},4, Phi]**PutOn[2,3,4, Phi]-PutOn[{1,2},3,4, Phi]**PutOn[1,2,{3,4}, Phi];
RR[d_] := ModDegree[d+1, DExp[1/2 (r[1,2]+r[2,1])]];
Hexagon[Phi_, RR_] := PutOn[{1,2},3,RR] - Phi**PutOn[2,3,RR]**PutOn[1,3,2, DInvert[Phi]]**PutOn[1,3,RR]**PutOn[3,1,2, Phi];

ModDegree[3, Pentagon[Phi[2]]]

ModDegree[3, Hexagon[Phi[2], RR[2]]]

Phi[3]

ModDegree[4, Pentagon[Phi[3]]]

v[3]

V[3]

ModDegree[4, V[3]**Adjoint[V[3]]]

ModDegree[4, Hexagon[Phi[3], RR[3]]]

Phi[4]

ModDegree[5, Pentagon[Phi[4]]]

ModDegree[5, Hexagon[Phi[4], RR[4]]]