Pensieve header: The Objects, for the lazy evaluation version.

The Objects, for LazyEval

“Define” code

Define[lhs=rhs, ...] defines the lhs to be rhs, except that rhs is computed only once for each value of $k. Fancy Mathematica not for the faint of heart. Most readers should ignore.

SetAttributes[Define, HoldAll];
Define[def_,defs__] := (Define[def]; Define[defs];);
Define[(Subscript[op_, is__])=ℰ_] := Module[{SD,ii,jj,kk,isp,nis,nisp,sis},Block[{i,j,k},
ReleaseHold[Hold[
SD[(Subscript[op, nisp,$k_Integer]),(Subscript[PP, Boot])@Block[{i,j,k},(Subscript[op, isp,$k])=Zip@ℰ;(Subscript[op, nis,$k])]];
SD[(Subscript[op, isp]),(Subscript[op, {is},$k])]; SD[(Subscript[op, sis__]),(Subscript[op, {sis}])];
]/. {SD->SetDelayed,
isp->{is}/.{i->i_,j->j_,k->k_},
nis->{is}/.{i->ii,j->jj,k->kk},
nisp->{is}/.{i->ii_,j->jj_,k->kk_}
}]  ]]

Booting Up QU

Define[(Subscript[am, i,j->k])=(Subscript[(Subscript[𝔼, {i,j}->{k}])[((Subscript[α, i])+(Subscript[α, j]))(Subscript[a, k]),((Subscript[𝒜, j]^(-1))(Subscript[ξ, i])+(Subscript[ξ, j]))(Subscript[x, k]),1], $k]),
(Subscript[bm, i,j->k])=(Subscript[(Subscript[𝔼, {i,j}->{k}])[((Subscript[β, i])+(Subscript[β, j]))(Subscript[b, k]),((Subscript[η, i])+(Subscript[η, j]))(Subscript[y, k]),(E^(((E^(- ϵ (Subscript[β, i])))-1)(Subscript[η, j])(Subscript[y, k])))], $k])]

