(* ::Package:: *)

(************************************************************************)
(* This file was generated automatically by the Mathematica front end.  *)
(* It contains Initialization cells from a Notebook file, which         *)
(* typically will have the same name as this file except ending in      *)
(* ".nb" instead of ".m".                                               *)
(*                                                                      *)
(* This file is intended to be loaded into the Mathematica kernel using *)
(* the package loading commands Get or Needs.  Doing so is equivalent   *)
(* to using the Evaluate Initialization Cells menu command in the front *)
(* end.                                                                 *)
(*                                                                      *)
(* DO NOT EDIT THIS FILE.  This entire file is regenerated              *)
(* automatically each time the parent Notebook file is saved in the     *)
(* Mathematica front end.  Any changes you make to this file will be    *)
(* overwritten.                                                         *)
(************************************************************************)



Print["In the U(T)\[TensorProduct]U(H) conventions. Internal use symbols: ", {rr,pp}]


SetDirectory["C:\\drorbn\\AcademicPensieve\\Projects\\OneCo-1604"]


Simp[\[CurlyEpsilon]_] := Simplify[\[CurlyEpsilon]];
CF[\[CurlyEpsilon]_]:=\[CurlyEpsilon]/.\[Lambda]_\[Beta]|\[Lambda]_a|\[Lambda]_\[Delta]\[Beta]|\[Lambda]_\[Delta]a|\[Lambda]_\[Delta]aa|\[Lambda]_c|\[Lambda]_ao|\[Lambda]_ca|\[Lambda]_aao:>MapAt[Simp,\[Lambda],1];
AutoCollecting[\[Lambda]_] := (\[Lambda] /: \[Lambda][0,___] = 0;
\[Lambda] /: \[Lambda][f_, r___] + \[Lambda][g_, r___] := \[Lambda][Simp[f+g], r];
\[Lambda] /: g_*\[Lambda][f_, r___] := \[Lambda][Simp[g f], r]);
AutoCollecting /@ {\[Beta], a, \[Delta]\[Beta], \[Delta]a,\[Delta]aa,c,ao,ca,aao};
UU /: UU[x_]+UU[y_] := UU[x+y];
UU /: a_*UU[x_] := UU[Expand[a x]];
UU /: D[u_UU, vs__] := CF[u/.\[Lambda]_\[Beta]|\[Lambda]_a|\[Lambda]_\[Delta]\[Beta]|\[Lambda]_\[Delta]a|\[Lambda]_\[Delta]aa :> MapAt[D[#,vs]&, \[Lambda], 1]];
Subscript[b, \[CCedilla]]=1;
\[Gamma]a[f_, j_,k_,l_,m_] := \[Delta]aa[f,j,k,l,m]-\[Delta]aa[Subscript[b, j]f,\[CCedilla],k,l,m];
hb[f_,i_,j_,k_]:=a[Subscript[b, j]f,i,k]-a[Subscript[b, i]f,j,k] (*=f[Subscript[a, ik],Subscript[a, jk]]*);
\[Delta]hb[f_,i_,j_,k_]:=\[Delta]a[Subscript[b, j]f,i,k]-\[Delta]a[Subscript[b, i]f,j,k];
\[Delta]tb[f_,x_,j_,l_]:=\[Delta]aa[f,\[CCedilla],l,x,j]-\[Delta]aa[f,\[CCedilla],j,x,l];
UU /: Coefficient[u_UU, \[Lambda]_[js___]] := Total[Cases[u, \[Lambda][f_,js]:>f, \[Infinity]]];
K\[Delta] /: Subscript[K\[Delta], is__]:=KroneckerDelta[1,Length[Union[{is}]]];


\[CapitalARing]Form = ReplaceAll[{
\[Delta]a[f_,\[CCedilla],j_]:>c[f,j],
\[Delta]a[f_,i_,j_]:>ao[f,i,j]+c[Subscript[b, i]f,j],
\[Delta]aa[f_,\[CCedilla],j_,k_,l_]:>ca[f,j,k,l],
\[Delta]aa[f_,j_,k_,\[CCedilla],l_]:>\!\(TraditionalForm\`ca[f, l, j, k] + 
\*SubscriptBox[\(K\[Delta]\), \(k\[InvisibleComma]l\)] ao[f, j, k]\),
\[Delta]aa[f_,i_,j_,k_,l_]:>aao[f,i,j,k,l]+ca[Subscript[b, i]f,j,k,l]+\!\(TraditionalForm\`ca[
\*SubscriptBox[\(b\), \(k\)] f, l, i, j] + 
\*SubscriptBox[\(K\[Delta]\), \(j\[InvisibleComma]l\)] ao[
\*SubscriptBox[\(b\), \(k\)] f, i, j]\) }];
\[Delta]aForm=ReplaceAll[{c[f_,i_] :> \[Delta]a[f,\[CCedilla],i],
ao[f_,i_,j_]:> \[Delta]a[f,i,j]-\[Delta]a[Subscript[b, i]f,\[CCedilla],j],
ca[f_,i_,j_,k_]:>\[Delta]aa[f,\[CCedilla],i,j,k],
aao[f_,i_,j_,k_,l_]:> \[Delta]aa[f,i,j,k,l]-\[Delta]aa[Subscript[b, i]f,\[CCedilla],j,k,l]-\[Delta]aa[Subscript[b, k]f,i,j,\[CCedilla],l] }];


i_\[PrecedesEqual]j_:=OrderedQ[{i,j}]; i_\[Precedes]j_:=!OrderedQ[{j,i}];
CF[UU[\[CurlyEpsilon]_]]:=UU[CF[\[CurlyEpsilon]/.\[Delta]aa[f_,i_,j_,k_,l_]:>Which[
k===\[CCedilla],\[Delta]aa[f,\[CCedilla],l,i,j]+Subscript[K\[Delta], j\[InvisibleComma]l]\[Delta]hb[f,i,\[CCedilla],j],
(i===\[CCedilla])\[Or](i\[PrecedesEqual]k\[And]j\[PrecedesEqual]l), \[Delta]aa[f,i,j,k,l],
k\[Precedes]i\[And]j\[Precedes]l, \[Delta]aa[f,k,j,i,l]+\[Delta]aa[-f Subscript[b, i],\[CCedilla],l,k,j]+\[Delta]aa[f Subscript[b, i],\[CCedilla],j,k,l]+\[Delta]aa[-f Subscript[b, k],\[CCedilla],j,i,l]+\[Delta]aa[f Subscript[b, k],\[CCedilla],l,i,j],
k\[Precedes]i\[And]j===l, \[Delta]a[-f Subscript[b, i] ,k,j]+\[Delta]a[f Subscript[b, k] ,i,j]+\[Delta]aa[f,k,j,i,j],
i\[PrecedesEqual]k\[And]l\[Precedes]j, \[Delta]aa[f,i,l,k,j]+\[Delta]aa[-f Subscript[b, i],\[CCedilla],l,k,j]+\[Delta]aa[f Subscript[b, i],\[CCedilla],j,k,l]+\[Delta]aa[-f Subscript[b, k],\[CCedilla],j,i,l]+\[Delta]aa[f Subscript[b, k],\[CCedilla],l,i,j],
k\[Precedes]i\[And]l\[Precedes]j, \[Delta]aa[f,k,l,i,j]
]]];


UUBasis[T_List, H_List, f_] := Module[
{ff,n=0,h,t,h1,h2,i,j,k,l},
ff:=
\!\(\*SubscriptBox[\(f\), \(++n\)]\)@@Table[Subscript[b, t], {t,T}];
CF /@ UU /@ Flatten@{
\[Beta][ff],\[Delta]\[Beta][ff],
Table[a[ff, t,h], {t,T}, {h,H}],
Table[\[Delta]a[ff,t,h], {t,T\[Union]{\[CCedilla]}}, {h,H}],
Table[\[Delta]aa[ff,\[CCedilla],h1,t,h2], {t,T}, {h1,H},{h2,H}],
Table[\[Delta]aa[ff, T[[i]],H[[j]],T[[k]],H[[l]]], {k,Length@T},{i,k}, {l,Length@H},{j,l}]
} /. Subscript[1, _][___] -> 1
];
UUBasis[S_List,f_] := UUBasis[S,S,f];
UUBasis[n_Integer,m_Integer,f_] := UUBasis[Range@n,Range@m,f];
UUBasis[n_Integer, f_] := UUBasis[Range@n, f];


\[CapitalARing]Basis[T_List, H_List, f_] := Module[
{ff,n=0,h,t,h1,h2,i,j,k,l},
ff:=
\!\(\*SubscriptBox[\(f\), \(++n\)]\)@@Table[Subscript[b, t], {t,T}];
CF /@ UU /@ Flatten@{
\[Beta][ff],
Table[a[ff, t,h], {t,T}, {h,H}],
\[Delta]\[Beta][ff],
Table[c[ff,h],{h,H}],
Table[ao[ff,t,h], {t,T}, {h,H}],
Table[ca[ff, h1,t,h2], {t,T}, {h1,H},{h2,H}],
Table[aao[ff, T[[i]],H[[j]],T[[k]],H[[l]]], {k,Length@T},{i,k}, {l,Length@H},{j,l}]
} /. Subscript[1, _][___] -> 1
];
\[CapitalARing]Basis[S_List,f_] := \[CapitalARing]Basis[S,S,f];
\[CapitalARing]Basis[n_Integer,m_Integer,f_] := \[CapitalARing]Basis[Range@n,Range@m,f];
\[CapitalARing]Basis[n_Integer, f_] := \[CapitalARing]Basis[Range@n, f];


h\[Infinity]Basis[S_List,f_] := Module[{n=0},
Select[UUBasis[S,S\[Union]{h\[Infinity]},f], Count[#,h\[Infinity],{2}]==1&] /. Subscript[f, _][bs___]:> 
\!\(\*SubscriptBox[\(f\), \(++n\)]\)[bs]
];
h\[Infinity]\[CapitalARing]Basis[S_List,f_] := Module[{n=0},
Select[\[CapitalARing]Basis[S,S\[Union]{h\[Infinity]},f], Count[#,h\[Infinity],{2}]==1&] /. Subscript[f, _][bs___]:> 
\!\(\*SubscriptBox[\(f\), \(++n\)]\)[bs]
];


UU/:UU[L_]**UU[R_]:=CF@UU[Expand[Distribute[pp[L,R]] /. {
pp[0,_] -> 0, pp[_,0] -> 0,
pp[\[Beta][f_], \[Lambda]_\[Beta]|\[Lambda]_a|\[Lambda]_\[Delta]\[Beta]|\[Lambda]_\[Delta]a|\[Lambda]_\[Delta]aa] :> MapAt[f #&, \[Lambda], 1],
pp[_\[Delta]\[Beta]|_\[Delta]a|_\[Delta]aa,_\[Delta]\[Beta]|_\[Delta]a|_\[Delta]aa] -> 0,
pp[\[Delta]a[f_,i_,j_],a[g_,k_,l_]] :> \[Delta]aa[f g,i,j,k,l]-Subscript[K\[Delta], j\[InvisibleComma]k]\[Delta]hb[f g,i,j,l],
pp[\[Delta]\[Beta][f_],\[Beta][g_]] :> \[Delta]\[Beta][f g],
pp[\[Delta]\[Beta][f_],a[g_,i_,j_]] :> \[Delta]a[f g,i,j]
}]];


UU[\[CurlyEpsilon]_] // tm[x_,y_,z_] := (rr=Replace[x|y->z];
CF[UU[Expand[\[CurlyEpsilon] /. {
a[f_,x,j_] :> a[f,z,j]+\[Delta]hb[\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(b\), \(y\)]]f\),z,\[CCedilla],j],
a[f_,y,j_] :> a[f,z,j],
\[Delta]a[f_,x|y,j_] :> \[Delta]a[f,z,j],
\[Delta]aa[f_,i_,j_,k_,l_] :> \[Delta]aa[f,rr@i, j, rr@k, l]
} /. Subscript[b, x|y]->Subscript[b, z]]]]);


UU[\[CurlyEpsilon]_] // hm[x_,y_,z_] := (rr=Replace[x|y->z];
CF[UU[Expand[\[CurlyEpsilon] /. {
a[f_,i_,x|y] :> a[f,i,z],
\[Delta]a[f_,i_,x|y] :> \[Delta]a[f,i,z],
\[Delta]aa[f_,i_,y,k_,x] :> \[Delta]aa[f,k,z,i,z],
\[Delta]aa[f_,i_,j_,k_,l_] :> \[Delta]aa[f,i,rr@j, k, rr@l]
}]]]);


UU[\[CurlyEpsilon]_] // hts[y_,x_] := CF[UU[Expand[\[CurlyEpsilon] /. {
a[f_,i_,j_] :> a[f,i,j] - Subscript[K\[Delta], j\[InvisibleComma]y]\[Delta]hb[\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(b\), \(x\)]]f\),i,\[CCedilla],y] - Subscript[K\[Delta], i\[InvisibleComma]x] Subscript[K\[Delta], j\[InvisibleComma]y](\[Beta][f Subscript[b, x]]-\[Delta]a[f,\[CCedilla],y]-\[Delta]\[Beta][Subscript[b, x]\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(b\), \(x\)]]f\)]),
\[Delta]a[f_,x,y] :> \[Delta]a[f,x,y] -\[Delta]\[Beta][f Subscript[b, x]],
\[Delta]aa[f_,i_,j_,k_,l_] :> \[Delta]aa[f,i,j,k,l]+Subscript[K\[Delta], i\[InvisibleComma]x] Subscript[K\[Delta], j\[InvisibleComma]y]\[Delta]a[-Subscript[b, x]f,k,l] + Subscript[K\[Delta], i\[InvisibleComma]x] Subscript[K\[Delta], l\[InvisibleComma]y](\[Delta]a[Subscript[b, k]f,x,j]-\[Delta]a[Subscript[b, x]f,k,j]) + Subscript[K\[Delta], k\[InvisibleComma]x] Subscript[K\[Delta], j\[InvisibleComma]y](\[Delta]a[Subscript[b, i]f,x,l]-\[Delta]a[Subscript[b, x]f,i,l]) + Subscript[K\[Delta], k\[InvisibleComma]x] Subscript[K\[Delta], l\[InvisibleComma]y]\[Delta]a[-Subscript[b, x]f,i,j]-Subscript[K\[Delta], i\[InvisibleComma]x] Subscript[K\[Delta], j\[InvisibleComma]l\[InvisibleComma]y]\[Delta]\[Beta][Subscript[b, x] Subscript[b, k]f]+2Subscript[K\[Delta], x\[InvisibleComma]i\[InvisibleComma]k] Subscript[K\[Delta], y\[InvisibleComma]j\[InvisibleComma]l]\[Delta]\[Beta][Subscript[b, x] Subscript[b, x]f]
}]]];


dm[x_,y_,z_][\[CurlyEpsilon]_] := \[CurlyEpsilon] // hts[x,y] // tm[x,y,z] // hm[x,y,z]


t\[Sigma][x_List,y_List][\[CurlyEpsilon]_] := (rr=Replace[Thread[x->y]];
CF[\[CurlyEpsilon] /. Subscript[b, i_]:>Subscript[b, rr@i] /. {
a[f_,i_,j_] :> a[f,rr@i,j],
\[Delta]a[f_,i_,j_] :> \[Delta]a[f,rr@i,j],
\[Delta]aa[f_,i_,j_,k_,l_]:>\[Delta]aa[f,rr@i,j,rr@k,l]
}]);
t\[Sigma][x_,y_][\[CurlyEpsilon]_] := t\[Sigma][{x},{y}][\[CurlyEpsilon]];
h\[Sigma][x_List,y_List][\[CurlyEpsilon]_] := (rr=Replace[Thread[x->y]];
CF[\[CurlyEpsilon] /. {
a[f_,i_,j_] :> a[f,i,rr@j],
\[Delta]a[f_,i_,j_] :> \[Delta]a[f,i,rr@j],
\[Delta]aa[f_,i_,j_,k_,l_]:>\[Delta]aa[f,i,rr@j,k,rr@l]
}]);
h\[Sigma][x_,y_][\[CurlyEpsilon]_] := h\[Sigma][{x},{y}][\[CurlyEpsilon]];
d\[Sigma][x_,y_][\[CurlyEpsilon]_] := \[CurlyEpsilon] // t\[Sigma][x,y] // h\[Sigma][x,y];


tb[x_][UU[L_],UU[R_]] := CF[UU[Expand[Distribute[pp[L,R]] /. {
pp[0,_] -> 0, pp[_,0] -> 0,
pp[_\[Beta]|_\[Delta]\[Beta]|_\[Delta]a|_\[Delta]aa, _\[Beta]|_\[Delta]\[Beta]|_\[Delta]a|_\[Delta]aa] -> 0,
pp[u_\[Beta]|u_\[Delta]\[Beta]|u_\[Delta]a|u_\[Delta]aa, v_a] :> -pp[v,u]
} /. {
pp[a[f_,x,j_], u_] :> (u /. {
\[Beta][g_] :> \[Delta]hb[f \!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(b\), \(x\)]]g\),x,\[CCedilla],j],
a[g_,k_,l_] :> \[Gamma]a[f \!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(b\), \(x\)]]g\),x,j,k,l] +Subscript[K\[Delta], x\[InvisibleComma]k](-\[Gamma]a[g \!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(b\), \(k\)]]f\),k,l,x,j] + \[Delta]tb[f g,x,j,l]),
_ -> 0
}),
pp[a[f_,j_,k_], a[g_,x,l_]] /; j=!=x :> -\[Gamma]a[g \!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(b\), \(x\)]]f\),x,l,j,k],
pp[_,_] -> 0
}]]];


hb[y_][UU[L_],UU[R_]] := CF[UU[Expand[Distribute[pp[L,R]] /. {
pp[0,_] -> 0, pp[_,0] -> 0,
pp[_\[Beta]|_\[Delta]\[Beta],_] -> 0,
pp[_, _\[Beta]|_\[Delta]\[Beta]] -> 0,
pp[_\[Delta]a|_\[Delta]aa, _\[Delta]a|_\[Delta]aa] -> 0,
pp[u_\[Delta]a|u_\[Delta]aa, v_a] :> -pp[v,u]
} /. {
pp[a[f_,i_,y], u_] :> (u /. {
a[g_,j_,k_] :> Subscript[K\[Delta], y\[InvisibleComma]k]hb[f g, i,j,k],
\[Delta]a[g_,j_,k_] :> Subscript[K\[Delta], y\[InvisibleComma]k]\[Delta]hb[f g, i,j,k],
\[Delta]aa[g_,j_,k_,l_,m_] :> Subscript[K\[Delta], y\[InvisibleComma]k](\[Delta]aa[Subscript[b, j]f g,i,y,l,m]-\[Delta]aa[Subscript[b, i]f g,j,k,l,m]) + Subscript[K\[Delta], y\[InvisibleComma]m](\[Delta]aa[Subscript[b, l]f g,j,k,i,y]-\[Delta]aa[Subscript[b, i]f g,j,k,l,m])
}),
_pp -> 0
}]]];


thb[x_,y_][UU[L_],UU[R_]] := CF[UU[Expand[Distribute[pp[L,R]] /. {
pp[0,_] -> 0, pp[_,0] -> 0,
pp[_\[Beta]|_\[Delta]\[Beta]|_\[Delta]a|_\[Delta]aa, _\[Beta]|_\[Delta]\[Beta]|_\[Delta]a|_\[Delta]aa] -> 0,
pp[_a,_\[Beta]|_\[Delta]\[Beta]] -> 0,
pp[\[Beta][f_], a[g_,i_,j_]] :> Subscript[K\[Delta], y\[InvisibleComma]j]\[Delta]hb[g \!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(b\), \(x\)]]f\), i,\[CCedilla],y],
pp[a[f_,i_,j_], a[g_,k_,l_]] :> Subscript[K\[Delta], y\[InvisibleComma]l](
\[Gamma]a[g \!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(b\), \(x\)]]f\),k,l,i,j]+Subscript[K\[Delta], x\[InvisibleComma]i](
\[Delta]hb[-Subscript[b, k]g \!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(b\), \(x\)]]f\),i,\[CCedilla],j]+\[Delta]a[Subscript[b, k]g \!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(b\), \(x\)]]f\),i,j]-\[Delta]a[Subscript[b, i]g \!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(b\), \(x\)]]f\),k,j]+hb[f g,k,i,j]+\[Delta]aa[f g,\[CCedilla],j,k,l]-\[Delta]aa[f g,\[CCedilla],l,k,j])),
pp[a[f_,i_,j_], \[Delta]a[g_,k_,l_]] :> Subscript[K\[Delta], x\[InvisibleComma]i] Subscript[K\[Delta], y\[InvisibleComma]l](-\[Delta]a[Subscript[b, k]f g,i,j]+\[Delta]a[Subscript[b, i]f g,k,j]),
pp[a[f_,i_,j_], \[Delta]aa[g_,k_,l_,m_,n_]] :> Subscript[K\[Delta], x\[InvisibleComma]i](
Subscript[K\[Delta], y\[InvisibleComma]l](-\[Delta]aa[Subscript[b, k]f g,i,j,m,n]+\[Delta]aa[Subscript[b, i]f g,k,j,m,n]) + Subscript[K\[Delta], y\[InvisibleComma]n](-\[Delta]aa[Subscript[b, m]f g,k,l,i,j]+\[Delta]aa[Subscript[b, i]f g,k,l,m,j])+Subscript[K\[Delta], y\[InvisibleComma]l\[InvisibleComma]n](\[Delta]a[Subscript[b, x] Subscript[b, m]f g,k,j]-\[Delta]a[Subscript[b, k] Subscript[b, m]f g,x,j])),
pp[_\[Delta]\[Beta],_a] -> 0,
pp[\[Delta]a[f_,i_,j_], a[g_,k_,l_]] :> Subscript[K\[Delta], x\[InvisibleComma]i] Subscript[K\[Delta], y\[InvisibleComma]l](-\[Delta]a[Subscript[b, k]f g,i,j]+\[Delta]a[Subscript[b, i]f g,k,j]),
pp[\[Delta]aa[f_,i_,j_,m_,n_], a[g_,k_,l_]] :> Subscript[K\[Delta], x\[InvisibleComma]i] Subscript[K\[Delta], y\[InvisibleComma]l](-\[Delta]aa[Subscript[b, k]f g,i,j,m,n]+\[Delta]aa[Subscript[b, i]f g,k,j,m,n]) + Subscript[K\[Delta], x\[InvisibleComma]m] Subscript[K\[Delta], y\[InvisibleComma]l](-\[Delta]aa[Subscript[b, k]f g,i,j,m,n]+\[Delta]aa[Subscript[b, m]f g,i,j,k,n])}]]];
htb[x_,y_][L_UU,R_UU] := -thb[y,x][R,L];


db[x_][u_UU,v_UU] := Module[{t,h}, Plus[
htb[x,x][u//t\[Sigma][x,t],v//h\[Sigma][x,h]]//tm[t,x,x]//hm[x,h,x],
tb[x][u,v//h\[Sigma][x,h]] // hm[x,h,x],
hb[x][u,v//t\[Sigma][x,t]] // tm[t,x,x],
thb[x,x][u//h\[Sigma][x,h],v//t\[Sigma][x,t]]//tm[t,x,x]//hm[x,h,x] ]];


bb[S_List] := Module[{w,bar,t,n=0,i,k},
w=#2//d\[Sigma][S,bar/@S];
Sum[t=db[S[[k]]][#1,w // d\[Sigma][bar[S[[k]]], S[[k]]]];
Do[t=t//dm[bar[S[[i]]], S[[i]], S[[i]]], {i,1,k-1}];
Do[t=t//dm[S[[i]], bar[S[[i]]], S[[i]]], {i,k+1,Length@S}];
t, {k,Length@S}] ]&
bb[S___] := bb[{S}]


ct::usage="ct[h,t][L,R] contracts the head h in L with the tail t in R. ct[s][L,R] takes h=t=s, and ct[][L,R] takes s=0. When ambiguous, L is placeed below R.";


ct[s_] := ct[s,s]; ct[] = ct[0,0];
ct[h_,t_][UU[L_],UU[R_]] := CF[UU[Distribute[pp[L,R]] /. {
pp[0,_] -> 0, pp[_,0] -> 0,pp[_\[Beta]|_\[Delta]\[Beta],_] -> 0,
pp[a[f_,i_,h], \[Beta][g_]] :> \[Beta][f Subscript[b, i]((\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(b\), \(t\)]]g\)) /. Subscript[b, t]->0)],
pp[a[f_,i_,h], a[g_,t,j_]] :> a[f(g/.Subscript[b, t]->0), i,j],
pp[a[f_,i_,h], a[g_,j_,k_]] :> a[f Subscript[b, i]((\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(b\), \(t\)]]g\)) /. Subscript[b, t]->0), j,k],
pp[a[f_,i_,h], \[Delta]a[g_,t,j_]] :> \[Delta]a[f(g/.Subscript[b, t]->0), i,j],
pp[a[f_,i_,h], \[Delta]a[g_,j_,k_]] :> \[Delta]a[f Subscript[b, i]((\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(b\), \(t\)]]g\)) /. Subscript[b, t]->0), j,k],
pp[a[f_,i_,h], \[Delta]aa[g_,t,j_,t,k_]]  -> 0,
pp[a[f_,i_,h], \[Delta]aa[g_,t,j_,k_,l_]] :> \[Delta]aa[f(g/.Subscript[b, t]->0), i,j,k,l],
pp[a[f_,i_,h], \[Delta]aa[g_,j_,k_,t,l_]] :> \[Delta]aa[f(g/.Subscript[b, t]->0), j,k,i,l],
pp[a[f_,i_,h], \[Delta]aa[g_,j_,k_,l_,m_]] :> \[Delta]aa[f Subscript[b, i]((\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(b\), \(t\)]]g\)) /. Subscript[b, t]->0), j,k,l,m],
pp[a[__], _] -> 0, pp[_\[Delta]a|_\[Delta]aa, _\[Delta]\[Beta]|_\[Delta]a|_\[Delta]aa] -> 0,
pp[\[Delta]a[f_,i_,h], \[Beta][g_]] :> \[Delta]\[Beta][f Subscript[b, i]((\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(b\), \(t\)]]g\)) /. Subscript[b, t]->0)],
pp[\[Delta]a[f_,i_,h], a[g_,t,j_]] :> \[Delta]a[f(g/.Subscript[b, t]->0),i,j],
pp[\[Delta]a[f_,i_,h], a[g_,j_,k_]] :> \[Delta]a[f Subscript[b, i]((\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(b\), \(t\)]]g\)) /. Subscript[b, t]->0), j,k],
pp[_\[Delta]a,_] -> 0, pp[\[Delta]aa[_,_,h,_,h], _] -> 0,
pp[\[Delta]aa[f_,i_,h,j_,k_], \[Beta][g_]] :> \[Delta]a[f Subscript[b, i]((\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(b\), \(t\)]]g\)) /. Subscript[b, t]->0),j,k],
pp[\[Delta]aa[f_,i_,h,j_,k_], a[g_,t,l_]] :> \[Delta]aa[f (g/.Subscript[b, t]->0),i,l,j,k],
pp[\[Delta]aa[f_,i_,h,j_,k_], a[g_,l_,m_]] :> \[Delta]aa[f Subscript[b, i]((\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(b\), \(t\)]]g\)) /. Subscript[b, t]->0), j,k,l,m],
pp[\[Delta]aa[f_,i_,j_,k_,h], \[Beta][g_]] :> \[Delta]a[f Subscript[b, k]((\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(b\), \(t\)]]g\)) /. Subscript[b, t]->0), i,j],
pp[\[Delta]aa[f_,i_,j_,k_,h], a[g_,t,l_]] :> \[Delta]aa[f (g/.Subscript[b, t]->0),i,j,k,l],
pp[\[Delta]aa[f_,i_,j_,k_,h], a[g_,l_,m_]] :> \[Delta]aa[f Subscript[b, k]((\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(b\), \(t\)]]g\)) /. Subscript[b, t]->0), i,j,l,m],
pp[_\[Delta]aa, _] -> 0 }]];


dect::usage="dect[h,t][uu] returns a pair {L,R} such that ct[h,t][L,R]=uu. Similarly for dect[s] and dect[]. uu is assumed to be atomic.";
dect[s_] := dect[s,s];
dect[] = dect[0,0];
dect[h_,t_][\[Beta][f_]] :=  {};
dect[h_,t_][\[Delta]\[Beta][f_]] :=  TBD;


SetDirectory["C:\\drorbn\\AcademicPensieve\\Projects\\OneCo-1604"];

ConditionalExport[fname_String, rest___] := Module[{temp, exists},
temp="ConditionalExportTemporary"<>"."<>FileExtension[fname];
exists=FileExistsQ[fname];
Export[temp, rest];
If[exists && FileByteCount[fname]===FileByteCount[temp],
DeleteFile[temp],
(* else *) Print["Exporting "<>fname<>"..."];
If[exists, DeleteFile[fname]];
RenameFile[temp, fname]
];
fname
]

ExportButton = Button["Export",
SetOptions[$FrontEndSession,PrintingStyleEnvironment->"Working"];
TagProperties[_] := {};
TagProperties["ct-def"] = {PageWidth ->6/0.65};
Options[CellExport] = {
PageWidth -> 4/0.65, CellFilter -> Identity, ExportDirectory -> "Snips", ExportBaseFilename -> Automatic, ExportFormat -> ".pdf", ExportOptions -> {}, Split -> False
};
CellExport[tag_String, opts___Rule] := CellExport[
NotebookGet[EvaluationNotebook[]],
tag, opts
];
CellExport[nb_Notebook, tag_String] := CellExport[nb, tag, TagProperties[tag]];
CellExport[nb_Notebook, tag_String, OptionsPattern[]] := Module[
{cells, cell, filename, format},
filename = FileNameJoin[{
OptionValue[ExportDirectory] /. Automatic -> Directory[],
OptionValue[ExportBaseFilename] /. Automatic -> tag
}];
format=OptionValue[ExportFormat];
cells=OptionValue[CellFilter][Cases[
nb, c_Cell /; FreeQ[List@@c, Cell] && !FreeQ[c, CellTags->tag],
Infinity
]];
If[!OptionValue[Split],
If[Length[cells]>=1,
If[Length[cells]==1,
cells=Append[First[cells], PageWidth ->1.2 72OptionValue[PageWidth]],
cells=Cell[CellGroup[cells], PageWidth -> 72OptionValue[PageWidth]]
];
ConditionalExport[
filename<>format,cells,
ImageResolution -> 300,
OptionValue[ExportOptions]
]
],
k=0;
Table[
++k;
ConditionalExport[
filename<>"-"<>ToString[k]<>format,
Append[cell, PageWidth -> 72OptionValue[PageWidth]],
ImageResolution -> 300,
OptionValue[ExportOptions]
],
{cell, cells}
]
]
];
nb=NotebookGet[EvaluationNotebook[]];
tags=Cases[nb, (CellTags->tag_) :> tag, Infinity ] // Union;
CellExport /@ tags;
Print["Done."]
]
