Paths[0]={{0}};

extendPath[{a___,0}]:={{a,0,1}}
extendPath[{a___,b_/;b>0}]:={{a,b,b-1},{a,b,b+1}}

Paths[n_/;n≥1]:=Paths[n]=Flatten[extendPath/@Paths[n-1],1]

Paths[5]

PathsWithin[n_,m_]:=Cases[Paths[n],p_/;Max[p]≤m]

PathsEndingAt[n_,k_]:=Cases[Paths[n],{___,k}]

PathsWithinEndingAt[n_,m_,k_]:=Cases[PathsWithin[n,m],{___,k}]

PathsEndingAt[5,5]

TLBasis[n_,m_:∞]:=Flatten[Table[Outer[(TLMono@@#1)**(TLEpi@@#2)&,PathsWithinEndingAt[n,m,k],PathsWithinEndingAt[n,m,k],1],{k,0,n}],2]

TLBasis[3]

TLBasis[3,2]

(TLMono[a___]**TLEpi[b___])⊗(TLMono[c_]**TLEpi[d_]):=(TLMono[a]⊗TLMono[b])**(TLEpi[b]⊗TLEpi[d])

TLMono[a___,A_]⊗TLMono[b___]:=TLMono[a,Sequence@@(A+{b})]
TLEpi[a___,A_]⊗TLEpi[b___]:=TLEpi[a,Sequence@@(A+{b})]

TLMono[0,1,2]⊗TLMono[0,1,2]

ExtractCap[cap_TLCap]:=cap
ExtractCap[caps:NonCommutativeMultiply[__TLCap]]:=caps
ExtractCap[caps__TLCap**e_TLEpi]:=caps**ExtractCap[e]
ExtractCap[caps__TLCap**e_TLIdentity]:=caps**e
ExtractCap[e:TLEpi[a___,b_,c_,d___]/;(c+1==b)]:=TLCap[Length[e]-1,Length[{a}]+1]**TLEpi[a,d]
ExtractCap[e:TLEpi[__,a_]]/;a+1==Length[e]:=TLIdentity[a]

Clear[ExtractCup,ExtractCap]

ExtractCup[cup_TLCup]:=cup
ExtractCup[cups:NonCommutativeMultiply[__TLCup]]:=cups
ExtractCup[e_TLMono**cups__TLCup]:=ExtractCup[e]**cups
ExtractCup[e_TLIdentity**cups__TLCup]:=e**cups
ExtractCup[e:TLMono[a___,b_,c_,d___]/;(c+1==b)]:=TLMono[a,d]**TLCup[Length[e]-1,Length[{a}]+1]
ExtractCup[e:TLMono[__,a_]]/;a+1==Length[e]:=TLIdentity[a]

ExtractCaps[X_]:=FixedPoint[ExtractCap,X]
ExtractCups[X_]:=FixedPoint[ExtractCup,X]

TLIdentity/:TLCap[n_,a_]**TLIdentity[m_]/;m+2==n:=TLCap[n,a]
TLIdentity/:TLIdentity[m_]**TLCup[n_,a_]/;m+2==n:=TLCup[n,a]

ExtractCaps[TLEpi[0,1,0,1,0,1,2,3]]

TLEpi/:e_TLEpi**m_TLMono:=PermuteCapsAndCups[ExtractCaps[e]**ExtractCups[m]]

ExtractCaps[TLEpi[0,1,0,1]]

ExtractCups[TLMono[0,1,0,1]]

TLEpi[0,1,0,1]**TLMono[0,1,0,1]

Clear[PermuteCapsAndCupsOnce]

PermuteCapsAndCups[X_]:=FixedPoint[PermuteCapsAndCupsOnce,X,3]

source[X__**Y_]:=source[Y]
target[X_**Y__]:=target[X]
source[TLCap[n_,_]]:=n
target[TLCap[n_,_]]:=n-2
source[TLCup[n_,_]]:=n-2
target[TLCup[n_,_]]:=n
source[TLIdentity[n_]]:=n
target[TLIdentity[n_]]:=n

PermuteCapsAndCupsOnce[z_  X_NonCommutativeMultiply]:=z PermuteCapsAndCupsOnce[X]

PermuteCapsAndCupsOnce[x:(NonCommutativeMultiply[TLIdentity[_]])]:=x

PermuteCapsAndCupsOnce[x:(___TLCup**___TLCap)]:=x

PermuteCapsAndCupsOnce[x_TLCup]:=x
PermuteCapsAndCupsOnce[x_TLCap]:=x

PermuteCapsAndCupsOnce[x:(a___**TLCap[n_,k_]**TLCup[n_,k_]**b___)]:=δ(a**b**TLIdentity[source[x]])

PermuteCapsAndCupsOnce[x:(a___**TLCap[n_,k_]**TLCup[n_,l_]**b___)]/;Abs[k-l]==1:=a**b**TLIdentity[source[x]]

PermuteCapsAndCupsOnce[x:(a___**TLCap[n_,k_]**TLCup[n_,l_]**b___)]/;Abs[k-l]>1:=a**TLCup[n,l]**TLCap[n,k]**b

PermuteCapsAndCupsOnce[x:(a___**TLCap[n_,k_]**TLCap[m_,l_]**b__)]/;n+2==m∧l≥k+2:=a**TLCap[m,l]**TlCap[n,k-2]**b

Achtung:

PermuteCapsAndCupsOnce[x:(a___**TLCup[n_,k_]**TLCup[m_,l_]**b__)]/;