Define[(Subscript[R, i,j])=(Subscript[(Subscript[𝔼, {}->{i,j}])[ℏ (Subscript[a, j]) (Subscript[b, i]),ℏ (Subscript[x, j]) (Subscript[y, i]),E^((∑_(k=2)^($k+1)) (((((1-(E^(γ ϵ ℏ))))^k)(((ℏ (Subscript[y, i])(Subscript[x, j])))^k))/(k(1-(E^(k γ ϵ ℏ))))))], $k]),
(Subscript[(OverBar[R]), i,j])=(Subscript[𝔼, {}->{i,j}])[-ℏ (Subscript[a, j]) (Subscript[b, i]),-ℏ (Subscript[x, j]) (Subscript[y, i])/(Subscript[B, i]),1+If[$k==0, 0,(Subscript[((Subscript[(OverBar[R]), {i,j},$k-1])), $k])[-1]-
Zip[((Subscript[((Subscript[(OverBar[R]), {i,j},0])), $k])(Subscript[R, 1,2])(Subscript[((Subscript[(OverBar[R]), {3,4},$k-1])), $k]))//((Subscript[bm, i,1->i])(Subscript[am, j,2->j]))//((Subscript[bm, i,3->i])(Subscript[am, j,4->j]))][-1]]],
(Subscript[P, i,j])=(Subscript[𝔼, {i,j}->{}])[(Subscript[β, i])(Subscript[α, j])/ℏ,(Subscript[η, i])(Subscript[ξ, j])/ℏ,1+If[$k==0,0,(Subscript[((Subscript[P, {i,j},$k-1])), $k])[-1]-
Zip[(Subscript[R, 1,2])//((Subscript[((Subscript[P, {1,j},0])), $k])(Subscript[((Subscript[P, {i,2},$k-1])), $k]))][-1]]]]

Define[(Subscript[aS, j])=(Subscript[(OverBar[R]), i,j])~(Subscript[B, i])~(Subscript[P, i,j]),
(Subscript[(OverBar[aS]), i])=(Subscript[𝔼, {i}->{i}])[-(Subscript[a, i]) (Subscript[α, i]),-(Subscript[x, i]) (Subscript[𝒜, i]) (Subscript[ξ, i]),1+If[$k==0, 0,(Subscript[((Subscript[(OverBar[aS]), {i},$k-1])), $k])[-1]-
Zip[(Subscript[((Subscript[(OverBar[aS]), {i},0])), $k])~(Subscript[B, i])~(Subscript[aS, i])~(Subscript[B, i])~(Subscript[((Subscript[(OverBar[aS]), {i},$k-1])), $k])][-1]]]]

Define[(Subscript[bS, i])=(Subscript[R, i,1])~(Subscript[B, 1])~(Subscript[aS, 1])~(Subscript[B, 1])~(Subscript[P, i,1]),
(Subscript[(OverBar[bS]), i])=(Subscript[R, i,1])~(Subscript[B, 1])~(Subscript[(OverBar[aS]), 1])~(Subscript[B, 1])~(Subscript[P, i,1]),
(Subscript[aΔ, i->j,k])=((Subscript[R, 1,j])(Subscript[R, 2,k]))//(Subscript[bm, 1,2->3])//(Subscript[P, 3,i]),
(Subscript[bΔ, i->j,k])=((Subscript[R, j,1])(Subscript[R, k,2]))//(Subscript[am, 1,2->3])//(Subscript[P, i,3])]

Define[(Subscript[dm, i,j->k])=((Subscript[𝔼, {i,j}->{i,j}])[(Subscript[β, i])(Subscript[b, i]) + (Subscript[α, j])(Subscript[a, j]),(Subscript[η, i])(Subscript[y, i])+(Subscript[ξ, j])(Subscript[x, j]),1]((Subscript[aΔ, i->1,2])//(Subscript[aΔ, 2->2,3])//(Subscript[(OverBar[aS]), 3]))((Subscript[bΔ, j->-1,-2])//(Subscript[bΔ, -2->-2,-3])))//((Subscript[P, -1,3])(Subscript[P, -3,1])(Subscript[am, 2,j->k])(Subscript[bm, i,-2->k])),
(Subscript[dS, i])=(Subscript[𝔼, {i}->{1,2}])[(Subscript[β, i])(Subscript[b, 1])+(Subscript[α, i])(Subscript[a, 2]),(Subscript[η, i])(Subscript[y, 1])+(Subscript[ξ, i])(Subscript[x, 2]),1]//((Subscript[(OverBar[bS]), 1])(Subscript[aS, 2]))//(Subscript[dm, 2,1->i]),
(Subscript[dΔ, i->j,k])=((Subscript[bΔ, i->3,1])(Subscript[aΔ, i->2,4]))//((Subscript[dm, 3,4->k])(Subscript[dm, 1,2->j]))]

Define[(Subscript[C, i])=(Subscript[(Subscript[𝔼, {}->{i}])[0,0,(Subscript[B, i]^(1/2))(E^(-ℏ ϵ (Subscript[a, i])/2))], $k]),
(Subscript[(OverBar[C]), i])=(Subscript[(Subscript[𝔼, {}->{i}])[0,0,(Subscript[B, i]^(-1/2))(E^(ℏ ϵ (Subscript[a, i])/2))], $k]),
(Subscript[Kink, i]) = ((Subscript[R, 1,3])(Subscript[(OverBar[C]), 2]))//(Subscript[dm, 1,2->1])//(Subscript[dm, 1,3->i]),
(Subscript[(OverBar[Kink]), i]) = ((Subscript[(OverBar[R]), 1,3])(Subscript[C, 2]))//(Subscript[dm, 1,2->1])//(Subscript[dm, 1,3->i])]

Note. t==ϵa-γb and b==-t/γ+ϵa/γ.

Define[(Subscript[b2t, i])=(Subscript[(Subscript[𝔼, {i}->{i}])[(Subscript[α, i])(Subscript[a, i])-(Subscript[β, i])(Subscript[t, i])/γ,(Subscript[ξ, i])(Subscript[x, i])+(Subscript[η, i])(Subscript[y, i]),(E^(ϵ (Subscript[β, i])(Subscript[a, i])/γ))], $k]),
(Subscript[t2b, i])=(Subscript[(Subscript[𝔼, {i}->{i}])[(Subscript[α, i])(Subscript[a, i])-(Subscript[τ, i])γ (Subscript[b, i]),(Subscript[ξ, i])(Subscript[x, i])+(Subscript[η, i])(Subscript[y, i]),(E^(ϵ (Subscript[τ, i])(Subscript[a, i])))], $k])]

The CU Definitions

Define[(Subscript[cm, i,j->k])=(Subscript[(Subscript[𝔼, {i,j}->{k}])[
(Subscript[a, k]) ((Subscript[α, i])+(Subscript[α, j]))+(Subscript[b, k]) ((Subscript[β, i])+(Subscript[β, j])),
(Subscript[y, k]) ((Subscript[η, i])+((Subscript[η, j])/(Subscript[𝒜, i])))+γ (Subscript[b, k]) (Subscript[η, j]) (Subscript[ξ, i])+(Subscript[x, k]) (((Subscript[ξ, i])/(Subscript[𝒜, j]))+(Subscript[ξ, j])),
(E^((Subscript[y, k]) (Subscript[η, j]) (((E^(-ϵ (Subscript[β, i])))/((Subscript[𝒜, i])+γ ϵ (Subscript[𝒜, i]) (Subscript[η, j]) (Subscript[ξ, i])))-(1/(Subscript[𝒜, i])))+(Subscript[ξ, i]) ((Subscript[x, k]) (((E^(-ϵ (Subscript[β, j])))/((Subscript[𝒜, j])+γ ϵ (Subscript[𝒜, j]) (Subscript[η, j]) (Subscript[ξ, i])))-(1/(Subscript[𝒜, j])))-γ (Subscript[b, k]) (Subscript[η, j])))) (((1+γ ϵ (Subscript[η, j]) (Subscript[ξ, i])))^(((Subscript[a, k])/γ)+((Subscript[b, k])/ϵ)))
], $k])]

Define[(Subscript[cΔ, i->j,k])=(Subscript[(Subscript[𝔼, {i}->{j,k}])[((Subscript[a, j])+(Subscript[a, k])) (Subscript[α, i])+((Subscript[b, j])+(Subscript[b, k])) (Subscript[β, i]),((Subscript[y, j])+(Subscript[y, k])) (Subscript[η, i])+((Subscript[x, j])+(Subscript[x, k])) (Subscript[ξ, i]),1], $k])]

Define[(Subscript[cS, i])=(Subscript[𝔼, {i}->{1,2,3,4}])[-(Subscript[β, i])(Subscript[b, 2])-(Subscript[α, i])(Subscript[a, 3]),-(Subscript[η, i])(Subscript[y, 1])-(Subscript[ξ, i])(Subscript[x, 4]),1]//(Subscript[cm, 4,3->i])//(Subscript[cm, i,2->i])//(Subscript[cm, i,1->i])]

The Knot Tensors

Define[(Subscript[kR, i,j])=(Subscript[R, i,j])//((Subscript[b2t, i])(Subscript[b2t, j])) /. (Subscript[t, i|j])->t,
(Subscript[(OverBar[kR]), i,j])=(Subscript[(OverBar[R]), i,j])//((Subscript[b2t, i])(Subscript[b2t, j])) /. {(Subscript[t, i|j])->t,(Subscript[T, i|j])->T},
(Subscript[km, i,j->k])=((Subscript[t2b, i])(Subscript[t2b, j]))//(Subscript[dm, i,j->k])//(Subscript[b2t, k]) /. {(Subscript[t, k])->t, (Subscript[T, k])->T,(Subscript[τ, i|j])->0},
(Subscript[kC, i])=(Subscript[C, i])//(Subscript[b2t, i]) /. (Subscript[T, i])->T,
(Subscript[(OverBar[kC]), i])=(Subscript[(OverBar[C]), i])//(Subscript[b2t, i]) /. (Subscript[T, i])->T,
(Subscript[kKink, i])=(Subscript[Kink, i])//(Subscript[b2t, i]) /. {(Subscript[t, i])->t, (Subscript[T, i])->T},
(Subscript[(OverBar[kKink]), i])=(Subscript[(OverBar[Kink]), i])//(Subscript[b2t, i]) /. {(Subscript[t, i])->t, (Subscript[T, i])->T}]