Working with Tensors II

This notebook continues on developing the tools needed to work with Tensors in Mathematica

Routines from first notebook

NamedTranspose[mat_,orig_,final_]:=Module[{ord=Flatten[Position[final,#]&/@orig]},Transpose[mat,ord]]

NamedTranspose::usage="NamedTranspose[mat_,orig_,final_] takes a tensor `mat' whose indices are named `orig' and shuffles the order, so they match `final'.  For example NamedTranspose[SparseArray[{1,2,3}->5,{3,3,3}],{'a','b','c'},{'b','c','a'}]";

ReOrder[tensordescription_List,finalnames_]:=Module[{
tensor="tensor"/.tensordescription, (* Extract Tensor *)
names="names"/.tensordescription, (* Extract names of indices *)
newtensor (* Declare local variables *)
},
(* Calculate new Tensor *)
newtensor=NamedTranspose[tensor,names,finalnames];
(* Assemble into rules *)
{"tensor"->newtensor,"names"->finalnames}
]

ReOrder::usage="ReOrder[tensordescription_List,finalnames_] takes a NamedTensor object of the form {'tensor'->tensor,'names'->names} and returns a NamedTensor, with the indices permuted to match finalnames"

New routines

Combining and Breaking Indices

We combine and break apart indices using “ArrayReshape”.  For example, we can turn a 3x4x2 tensor into a 3x8 matrix, and back

M=SparseArray[{{1,1,1}->a,{2,2,1}->b,{2,3,2}->c,{3,4,2}->d},{3,4,2}]

MatrixForm[combM23=ArrayReshape[M,{3,8}]]

MatrixForm[ArrayReshape[combM23,{3,4,2}]]

Here are some functions that do the same for out “NamedTensors.”

There is a choice of what order the new indices should have.  I will make 3 versions -- CombineIndices, which puts them at the location of the first of the names being combined.  The others: leftCombineIndices and rightCombineIndices put them at the left and right

CombineIndices[namedtensor_List,indicestocombine_List,newindex_]:=
Module[{oldnames="names"/.namedtensor,names,targpos,newnamedtensor,dims,tensor,newdims,newtensor,finalnamedtensor,ind,indexkeys,refine,newnames,targnames},
(* Shift the indices we want to the right *)
targpos=First@Flatten@Position[oldnames,Alternatives@@indicestocombine];
names=Join[Complement[oldnames,indicestocombine],indicestocombine];
newnamedtensor=ReOrder[namedtensor,names];
(* Next extract the tensor *)
tensor="tensor"/.newnamedtensor;
(* Calculate the lengths of each of the indices *)
dims=Dimensions[tensor];
newdims=Append[dims[[;;-Length[indicestocombine]-1]],Times@@dims[[-Length[indicestocombine];;]]];
(* Do the reshaping *)
newtensor=ArrayReshape[tensor,newdims];
newnames=Append[names[[;;-Length[indicestocombine]-1]],newindex];
(* Do a final reordering *)
targnames=Join[newnames[[;;targpos-1]],{newnames[[-1]]},newnames[[targpos;;-2]]];
ReOrder[{"tensor"->newtensor,"names"->newnames},targnames]]

rightCombineIndices[namedtensor_List,indicestocombine_List,newindex_]:=
Module[{oldnames="names"/.namedtensor,names,newnamedtensor,dims,tensor,newdims,newtensor,finalnamedtensor,ind,indexkeys,refine,newnames,targnames},
(* Shift the indices we want to the right *)
names=Join[SortBy[Complement[oldnames,indicestocombine],Position[oldnames,#]&],indicestocombine];
newnamedtensor=ReOrder[namedtensor,names];
(* Next extract the tensor *)
tensor="tensor"/.newnamedtensor;
(* Calculate the lengths of each of the indices *)
dims=Dimensions[tensor];
newdims=Append[dims[[;;-Length[indicestocombine]-1]],Times@@dims[[-Length[indicestocombine];;]]];
(* Do the reshaping *)
newtensor=ArrayReshape[tensor,newdims];
newnames=Append[names[[;;-Length[indicestocombine]-1]],newindex];
{"tensor"->newtensor,"names"->newnames}]

leftCombineIndices[namedtensor_List,indicestocombine_List,newindex_]:=
Module[{oldnames="names"/.namedtensor,names,newnamedtensor,dims,tensor,newdims,newtensor,finalnamedtensor,ind,indexkeys,refine,newnames,targnames},
(* Shift the indices we want to the right *)
names=Join[indicestocombine,SortBy[Complement[oldnames,indicestocombine],Position[oldnames,#]&]];
newnamedtensor=ReOrder[namedtensor,names];
(* Next extract the tensor *)
tensor="tensor"/.newnamedtensor;
(* Calculate the lengths of each of the indices *)
dims=Dimensions[tensor];
newdims=Prepend[dims[[Length[indicestocombine]+1;;]],Times@@dims[[;;Length[indicestocombine]]]];
(* Do the reshaping *)
newtensor=ArrayReshape[tensor,newdims];
newnames=Prepend[names[[Length[indicestocombine]+1;;]],newindex];
{"tensor"->newtensor,"names"->newnames}]

We are now going to overload a version where it uses an automated convention to name the index

makename[indicestocombine_List]:=StringJoin@@Riffle[ToString/@indicestocombine,Table["_",{Length[indicestocombine]-1}]]

Here is how the naming works

makename[{"a","b","c"}]

Here is the inverse command

breakname[compoundname_String]:=StringSplit[compoundname,"_"]

breakname["a_b_c_"]

CombineIndices[namedtensor_List,indicestocombine_List]:=
Module[{newindex=makename[indicestocombine]},
CombineIndices[namedtensor,indicestocombine,newindex]]

leftCombineIndices[namedtensor_List,indicestocombine_List]:=
Module[{newindex=makename[indicestocombine]},
leftCombineIndices[namedtensor,indicestocombine,newindex]]

rightCombineIndices[namedtensor_List,indicestocombine_List]:=
Module[{newindex=makename[indicestocombine]},
rightCombineIndices[namedtensor,indicestocombine,newindex]]

Usage

R1={"tensor"->SparseArray[{{1,1,1,1}->1,{2,2,2,2}->1},{2,2,2,2}],"names"->{"α","β","α`","β`"}}

CombineIndices[R1,{"α`","β"}]

leftCombineIndices[R1,{"α`","β"}]

rightCombineIndices[R1,{"α`","β"}]

CombineIndices[R1,{"α","α`"}]

rightCombineIndices[R1,{"α","α`"}]

CombineIndices[R1,{"α","β","α`"},"αβα"]

cr1=CombineIndices[R1,{"α","β","α`"}]

Then we need to encapsulate breaking indices.  You need to tell it the dimension of each of the new indices, see below for example.

BreakIndices[namedtensor_List,indextobreak_,newnames_List,newdimensions_List]:=
Module[{tensor="tensor"/.namedtensor,
names="names"/.namedtensor,
olddims,
pos,newtensor,newdims,finalnames,dimtobereplaced
},
olddims=Dimensions[tensor];
pos=First@Flatten@Position[names,indextobreak];
(* Do a quick consistency check *)
dimtobereplaced=olddims[[pos]];
If[dimtobereplaced≠Times@@newdimensions,
Return[Failure["Inconsistent Dimensions",
Association["MessageTemplate"->"Trying to break an index of length `l1` into indices of length `dims`",
"MessageParameters"->Association[
"l1"->dimtobereplaced,
"dims"->newdimensions
]]]];
];
newdims=Join[olddims[[;;pos-1]],newdimensions,olddims[[pos+1;;]]];
newtensor=ArrayReshape[tensor,newdims];
finalnames=Join[names[[;;pos-1]],newnames,names[[pos+1;;]]];
{"tensor"->newtensor,"names"->finalnames}
]

R2=BreakIndices[cr1,"α_β_α`",{"α","β","α`"},{2,2,2}]

R2==R1

Outer Products

First make a little routine which will add primes to indices if we give two labels which are the same

disambiguate[names_List]:=Module[{seive,count},
count[_]=0;
seive[a_]:=Module[{astr=ToString[a],root,numticks=0},
root=astr;
While[StringTake[root,-1]=="'",
numticks+=1;
root=StringTake[root,{1,-2}];
];
count[root]+=1;
root<>StringRepeat["'",count[root]-1]];
seive/@names]

disambiguate[{"a","b","a","b"}]

disambiguate[{"a'","b","c","b"}]

Combine[namedtensors__List]:={"tensor"->TensorProduct@@("tensor"/.{namedtensors}),"names"->disambiguate[Join@@("names"/.{namedtensors})]}

Example: Making an identity matrix on the product space of three spin 1/2’s

id[left_,right_,len_]:={"tensor"->IdentityMatrix[len],"names"->{left,right}}

idabc=Combine[id["a","a'",2],id["b","b'",2],id["c","c'",2]]

Exercises

We can work with this technology symbolically -- for example, we can label basis states of a spin by

sigbasis={"tensor"->{"(Subscript[σ, ↑])","(Subscript[σ, ↓])"},"names"->{"σ"}}

The basis for a second spin is

taubasis={"tensor"->{"(Subscript[τ, ↑])","(Subscript[τ, ↓])"},"names"->{"τ"}}

The product basis would be

mixedbasis=CombineIndices[Combine[sigbasis,taubasis],{"σ","τ"}]

The Pauli operators are

pauliZ=SparseArray@{{1,0},{0,-1}};
pauliX=SparseArray@{{0,1},{1,0}};
pauliY=SparseArray@{{0,-I},{I,0}};
pauliI = SparseArray@{{1,0},{0,1}};

Use the various tools that we developed to make the operator A=(Subscript[σ, x])(Subscript[σ, x])+(Subscript[σ, y])(Subscript[σ, y])+(Subscript[σ, z])(Subscript[σ, z]) as a 4x4 matrix.  Then use the function “Eigensystem” to find its eigenvectors and eigenvalues