Pensieve header: OneCo, the local picture. Branched from pensieve://Projects/OneCo-1604/.

Print["In the U(T)⊗U(H) conventions and with renormalized arrows at 1co level. Internal use symbols: ", {rr,pp}]

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

Temporary

ToOld=ToNew=Identity;

Generalities

Simp[ε_] := Simplify[ε];
CF[ε_]:=ε/.{λ_β|λ_a|λ_δβ|λ_c|λ_ao|λ_ca:>MapAt[Simp,λ,1],
aao[f_,i_,j_,k_,l_]:>aao[Simp@f,Sort[{i,k}][[1]],Sort[{j,l}][[1]],Sort[{i,k}][[2]],Sort[{j,l}][[2]]]};
AutoCollecting[λ_] := (λ /: λ[0,___] = 0;
λ /: λ[f_, r___] + λ[g_, r___] := λ[Simp[f+g], r];
λ /: g_*λ[f_, r___] := λ[Simp[g f], r]);
AutoCollecting /@ {β, a, δβ, 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/._β|λ_a|λ_δβ|λ_c|λ_ao|λ_ca|λ_aao :> MapAt[D[#,vs]&, λ, 1]];
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])] *);
UU /: Coefficient[u_UU, λ_[js___]] := Total[Cases[u, λ[f_,js]:>f, ∞]];
Kδ /: (Subscript[Kδ, is__]):=KroneckerDelta[1,Length[Union[{is}]]];

Bases

UUBasis[T_List, H_List, f_] := Module[
{ff,n=0,h,t,h1,h2,i,j,k,l},
ff:=(Subscript[f, ++n])@@Table[(Subscript[b, t]), {t,T}];
CF /@ UU /@ Flatten@{
β[ff],
Table[a[ff, t,h], {t,T}, {h,H}],
δβ[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
];
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];
h∞Basis[S_List,f_] := Module[{n=0},
Select[UUBasis[S,S⋃{h∞},f], Count[#,h∞,{2}]==1&] /. (Subscript[f, _])[bs___]:> (Subscript[f, ++n])[bs]
];

NonCommutativeMultiply

UU/:UU[L_]**UU[R_]:=CF@UU[Expand[Distribute[pp[L,R]] /. {
pp[0,_] -> 0, pp[_,0] -> 0,
pp[β[f_], λ_β|λ_a|λ_δβ|λ_c|λ_ao|λ_ca|λ_aao] :> MapAt[f#&, λ, 1],
pp[_δβ|_c|_ao|_ca|_aao,_δβ|_c|_ao|ca|_aao] -> 0,
pp[ao[f_,i_,j_],a[g_,k_,l_]] :> (* Not done! *)aao[f g,i,j,k,l]-(Subscript[Kδ, j,k])δhb[f g,i,j,l],
pp[δβ[f_],β[g_]] :> δβ[f g],
pp[δβ[f_],a[g_,i_,j_]] :> ao[f g,i,j]
}]];

Ufinished, untested!

tσ, hσ, dσ on {β, a, δβ, c, ao, ca, aao}

tσ[x_List,y_List][ε_] := (rr=Replace[Thread[x->y]];
CF[ε /. (Subscript[b, i_]):>(Subscript[b, rr@i]) /. {
a[f_,i_,j_] :> a[f,rr@i,j],
ao[f_,i_,j_] :> ao[f,rr@i,j],
ca[f_,i_,j_,k_] :> ca[f,i,rr@j,k],
aao[f_,i_,j_,k_,l_]:>aao[f,rr@i,j,rr@k,l]
}]);
tσ[x_,y_][ε_] := tσ[{x},{y}][ε];
hσ[x_List,y_List][ε_] := (rr=Replace[Thread[x->y]];
CF[ε /. {
a[f_,i_,j_] :> a[f,i,rr@j],
c[f_,i_] :> c[f,rr@i],
ao[f_,i_,j_] :> ao[f,i,rr@j],
ca[f_,i_,j_,k_] :> ca[f,rr@i,j,rr@k],
aao[f_,i_,j_,k_,l_]:>aao[f,i,rr@j,k,rr@l]
}]);
hσ[x_,y_][ε_] := hσ[{x},{y}][ε];
dσ[x_,y_][ε_] := ε // tσ[x,y] // hσ[x,y];

tm, hm, hts, dm

UU[ε_] // tm[x_,y_,z_] := (rr=Replace[x|y->z];
CF[UU[Expand[ε /. {
a[f_,x,j_] :> a[f,z,j]+ao[(∂_(Subscript[b, y]))f,z,j],
a[f_,y,j_] :> a[f,z,j],
ao[f_,x|y,j_] :> ao[f,z,j],
ca[f_,i_,x|y,k_]:>ca[f,i,z,k],
aao[f_,i_,j_,k_,l_] :> aao[f,rr@i, j, rr@k, l]
} /. (Subscript[b, x|y])->(Subscript[b, z])]]]);

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

UU[ε_] // hts[y_,x_] := CF[UU[Expand[ε /. {
a[f_,i_,j_] :> a[f,i,j] - (Subscript[Kδ, j,y])ao[(∂_(Subscript[b, x]))f,i,y] + (Subscript[Kδ, i,x])(Subscript[Kδ, j,y])(β[-(Subscript[b, x])f]+δβ[(Subscript[b, x]) (∂_(Subscript[b, x]))f]+c[f,y]),
ao[f_,x,y] :> ao[f,x,y] -δβ[f (Subscript[b, x])],
ca[f_,i_,j_,k_] :> ca[f,i,j,k]+(Subscript[Kδ, i,y])(Subscript[Kδ, j,x])ao[f,x,k] + (Subscript[Kδ, j,x])(Subscript[Kδ, k,y])c[-f (Subscript[b, x]),i],
aao[f_,i_,j_,k_,l_] :> aao[f,i,j,k,l]+(Subscript[Kδ, i,x])(Subscript[Kδ, j,y])ao[-(Subscript[b, x])f,k,l] + (Subscript[Kδ, i,x])(Subscript[Kδ, l,y])ao[-(Subscript[b, x])f,k,j] + (Subscript[Kδ, k,x])(Subscript[Kδ, j,y])ao[-(Subscript[b, x])f,i,l] + (Subscript[Kδ, k,x])(Subscript[Kδ, l,y])ao[-(Subscript[b, x])f,i,j]+2(Subscript[Kδ, x,i,k])(Subscript[Kδ, y,j,l])δβ[(Subscript[b, x])(Subscript[b, x])f]
}]]];

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

