Pensieve header:  Hour 30: Perturbing the Heisenberg-algebra knot invariant (2).

Recall,

(Subscript[m, k]^ij)=(e^(((Subscript[ξ, i])+(Subscript[ξ, j]))(Subscript[x, k])+((Subscript[π, i])+(Subscript[π, j]))(Subscript[p, k])-(Subscript[ξ, i])(Subscript[π, j]))),

(Subscript[R, ϵ])=(e^((T-1)((Subscript[p, i])-(Subscript[p, j]))(Subscript[x, j])+R'));	R'=(∑_(k=1)^$k)(ϵ^k)(R^((k))),

A(Subscript[ℒ, B])//B(Subscript[ℳ, C])=(e^((∑_(i∈B))(∂_(Subscript[z, i]))(∂_(Subscript[ζ, i]))))(ℒ·ℳ),

(Subscript[⟨F:ℰ⟩, B])=(e^((1/2)(∑_(u,v∈B))(Subscript[F, uv])(∂^u)(∂^v)))ℰ(Subscript[|, (Subscript[z, B])=0])  and  (Subscript[[F:ℰ], B])=(e^((1/2)(∑_(u,v∈B))(Subscript[F, uv])(∂^u)(∂^v)))ℰ

(Note, the two are equi-computable: clearly if we know how to compute [F:ℰ] we also know how to compute ⟨F:ℰ⟩, and also [F:ℰ](Subscript[|, (Subscript[z, B])->(Subscript[(OverBar[z]), B])])=⟨F:ℰ(Subscript[|, (Subscript[z, B])->(Subscript[z, B])+(Subscript[(OverBar[z]), B])])⟩).

(Subscript[Z, λ]):=log[λF:(e^E)]  satisfies  (Subscript[Z, 0])=E  and the “synthesis equation”,

(∂_λ)(Subscript[Z, λ])=(1/2)(Subscript[F, uv])((∂_u)(∂_v)(Subscript[Z, λ])+((∂_u)(Subscript[Z, λ]))((∂_v)(Subscript[Z, λ]))).

Lemma 1.   (Subscript[⟨F:ℰ (e^((1/2)(∑_(i,j∈B))(Subscript[G, ij])(Subscript[z, i])(Subscript[z, j])))⟩, B])=((det(I-GF))^(-1/2))(Subscript[⟨((F(I-GF))^(-1)):ℰ⟩, B]).

Lemma 2.   (Subscript[⟨F:ℰ (e^((∑_(i∈B))(Subscript[y, i])(Subscript[z, i])))⟩, B])=(e^((1/2)(∑_(i,j∈B))(Subscript[F, ij])(Subscript[z, i])(Subscript[z, j])))(Subscript[⟨F:ℰ(Subscript[|, (Subscript[Z, B])->(Subscript[Z, B])+(Subscript[Fy, B])])⟩, B]).

To solve the synthesis equation in general, we write (Subscript[Z, λ])=∑Z[m](λ^m) and then solve iteratively Z[0]=(Subscript[Z, 0])=E and

(m+1)Z[m+1]=(1/2)(Subscript[F, uv])((∂_u)(∂_v)Z[m]+(∑_j)((∂_u)Z[j])·((∂_v)Z[m-j])).

Definition. A power series f in an auxiliary variable ϵ and in the (Subscript[z, i])’s, including i∉B, is called docile if every monomial μ in it satisfies (Subscript[deg, z])μ<=2(Subscript[deg, ϵ])μ+2; we will short that to (Subscript[deg, z])f<=2(Subscript[deg, ϵ])f+2.

Claim 1. The synthesis equation preserves docility: if E is docile then so is (Subscript[Z, λ]), and in particular, so is log⟨F:(e^E)⟩.

(And so it makes sense to restrict our attention to docile perturbations!)

Claim 2. Restricting attention to {(Subscript[z, i]):i∈B}, if (Subscript[deg, (Subscript[z, B])])E<=4(Subscript[deg, ϵ])E then (Subscript[deg, (Subscript[z, B])])(Subscript[Z, λ])<=4(Subscript[deg, ϵ])(Subscript[Z, λ])-2(Subscript[deg, λ])(Subscript[Z, λ]) and thus (Subscript[deg, λ])(Subscript[Z, λ])<=2(Subscript[deg, ϵ])(Subscript[Z, λ]).

Claim 2 implies that  if E(Subscript[|, ϵ=0]) is independent of (Subscript[z, B]) and if we only care about (Subscript[Z, λ]) up to (ϵ^k), then the iterative process for finding (Subscript[Z, λ]) terminates at Z[2k].

Conclusion. We can compute efficiently (in polynomial time!) if all of our generating functions are of the form ω (e^(Q+P)), where ω is a scalar, Q is an ϵ-free quadratic, and P=(∑_(k=1)^$k)(P^((k)))(ϵ^k), where deg (P^((k)))<=2k+2.

On to the implementation...

𝔼[ω,Q,P_ϵSeries] represents ω (e^(Q+P)), where ω is a scalar, Q is an ϵ-free quadratic, and P=(∑_(k=0)^$k)P[[k]](ϵ^k) is a docile perturbation (it is ill-advised to include ω in P because then it will have log terms, so always, P[[0]]=0).

Initialization and minor utilities

SetDirectory["C:\\drorbn\\AcademicPensieve\\Classes\\21-1350-KnotTheory"];
Once[<<"Common.m"];

$k=1;

CCF[ℰ_] := ExpandDenominator@ExpandNumerator@Together[ℰ];

ComposeList[{Together, ExpandNumerator, ExpandDenominator}, (1/(T-1))+(1/(T-2))]

CCF[(1/(T-1))+(1/(T-2))]

CF[ℰ_List]:=CF/@ℰ;
CF[ℰ_ϵSeries]:=CF/@ℰ;
CF[ℰ_] :=Module[
{vs=Cases[ℰ,(Subscript[(p|x|π|ξ), _]),∞]⋃{p|x|π|ξ}},
Total[CoefficientRules[Expand[ℰ], vs] /. (ps_->c_) :> CCF[c](Times@@(vs^ps))]
];
CF[ℰ_𝔼]:=CF/@ℰ; 
CF[(Subscript[𝔼, sp___])[ℰs___]]:=CF/@(Subscript[𝔼, sp])[ℰs];

CF[(T (Subscript[x, 1])+(T-1)(Subscript[x, 2]))(((Subscript[p, 1])/(T-2))+(Subscript[p, 2]))]

ϵSeries/: S1_ϵSeries≡S2_ϵSeries:=Length[S1]==Length[S2]∧Inner[CF[#1]==CF[#2]&,S1,S2,And];
ϵSeries[0]:=ϵSeries@@Table[0,$k+1];
ϵSeries/: S1_ϵSeries+S2_ϵSeries := ϵSeries@@Table[S1[[k]]+S2[[k]],{k,Min[Length@S1,Length@S2]}];
ϵSeries/: S1_ϵSeries*S2_ϵSeries := ϵSeries@@Table[Sum[S1[[j+1]]*S2[[k-j+1]], {j,0,k}],{k,0,Min[Length@S1,Length@S2]-1}];
ϵSeries /:c_*S_ϵSeries:=(c#)& /@ S;
ϵSeries/:(∂_(vs___))S_ϵSeries:=(s|->(∂_vs)s)/@S;

ϵSeries[0,2,7,-1]ϵSeries[0,3,5,19,1350]

The Main Program

Variables and their duals:

{(SuperStar[p]),(SuperStar[x]),(SuperStar[π]),(SuperStar[ξ])}={π,ξ,p,x}; 
(SuperStar[(vs_List)]):=(v|->(SuperStar[v]))/@vs;
(SuperStar[((Subscript[u_, i_]))]):=(Subscript[((SuperStar[u])), i]);

𝔼 operations:

𝔼/:𝔼[ω1_,Q1_,P1_]≡𝔼[ω2_,Q2_,P2_]:=CF[ω1==ω2]∧CF[Q1==Q2]∧(P1≡P2);
𝔼/:𝔼[ω1_,Q1_,P1_]𝔼[ω2_,Q2_,P2_]:=𝔼[ω1 ω2,Q1+Q2,P1+P2];
(Subscript[𝔼, d1_->r1_])[ℰ1s___]≡(Subscript[𝔼, d2_->r2_])[ℰ2s___] ^:= (d1==d2)∧(r1==r2)∧(𝔼[ℰ1s]≡𝔼[ℰ2s]);
(Subscript[𝔼, d1_->r1_])[ℰ1s___](Subscript[𝔼, d2_->r2_])[ℰ2s___] ^:= (Subscript[𝔼, (d1⋃d2)->(r1⋃r2)])@@(𝔼[ℰ1s]𝔼[ℰ2s]);

Getting rid of the quadratic using lemma 1.

Lemma 1.   (Subscript[⟨F:ℰ (e^((1/2)(∑_(i,j∈B))(Subscript[G, ij])(Subscript[z, i])(Subscript[z, j])))⟩, B])=((det(I-GF))^(-1/2))(Subscript[⟨((F(I-GF))^(-1)):ℰ⟩, B]).

(Subscript[Zip1, {}])=Identity;
(Subscript[Zip1, vs_])@⟨ℱ_,𝔼[ω_,Q_,P_]⟩ := Module[{ℐ,F,G,u,v},
ℐ=IdentityMatrix@Length@vs;
F=Table[(∂_(u,v))ℱ,{u,(SuperStar[vs])},{v,(SuperStar[vs])}];
G=Table[(∂_(u,v))Q,{u,vs},{v,vs}];
CF/@⟨
(SuperStar[vs]).F.Inverse[ℐ-G.F].(SuperStar[vs])/2,
𝔼[PowerExpand@Factor[ω  ((Det[ℐ- G.F])^(-1/2))],Q-vs.G.vs/2,P]
⟩
]

Ex1=CF/@⟨(2/2)(Subscript[ξ, 1]^2),𝔼[19,(1/2){(Subscript[x, 1]),(Subscript[x, 2])}.(({{-3, 2}, {2, 7}})).{(Subscript[x, 1]),(Subscript[x, 2])},ϵSeries[0,(Subscript[x, 1])]]⟩

Ex1//(Subscript[Zip1, {(Subscript[x, 1])}])

Getting rid of linear terms using Lemma 2.

Lemma 2.   (Subscript[⟨F:ℰ (e^((∑_(i∈B))(Subscript[y, i])(Subscript[z, i])))⟩, B])=(e^((1/2)(∑_(i,j∈B))(Subscript[F, ij])(Subscript[z, i])(Subscript[z, j])))(Subscript[⟨F:ℰ(Subscript[|, (Subscript[Z, B])->(Subscript[Z, B])+(Subscript[Fy, B])])⟩, B]).

(Subscript[Zip2, {}])=Identity;
(Subscript[Zip2, vs_])@⟨ℱ_,𝔼[ω_,Q_,P_]⟩ := Module[{F,Y,u,v},
F=Table[(∂_(u,v))ℱ,{u,(SuperStar[vs])},{v,(SuperStar[vs])}];
Y=Table[(∂_v)Q,{v,vs}];
CF/@⟨ℱ, 𝔼[ω,Q-Y.vs+Y.F.Y/2, P/.Thread[vs->vs+F.Y]]⟩
]

Dealing with Feynman diagrams without ever seeing them, using the synthesis equation and iteration. Write (Subscript[Z, λ])=∑Z[m](λ^m) and then Z[0]=(Subscript[Z, 0])=E and

Z[m+1]=(1/(2(m+1)))(Subscript[F, uv])((∂_u)(∂_v)Z[m]+(∑_j)((∂_u)Z[j])·((∂_v)Z[m-j])),

and we only care to compute up to Z[[2$k]]:

(Subscript[Zip3, vs_])@⟨ℱ_,𝔼[ω_,Q_,P_]⟩ := Module[{Z,u,v,m,j},
Z[0]=P;
For[m=0,m<2$k,++m,
Z[m+1]=CF[(1/(2(m+1)))Sum[(∂_((SuperStar[u]),(SuperStar[v])))ℱ((∂_(u,v))Z[m]+Sum[((∂_u)Z[j])((∂_v)Z[m-j]),{j,0,m}]),{u,vs},{v,vs}]]
];
𝔼[ω,Q,CF[Sum[Z[m],{m,0,2$k}]/.Table[v->0,{v,vs}]]]
]

Block[{$k=2}, ⟨(1/2)(ξ^2),𝔼[1,0,ϵSeries[0,(1/6)(x^3),0]]⟩//(Subscript[Zip3, {x}])]

(1/(2^3))+(1/(3! 2))

Block[{$k=4}, ⟨(1/2)(ξ^2),𝔼[1,0,ϵSeries[0,(1/6)(x^3),0,0,0]]⟩//(Subscript[Zip3, {x}])]

From “Cubic Multigraphs A005967” by Richard J. Mathar, https://oeis.org/A005967/a005967.pdf:

(1/(4!))+(1/(3! (2^3)))+(1/(2^3))+(1/(2^4))+(1/(2^4))

Block[{$k=8}, ⟨(1/2)(ξ^2),𝔼[1,0,ϵSeries[0,(1/6)(x^3),Sequence@@Table[0,$k-1]]]⟩//(Subscript[Zip3, {x}])]

Check out https://oeis.org/!

Module[{l,m},Log[Sum[l=3m/2;  (((3m)!(ϵ^m))/((2^l)l!(6^m)m!)), {m,0,30,2}]+((O[ϵ])^31)]]

Check out https://oeis.org/!

(Subscript[Zip, vs_])[ℱ_,ℰ_]:=⟨ℱ,ℰ⟩//(Subscript[Zip1, vs])//(Subscript[Zip2, vs])//(Subscript[Zip3, vs])

(Subscript[𝔼, d1_->r1_])[ℰ1s___]//(Subscript[𝔼, d2_->r2_])[ℰ2s___] :=Module[{is=r1⋂d2,lvs},
lvs=Flatten@Table[{(Subscript[x, $@i]),(Subscript[p, $@i])},{i,is}];
(Subscript[𝔼, (d1⋃Complement[d2,is])->(r2⋃Complement[r1,is])])@@((Subscript[Zip, lvs⋃(SuperStar[lvs])])[(SuperStar[lvs]).lvs,Times[
𝔼[ℰ1s]/.Table[(Subscript[(v:x|p), i])->(Subscript[v, $@i]),{i,is}],
𝔼[ℰ2s]/.Table[(Subscript[(v:ξ|π), i])->(Subscript[v, $@i]),{i,is}]
]])
]

The Basic Tensors

(Subscript[η, i_]):=(Subscript[𝔼, {}->{i}])[1,0,ϵSeries[0]];
(Subscript[m, i_,j_->k_]):=(Subscript[𝔼, {i,j}->{k}])[1,-(Subscript[ξ, i])(Subscript[π, j])+((Subscript[π, i])+(Subscript[π, j]))(Subscript[p, k])+((Subscript[ξ, i])+(Subscript[ξ, j]))(Subscript[x, k]),ϵSeries[0]]

AllMonomials[{},0]={1};
AllMonomials[{},d_Integer] /; d>0 := {};
AllMonomials[{v_,vs___},d_Integer] := Join@@Table[(v^(d-k))AllMonomials[{vs},k],{k,0,d}];
AllMonomials[vs_List, {d_}] := Join@@Table[AllMonomials[vs,k],{k,0,d}];

Basis[js_List,m_]:=Flatten@Outer[Times,AllMonomials[Table[(Subscript[p, j]),{j,js}],m],AllMonomials[Table[(Subscript[x, j]),{j,js}],m]];
Basis[js_List,{m_}]:=Flatten@Table[Basis[js,k],{k,0,m}]

Basis[{i,j},{2}]

GenericCombination[bas_,c_]:=bas.Table[(Subscript[c, j]),{j,Length@bas}];
GenericCombination[bas_,(Subscript[c_, k_])]:=bas.Table[(Subscript[c, k,j]),{j,Length@bas}];

GenericCombination[Basis[{i,j},{2}],(Subscript[c, 1])]

(Subscript[R, i_,j_]):=(Subscript[𝔼, {}->{i,j}])[(T^(1/2)),(T-1)((Subscript[p, i])-(Subscript[p, j])) (Subscript[x, j]) ,ϵSeries@@Prepend[0]@Table[GenericCombination[Basis[{i,j},{k+1}],(Subscript[c, k])],{k,$k}]];
(Subscript[(OverBar[R]), i_,j_]):=(Subscript[𝔼, {}->{i,j}])[(T^(-1/2)),((T^(-1))-1)((Subscript[p, i])-(Subscript[p, j])) (Subscript[x, j]),ϵSeries@@Prepend[0]@Table[GenericCombination[Basis[{i,j},{k+1}],(Subscript[d, k])],{k,$k}]];
(Subscript[C, i_]):=(Subscript[𝔼, {}->{i}])[(T^(1/2)),0,ϵSeries@@Prepend[0]@Table[GenericCombination[Basis[{i},{k+1}],(Subscript[e, k])],{k,$k}]];
(Subscript[(OverBar[C]), i_]):=(Subscript[𝔼, {}->{i}])[(T^(-1/2)),0,ϵSeries@@Prepend[0]@Table[GenericCombination[Basis[{i},{k+1}],(Subscript[f, k])],{k,$k}]];

{(Subscript[R, 1,2]), (Subscript[(OverBar[R]), 1,2]),(Subscript[C, 1]),(Subscript[(OverBar[C]), 1])}

RMoves:={
((Subscript[R, 1,2])(Subscript[R, 4,3])(Subscript[R, 5,6])//(Subscript[m, 1,4->1])//(Subscript[m, 2,5->2])//(Subscript[m, 3,6->3]))≡((Subscript[R, 2,3])(Subscript[R, 4,5])(Subscript[R, 1,6])//(Subscript[m, 1,4->1])//(Subscript[m, 2,5->2])//(Subscript[m, 3,6->3])),
((Subscript[R, 1,2])(Subscript[(OverBar[R]), 3,4])//(Subscript[m, 1,3->1])//(Subscript[m, 2,4->2]))≡((Subscript[η, 1])(Subscript[η, 2])),
((Subscript[C, 1])(Subscript[(OverBar[C]), 2])//(Subscript[m, 1,2->1]) )≡(Subscript[η, 1]),
((Subscript[R, 1,4])(Subscript[(OverBar[R]), 5,2])(Subscript[(OverBar[C]), 3])//(Subscript[m, 2,4->2])//(Subscript[m, 1,3->1])//(Subscript[m, 1,5->1]))≡(Subscript[(OverBar[C]), 1])(Subscript[η, 2]),
((Subscript[C, 3])(Subscript[R, 1,2])//(Subscript[m, 2,3->2])//(Subscript[m, 2,1->1]))≡((Subscript[(OverBar[C]), 3])(Subscript[R, 1,2])//(Subscript[m, 1,3->1])//(Subscript[m, 1,2->1])),
((Subscript[(OverBar[C]), 2])(Subscript[R, 1,3])//(Subscript[m, 1,2->1])//(Subscript[m, 1,3->1]))≡(Subscript[η, 1]), ((Subscript[(OverBar[C]), 2])(Subscript[(OverBar[R]), 3,1])//(Subscript[m, 1,2->1])//(Subscript[m, 1,3->1]))≡(Subscript[η, 1]),
((Subscript[C, 2])(Subscript[(OverBar[R]), 1,3])//(Subscript[m, 1,2->1])//(Subscript[m, 1,3->1]))≡(Subscript[η, 1]),((Subscript[C, 2])(Subscript[R, 3,1])//(Subscript[m, 1,2->1])//(Subscript[m, 1,3->1]))≡(Subscript[η, 1])
}

Solving for R, C, $k=1

$k=1;
{(Subscript[R, 1,2]),(Subscript[C, 1])}
unknowns=Cases[{(Subscript[R, 1,2]),(Subscript[(OverBar[R]), 1,2]),(Subscript[C, 1]),(Subscript[(OverBar[C]), 1])},(Subscript[(c|d|e|f), $k,_]),∞]//Union

Short[errors=CCF/@Cases[RMoves,  a_==b_ :> a-b], 25]

eqns=Thread[0==Union@@(CoefficientRules[#,{(Subscript[x, 1]),(Subscript[x, 2]),(Subscript[x, 3]),(Subscript[p, 1]),(Subscript[p, 2]),(Subscript[p, 3])}][[;;,2]]& /@ errors)]

{sol}=Solve[eqns,unknowns]

sol/.(a_->b_):>(a=b)

{(Subscript[R, 1,2]),(Subscript[(OverBar[R]), 1,2]),(Subscript[C, 1]),(Subscript[(OverBar[C]), 1])}

Cases[{(Subscript[R, 1,2]),(Subscript[(OverBar[R]), 1,2]),(Subscript[C, 1]),(Subscript[(OverBar[C]), 1])},(Subscript[(c|d|e|f), $k,_]),∞]//Union

{(Subscript[c, 1,2])=0,(Subscript[c, 1,5])=0,(Subscript[c, 1,7])=0,(Subscript[c, 1,10])=1};
{(Subscript[R, 1,2]),(Subscript[(OverBar[R]), 1,2]),(Subscript[C, 1]),(Subscript[(OverBar[C]), 1])}

RMoves

Some Knot Theory at $k=1

ZF[Knot[3,1]]

ZF/@{Knot[6,1], Knot[9,46]}

equiv={Knot[10,106],Knot[12,NonAlternating,369]};
Length@Union@Echo[ZF/@equiv]

equiv={Knot[12,Alternating,427],Knot[12,Alternating,435],Knot[12,Alternating,990]};
Length@Union[ZF/@equiv]

Solving for R, C, $k=2

$k=2;
{(Subscript[R, 1,2]),(Subscript[C, 1])}
Short[RMoves,20]

unknowns=Cases[{(Subscript[R, 1,2]),(Subscript[(OverBar[R]), 1,2]),(Subscript[C, 1]),(Subscript[(OverBar[C]), 1])},(Subscript[(c|d|e|f), $k,_]),∞]//Union

Short[errors=CCF/@Cases[RMoves,  a_==b_ :> a-b], 25]

Short[#,10]&[eqns=Thread[0==Union@@(CoefficientRules[#,{(Subscript[x, 1]),(Subscript[x, 2]),(Subscript[x, 3]),(Subscript[p, 1]),(Subscript[p, 2]),(Subscript[p, 3])}][[;;,2]]& /@ errors)]]

{sol}=Solve[eqns,unknowns]

sol/.(a_->b_):>(a=b)

Cases[{(Subscript[R, 1,2]),(Subscript[(OverBar[R]), 1,2]),(Subscript[C, 1]),(Subscript[(OverBar[C]), 1])},(Subscript[(c|d|e|f), $k,_]),∞]//Union

{(Subscript[c, 2,2])=0,(Subscript[c, 2,5])=0,(Subscript[c, 2,7])=0,(Subscript[c, 2,10])=0,(Subscript[c, 2,16])=0};
{(Subscript[R, 1,2]),(Subscript[(OverBar[R]), 1,2]),(Subscript[C, 1]),(Subscript[(OverBar[C]), 1])}

RMoves

Some Knot Theory at $k=2

According to 12XingStats.nb at pensieve://Projects/SL2Invariant/k=2/ the following pair have equal (Subscript[ρ, 1]) but different (Subscript[ρ, 2]):

equiv={Knot[10,106],Knot[12,NonAlternating,369]};
res21=ZF/@equiv
Simplify[res21[[1]]≡res21[[2]]]

According to 12XingStats.nb at pensieve://Projects/SL2Invariant/k=2/ the following triple have equal (Subscript[ρ, 1]) but different (Subscript[ρ, 2]):

equiv={Knot[12,Alternating,427],Knot[12,Alternating,435],Knot[12,Alternating,990]};
Length@Union[res22=ZF/@equiv]

Solving for R, C, $k=3

$k=3;
Short[RMoves,20]

unknowns=Cases[{(Subscript[R, 1,2]),(Subscript[(OverBar[R]), 1,2]),(Subscript[C, 1]),(Subscript[(OverBar[C]), 1])},(Subscript[(c|d|e|f), $k,_]),∞]//Union

Short[errors=CCF/@Cases[RMoves,  a_==b_ :> a-b], 25]

Short[#,10]&[eqns=Thread[0==Union@@(CoefficientRules[#,{(Subscript[x, 1]),(Subscript[x, 2]),(Subscript[x, 3]),(Subscript[p, 1]),(Subscript[p, 2]),(Subscript[p, 3])}][[;;,2]]& /@ errors)]]

{sol}=Solve[eqns,unknowns]

sol/.(a_->b_):>(a=b)

Cases[{(Subscript[R, 1,2]),(Subscript[(OverBar[R]), 1,2]),(Subscript[C, 1]),(Subscript[(OverBar[C]), 1])},(Subscript[(c|d|e|f), $k,_]),∞]//Union

{(Subscript[c, 3,2])=0,(Subscript[c, 3,5])=0,(Subscript[c, 3,7])=0,(Subscript[c, 3,10])=0,(Subscript[c, 3,16])=0,(Subscript[c, 3,32])=1};
{(Subscript[R, 1,2]),(Subscript[(OverBar[R]), 1,2]),(Subscript[C, 1]),(Subscript[(OverBar[C]), 1])}

RMoves