4
$\begingroup$

Motivation

Consider the definition of tensor product of operators like \begin{equation} x1\otimes x2 \otimes x3 \cdot y1\otimes y2 \otimes y3=x1 y1\otimes x2 y2\otimes x3y3 \end{equation} where $x_i\in A_i$. Intuitively one can imagine a spin chain, and $x_i$'s are e.g. spin operators acting on different sites of the spin chain.

We can realize it using NonCommutativeMultiply and CircleTimes

NonCommutativeMultiply[arg1_CircleTimes,arg2_CircleTimes]:=
Block[{NonCommutativeMultiply},
Thread[NonCommutativeMultiply[arg1,arg2],CircleTimes]
]

Here Block is to prevent the evaluation inside Thread. The results are desired

(x1\[CircleTimes]x2\[CircleTimes]x3)**(y1\[CircleTimes]y2\[CircleTimes]y3)

enter image description here

Question

Now if we have a bilocal operator $R: H_1\otimes H_2\to H_1\otimes H_2$ acting on two sites (A concrete example of $R$ is the transposition operator $R(x\otimes y)=y\otimes x$), obeying the following rule \begin{equation} x1\otimes R \cdot y1\otimes y2 \otimes y3=x1 y1\otimes R(y2 \otimes y3) \end{equation}

To realize the rule we need threading over lists with unequal lengths.

What I want is like the following examples:

Example 1

f[g[x1,R,x4],g[y1,y2,y3,y4]]//thread[#,g]&

returns

g[f[x1,y1],f[R,g[y2,y3]],f[x4,y4]]

Example 2

f[g[x1,R],g[R,y3]]//thread[#,g]&

returns unchanged

f[g[x1,R],g[R,y3]]

Example 3

f[g[x1,R],g[y1,R]]//thread[#,g]&

returns

f[g[x1,y1],g[R,R]]

That is to say, R behaves like a sequcence with length[R]=2, and the lists are threaded as possible as they can. Is there a simple way to realize this version of thread?

Example 4

A more complicated case is like: now introducing a new one T behavine like a sequcence with length[R]=3,

f[g[x1,T],g[y1,R,y4]]//thread[#,g]&

returns

g[f[x1,y1],f[T,g[R,y4]]]

Example 5

If the "effective" lengths are unequal, then abort the evalutation

f[g[x1,R],g[R]]

returns

Abort[]

since length@R=2 and length@{x1,R}=3;

$\endgroup$
1
  • $\begingroup$ I forgot to say the attributes: SetAttributes[NonCommutativeMultiply,{Flat,OneIdentity}]; SetAttributes[CircleTimes,{Flat,OneIdentity}];. $\endgroup$
    – Lacia
    Sep 13, 2022 at 2:14

1 Answer 1

3
$\begingroup$

Code.

length[_]=1;
insert$dummy[(g_)[x___]]:=g@@Join@@Map[Join[{#},ConstantArray[$dummy,length[#]-1]]&,{x}];
thread[(f_)[(g_)[x___],(g_)[y___]]]:=Map[Thread[#,f]&,Split[Thread[
  f[insert$dummy[g[x]],insert$dummy[g[y]]],g],MemberQ[#2,$dummy]&]]/.{$dummy->Sequence[]}/.{g[s_]:>s};

If symbols have length unequal to one, one can specify them like so:

length[R]^=2;
length[T]^=3;

Examples. It works in the examples given by OP:

f[g[x1,R,x4],g[y1,y2,y3,y4]]//thread
(* g[f[x1,y1],f[R,g[y2,y3]],f[x4,y4]] *)

f[g[x1,R],g[R,y3]]//thread
(* f[g[x1,R],g[R,y3]] *)

f[g[x1,R],g[y1,R]]//thread
(* g[f[x1,y1],f[R,R]] *)

f[g[x1,T],g[y1,R,y4]]//thread
(* g[f[x1,y1],f[T,g[R,y4]]] *)

f[g[x1,R],g[R]]//thread
(* generates an error *)

Comment. I will use the 4th example above to indicate how the code works. Here is the sequence of expressions that is generated during the evaluation:

f[g[x1,T],g[y1,R,y4]]
-> f[g[x1,T,$dummy,$dummy],g[y1,R,$dummy,y4]] (* insert $dummy *)
-> g[f[x1,y1],f[T,R],f[$dummy,$dummy],f[$dummy,y4]] (* Thread *)
-> g[g[f[x1,y1]],g[f[T,R],f[$dummy,$dummy],f[$dummy,y4]]] (* Split *)
-> g[f[g[x1],g[y1]],f[g[T,$dummy,$dummy],g[R,$dummy,y4]]] (* Thread *)
-> g[f[g[x1],g[y1]],f[g[T],g[R,y4]]] (* drop $dummy *)
-> g[f[x1,y1],f[T,g[R,y4]]]

I understand that the code has limitations as it stands, but wanted to keep it simple.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.