tb, hb, thb, htb, db, bb on {β, a, δβ, ao, aao}

tb[x_][UU[L_],UU[R_]] := CF[UU[Expand[Distribute[pp[L,R]] /. {
pp[0,_] -> 0, pp[_,0] -> 0,
pp[_β|_δβ|_c|_ao|_ca|_aao, _β|_δβ|_c|_ao|_ca|_aao] -> 0,
pp[u_β|u_δβ|u_c|u_ao|u_ca|u_aao, v_a] :> -pp[v,u]
} /. {
pp[a[f_,x,j_], u_] :> (u /. {
β[g_] :> ao[f(∂_(Subscript[b, x]))g,x,j],
a[g_,k_,l_] :> aao[f(∂_(Subscript[b, x]))g,x,j,k,l] +ca[(Subscript[b, k])f(∂_(Subscript[b, x]))g,l,x,j]+(Subscript[Kδ, x,k])(ca[-f g-(Subscript[b, x])g(∂_(Subscript[b, x]))f,j,x,l]+ca[f g,l,x,j]+aao[-g (∂_(Subscript[b, x]))f,x,j,x,l]),
_ -> 0
}),
pp[a[f_,j_,k_], a[g_,x,l_]] (*/; j=!=x*) :> -aao[g(∂_(Subscript[b, x]))f,x,l,j,k]-ca[(Subscript[b, j])g(∂_(Subscript[b, x]))f,k,x,l],
pp[_,_] -> 0
}]]];

