Assignment rule to distribute matrix-multiplication over custom notation

Question

I'm trying to write some code to do basic algebraic manipulations in BraKet notation.

Thus far I have a function KetToVec which will convert any expression of the form a1 Ket[s1]+ b Ket[s2] +... to a column vector, and the inverse function VecToKet which does the reverse. One problem I'm having is in assigning matrix multiplication rules to the Ket form of the vectors.

Currently I have

Ket:/Dot[M_?MatrixQ,Ket[s__]]:= VecToKet[M.KetToVec[Ket[s]]]

which works for a single Ket. However I can't figure out how to make a similar assignment for multiplication to distribute over a linear combination of Ket's without having to overload one of the internal functions Times, Plus or Dot.

What I want is a way for it to evaluate

X.(a*Ket[s]) := a*(X.Ket[s])

and hence in general

X.(a*Ket[s1]+ b*Ket[s2]+..) := a*(X.Ket[s1]) + b*(X.Ket[s2])+...

But if I try something like

Ket:/Dot[M_?MatrixQ,Times[a_,Ket[s__]]]:= a*VecToKet[M.KetToVec[Ket[s]]]

it returns the error message "Tag Ket in ... is too deep for an assignment rule to be found"

Is this possible? Cheers!

Answer 1

Unfortunately, this is not possible directly, at least as far as I know. The error message you are getting is just a manifestation of it. You are using UpValues, which have a fundamental limitation that they can only be attached to symbols on a level no deeper than 1. I discussed this more in my answer to this question.

Redefining built-in functions, OTOH, especially such fundamental ones as Plus, Times and Dot, is a bad idea most of the time. What you can do, is to create a lexical environment, where they will be replaced by some functions myPlus, myTimes, and myDot:

ClearAll[env];
SetAttributes[env,HoldAll];
env[code_]:= 
 With[{rules = {Times->myTimes,Plus->myPlus,dot->myDot}},
  Unevaluated[code]/.rules/.Reverse[rules,{2}]
 ] 

Now, for example, you can define (note that in the first definition, s comes with a blank _, which you missed):

ClearAll[myDot];
myDot[M_, myTimes[a_, Ket[s_]]] := 
   myTimes[a, VecToKet[myDot[M, KetToVec[Ket[s]]]]];
myDot[M_, myPlus[args__]] := 
   myPlus @@ Map[myDot[M, #] &, {args}];

And you use this as

env[X.(a*Ket[s])]

a VecToKet[X.KetToVec[Ket[s]]]

and also

env[X.(a*Ket[s1] + b*Ket[s2])]

a VecToKet[X.KetToVec[Ket[s1]]] + b VecToKet[X.KetToVec[Ket[s2]]]

The function env serves as a custom evaluator here. The disadvantage of this approach is that you will generally have to insert env everywhere in your code, because env binds lexically rather than dynamically. But as long as the operation of Times, Plus and Dot on your objects is simply undefined (which would be so for general symbolic objects), you may avoid this problem by replacing the simple implementation above with a more complex infinite-evaluation one:

ClearAll[env];
SetAttributes[env, HoldAll];
env[code_] :=
  With[{result = 
      With[{rules = {Times -> myTimes, Plus -> myPlus, Dot -> myDot}},
         Unevaluated[code] /. rules /. Reverse[rules, {2}]
      ]},
     env[result] /; result =!= Unevaluated[code]
  ]; 
env[code_] := code; 

which should also cover composition.

Finally, you can, if you wish, use $Pre to avoid typing env every time you compute things interactively: $Pre = env;