Pensieve Header: Testing EmergentChordDiagrams.nb

SetDirectory["C:\\drorbn\\AcademicPensieve\\People\\Kuno"];
<< EmergentChordDiagrams.m

Bases

(Subscript[Basis, 2])[(Subscript[𝕆, AR,{x,y},{1,2}])]

AR: Reduction in A

D1=(Subscript[𝕆, AR,{x,y,z},{1,2}])[
(Subscript[𝒜, 0])[(Subscript[AW, 1])[x,y,x](Subscript[AW, 2])[x,x,y]]+
(Subscript[𝒜, c[1,2]])[(Subscript[AW, 1])[x,y](Subscript[AW, 2])[y,x](Subscript[AW, (OverBar[1])])[z](Subscript[AW, (OverBar[2])])[x,y]]
]//CF

HR: Reduction in the H Quotient

D2=(Subscript[𝕆, HR,{x,y,z},{1,2}])[
(Subscript[𝒜, 0])[(Subscript[AW, 1])[x,y,x](Subscript[AW, 2])[x,x,y]]+
(Subscript[𝒜, c[1,2]])[(Subscript[AW, 1])[x,y](Subscript[AW, 2])[y,x](Subscript[AW, (OverBar[1])])[z](Subscript[AW, (OverBar[2])])[x,y]]
]//CF

Reordering strands

(Subscript[𝕆, AR,{x,y},{1,2}])[(Subscript[𝒜, 0])[(Subscript[AW, 1])[x,y,y] (Subscript[AW, 2])[x]]]//(Subscript[𝕆, {2,1}])

Total@Table[B==(B//(Subscript[𝕆, {2,1,3}])//(Subscript[𝕆, {1,2,3}])),{B,(Subscript[Basis, 3])[(Subscript[𝕆, AR,{x,y},{1,2,3}])]}]

Total@Table[B==(B//(Subscript[𝕆, {2,1,3}])//(Subscript[𝕆, {1,2,3}])),{B,(Subscript[Basis, 4])[(Subscript[𝕆, AR,{x,y},{1,2,3}])]}]

Total@Table[B==(B//(Subscript[𝕆, {2,1,3}])//(Subscript[𝕆, {1,2,3}])),{B,(Subscript[Basis, 5])[(Subscript[𝕆, AR,{x,y},{1,2,3}])]}]

Associativity of Strand Multiplication

Total@Table[(B//(Subscript[sm, 1,2->1])//(Subscript[sm, 1,3->1]))==(B//(Subscript[sm, 2,3->2])//(Subscript[sm, 1,2->1])),{B,(Subscript[Basis, 3])[(Subscript[𝕆, AR,{x,y},{1,2,3}])]}]

Total@Table[(B//(Subscript[sm, 3,2->2])//(Subscript[sm, 2,1->1]))==(B//(Subscript[sm, 2,1->1])//(Subscript[sm, 3,1->1])),{B,(Subscript[Basis, 3])[(Subscript[𝕆, AR,{x,y},{1,2,3}])]}]

Co-Associativity of Strand Doubling

SortBy[
DeleteCases[
Table[B->((B//(Subscript[sΔ, 3->3,4])//(Subscript[sΔ, 4->4,5]))-(B//(Subscript[sΔ, 3->4,5])//(Subscript[sΔ, 4->3,4]))),{B,(Subscript[Basis, 3])[(Subscript[𝕆, AR,{x,y},{1,2,3}])]}],
_->0
],
LeafCount
]

The Hopf Axiom: Compatibility of Strand Doubling with Strand Multiplication

SortBy[
DeleteCases[
Table[B->((B//(Subscript[sΔ, 3->5,6])//(Subscript[sΔ, 4->7,8])//(Subscript[sm, 5,7->3])//(Subscript[sm, 6,8->4]))-(B//(Subscript[sm, 3,4->3])//(Subscript[sΔ, 3->3,4]))),{B,(Subscript[Basis, 3])[(Subscript[𝕆, AR,{x,y},{1,2,3,4}])]}],
_->0
],
LeafCount
]