hb[y_][UU[L_],UU[R_]] := CF[UU[Expand[Distribute[pp[L,R]] /. {
pp[0,_] -> 0, pp[_,0] -> 0,
pp[_β|_δβ,_] -> 0,
pp[_, _β|_δβ] -> 0,
pp[_c|_ao|_ca|_aao, _c|_ao|_ca|_aao] -> 0,
pp[u_c|u_ao|u_ca|u_aao, v_a] :> -pp[v,u]
} /. {
pp[a[f_,i_,y], u_] :> (u /. {
a[g_,j_,k_] :> (Subscript[Kδ, y,k])hb[f g, i,j,k],
c[g_, j_] :>(Subscript[Kδ, y,j])ao[f g,i,y],
ao[g_,j_,k_] :> (Subscript[Kδ, y,k])ao[-f g (Subscript[b, i]),j,y],
ca[g_,j_,k_,l_]:>(Subscript[Kδ, y,j])(ca[f g (Subscript[b, k]),l,i,y]+aao[f g,i,l,k,y])+(Subscript[Kδ, y,l])(ca[-f g (Subscript[b, i]),j,k,y]+ca[f g (Subscript[b, k]),j,i,y])+(Subscript[Kδ, y,j,l])ao[f g (Subscript[b, k]),i,y],
aao[g_,j_,k_,l_,m_] :> (Subscript[Kδ, y,k])(ca[-f g (Subscript[b, j]) (Subscript[b, l]),m,i,y]+aao[-f g (Subscript[b, i]),j,m,l,y]) + (Subscript[Kδ, y,m])(ca[-f g (Subscript[b, j]) (Subscript[b, l]),k,i,y]+aao[-f g (Subscript[b, i]),j,k,l,y])+(Subscript[Kδ, y,k,m])ao[-f g (Subscript[b, j]) (Subscript[b, l]),i,y]
}),
_pp -> 0
}]]];

thb[x_,y_][UU[L_],UU[R_]] := CF[UU[Expand[Distribute[pp[L,R]] /. {
pp[0,_] -> 0, pp[_,0] -> 0,
pp[_β|_δβ|_c|_ao|_ca|_aao, _β|_δβ|_c|_ao|_ca|_aao] -> 0,
pp[_a,_β|_δβ] -> 0,
pp[β[f_], a[g_,i_,j_]] :> (Subscript[Kδ, y,j])ao[g (∂_(Subscript[b, x]))f,i,y],
pp[a[f_,i_,j_], a[g_,k_,l_]] :> (Subscript[Kδ, y,l])(
aao[g(∂_(Subscript[b, x]))f,k,l,i,j]+ca[g (Subscript[b, i])(∂_(Subscript[b, x]))f,j,k,y]+(Subscript[Kδ, x,i])(a[-g f (Subscript[b, k]),x,j]+a[g f (Subscript[b, x]),k,j]+aao[-g (∂_(Subscript[b, x]))f,x,j,k,y]+aao[g (∂_(Subscript[b, x]))f,k,j,x,y]+ao[-g (Subscript[b, x]) (∂_(Subscript[b, x]))f,k,j]+ca[-g f,y,k,j]+ca[g f,j,k,y])),
pp[a[f_,i_,j_], c[g_,k_]] :>(Subscript[Kδ, i,x])(Subscript[Kδ, k,y])ao[-f g,x,j],
pp[a[f_,i_,j_], ao[g_,k_,l_]] :> (Subscript[Kδ, x,i])(Subscript[Kδ, y,l])ao[f g (Subscript[b, x]),k,j],
pp[a[f_,i_,j_], ca[g_,k_,l_,m_]] :> (Subscript[Kδ, x,i])(
(Subscript[Kδ, y,k])(aao[-f g,l,j,x,m]+ca[-f g (Subscript[b, l]),m,x,j])+(Subscript[Kδ, y,m])(ca[-f g (Subscript[b, l]),k,x,j]+ca[f g (Subscript[b, x]),k,l,j])-(Subscript[Kδ, y,k,m])ao[f g (Subscript[b, l]),x,j]),
pp[a[f_,i_,j_], aao[g_,k_,l_,m_,n_]] :> (Subscript[Kδ, x,i])(
(Subscript[Kδ, y,l])(aao[f g (Subscript[b, x]),k,j,m,n]+ca[f g (Subscript[b, k]) (Subscript[b, m]),n,x,j]) + (Subscript[Kδ, y,n])(aao[f g (Subscript[b, x]),k,j,m,l]+ca[f g (Subscript[b, k]) (Subscript[b, m]),l,x,j])+(Subscript[Kδ, y,l,n])ao[f g (Subscript[b, k]) (Subscript[b, m]),x,j]),
pp[_δβ|_c,_a] -> 0,
pp[ao[f_,i_,j_], a[g_,k_,l_]] :> (Subscript[Kδ, x,i])(Subscript[Kδ, y,l])(-ao[(Subscript[b, k])f g,i,j]+ao[(Subscript[b, i])f g,k,j]),
pp[ca[f_,m_,i_,j_], a[g_,k_,l_]] :> (Subscript[Kδ, x,i])(Subscript[Kδ, y,l])(ca[-f g (Subscript[b, k]),m,x,j]+ca[f g (Subscript[b, x]),m,k,j]),
pp[aao[f_,x,j_,x,n_], a[g_,k_,y]] :>aao[-2 f g (Subscript[b, k]),x,j,x,n]+aao[2 f g (Subscript[b, x]),k,j,x,n],
pp[aao[f_,i_,j_,m_,n_], a[g_,k_,l_]] :> (Subscript[Kδ, x,i])(Subscript[Kδ, y,l])(aao[-f g (Subscript[b, k]),m,j,x,n]+aao[f g (Subscript[b, x]),k,j,m,n]) + (Subscript[Kδ, x,m])(Subscript[Kδ, y,l])(aao[-f g (Subscript[b, k]),i,j,x,n]+aao[f g (Subscript[b, x]),i,j,k,n])}]]];
htb[x_,y_][L_UU,R_UU] := -thb[y,x][R,L];

(Subscript[t, 1])(Subscript[h, 1])(Subscript[t, 2])(Subscript[h, 2]) -> (Subscript[t, 1])(Subscript[t, 2])(Subscript[h, 1])(Subscript[h, 2]) -> (Subscript[t, 2])(Subscript[t, 1])(Subscript[h, 1])(Subscript[h, 2]) -> (Subscript[t, 2])(Subscript[t, 1])(Subscript[h, 2])(Subscript[h, 1]) -> (Subscript[t, 2])(Subscript[h, 2])(Subscript[t, 1])(Subscript[h, 1]):

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

bb[S_List] := Module[{w,bar,t,n=0,i,k},
w=#2//dσ[S,bar/@S];
Sum[t=db[S[[k]]][#1,w // dσ[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 (contract)

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,
pp[a[f_,i_,h], β[g_]] :> β[f (Subscript[b, i])(((∂_(Subscript[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])(((∂_(Subscript[b, t]))g) /. (Subscript[b, t])->0), j,k],
pp[a[f_,i_,h], c[g_,j_]] :> c[f (Subscript[b, i])(((∂_(Subscript[b, t]))g) /. (Subscript[b, t])->0), j],
pp[a[f_,i_,h], ao[g_,t,j_]] :> ao[f(g/.(Subscript[b, t])->0), i,j],
pp[a[f_,i_,h], ao[g_,j_,k_]] :> ao[f (Subscript[b, i])(((∂_(Subscript[b, t]))g) /. (Subscript[b, t])->0), j,k],
pp[a[f_,i_,h], ca[g_,k_,t,j_]] :> ca[f(g/.(Subscript[b, t])->0), k,i,j],
pp[a[f_,i_,h], ca[g_,l_,j_,k_]] :> ca[f(Subscript[b, i])(((∂_(Subscript[b, t]))g) /. (Subscript[b, t])->0), l,j,k],
pp[a[f_,i_,h], aao[g_,t,j_,t,k_]]  -> 0,
pp[a[f_,i_,h], aao[g_,t,j_,k_,l_]] :> aao[f(g/.(Subscript[b, t])->0), i,j,k,l],
pp[a[f_,i_,h], aao[g_,j_,k_,t,l_]] :> aao[f(g/.(Subscript[b, t])->0), j,k,i,l],
pp[a[f_,i_,h], aao[g_,j_,k_,l_,m_]] :> aao[f (Subscript[b, i])(((∂_(Subscript[b, t]))g) /. (Subscript[b, t])->0), j,k,l,m],
pp[a[__], _] -> 0,
pp[c[f_,h], β[g_]] :> δβ[f (((∂_(Subscript[b, t]))g) /. (Subscript[b, t])->0)],
pp[_c,_β]->0,
pp[c[f_,h], a[g_,t,j_]] :> c[f(g/.(Subscript[b, t])->0), j],
pp[c[f_,h], a[g_,j_,k_]] :> ao[f(((∂_(Subscript[b, t]))g) /. (Subscript[b, t])->0), j,k]+c[f (Subscript[b, j]) (((∂_(Subscript[b, t]))g) /. (Subscript[b, t])->0),k],
pp[_c,_a]->0,
pp[_c|_ao|_ca|_aao, _c|_ao|_ca|_aao] -> 0,
pp[ao[f_,i_,h], β[g_]] :> 0,
pp[ao[f_,i_,h], a[g_,t,j_]] :> ao[f(g/.(Subscript[b, t])->0),i,j],
pp[ao[f_,i_,h], a[g_,j_,k_]] :> 0,
pp[_ao,_] -> 0,
pp[ca[_,h,_,h], _] -> 0,
pp[ca[f_,h,i_,j_], β[g_]] :> ao[f(((∂_(Subscript[b, t]))g) /. (Subscript[b, t])->0), i,j]+c[f (Subscript[b, i]) (((∂_(Subscript[b, t]))g) /. (Subscript[b, t])->0),j],
pp[ca[f_,i_,j_,h], β[g_]] :> c[f (Subscript[b, j])(((∂_(Subscript[b, t]))g) /. (Subscript[b, t])->0), i],
pp[ca[f_,h,i_,j_], a[g_,t,k_]] :> ca[f (g/.(Subscript[b, t])->0), k,i,j],
pp[ca[f_,h,i_,j_], a[g_,k_,l_]] :> aao[f (((∂_(Subscript[b, t]))g) /. (Subscript[b, t])->0),i,j,k,l]+ca[f (Subscript[b, i])(((∂_(Subscript[b, t]))g) /. (Subscript[b, t])->0),j,k,l]+ca[f (Subscript[b, k])(((∂_(Subscript[b, t]))g) /. (Subscript[b, t])->0),l,i,j],
pp[ca[f_,i_,j_,h], a[g_,t,k_]] :> ca[f (g/.(Subscript[b, t])->0),i,j,k],
pp[ca[f_,i_,j_,h], a[g_,k_,l_]] :> ca[f (Subscript[b, j])(((∂_(Subscript[b, t]))g) /. (Subscript[b, t])->0), i,k,l],
pp[_ca,_] -> 0,
pp[aao[_,_,h,_,h], _] -> 0,
pp[aao[f_,i_,h,j_,k_], β[g_]] :> c[-f (Subscript[b, i]) (Subscript[b, j]) (((∂_(Subscript[b, t]))g) /. (Subscript[b, t])->0),k],
pp[aao[f_,i_,h,j_,k_], a[g_,t,l_]] :> aao[f (g/.(Subscript[b, t])->0),i,l,j,k],
pp[aao[f_,i_,h,j_,k_], a[g_,l_,m_]] :> ca[-f (Subscript[b, i]) (Subscript[b, j]) (((∂_(Subscript[b, t]))g) /. (Subscript[b, t])->0),k,l,m],
pp[aao[f_,i_,j_,k_,h], β[g_]] :> c[-f (Subscript[b, i]) (Subscript[b, k]) (((∂_(Subscript[b, t]))g) /. (Subscript[b, t])->0),j],
pp[aao[f_,i_,j_,k_,h], a[g_,t,l_]] :> aao[f (g/.(Subscript[b, t])->0),i,j,k,l],
pp[aao[f_,i_,j_,k_,h], a[g_,l_,m_]] :>  ca[-f (Subscript[b, i]) (Subscript[b, k]) (((∂_(Subscript[b, t]))g) /. (Subscript[b, t])->0),j,l,m],
pp[_aao, _] -> 0 }]];

Exporting the above as PDF files

The below is adapted from pensieve://2016-04/GaussGassner/GaussGassnerDemo.nb.

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

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
]

Button["Export",
SetOptions[$FrontEndSession,PrintingStyleEnvironment->"Working"];
TagProperties[_] := {};
TagProperties["ct-def"] = {PageWidth ->8/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."]
]