Calcular conmutadores en mecánica cuántica simbólicamente con la ayuda de Mathematica

Solución:

Creo que lo he descubierto, pero no lo he revisado con mucho cuidado, así que el comprador debe tener cuidado:

Unprotect[NonCommutativeMultiply];
ClearAll[NonCommutativeMultiply];
NonCommutativeMultiply[] := 1;
NonCommutativeMultiply[a_] := a;
NonCommutativeMultiply[first___, const_?NumericQ*b_, rest___] := 
  const*NonCommutativeMultiply[first, b, rest];
NonCommutativeMultiply[first___, const_?NumericQ, rest___] := 
  const*NonCommutativeMultiply[first, rest];

MakeBoxes[
   NonCommutativeMultiply[first___, 
    args : [email protected][x_, {2, [Infinity]}], rest___], form_] :=

  
  RowBox[[email protected]{
     If[Length[{first}] > 0,
      {MakeBoxes[NonCommutativeMultiply[first], form], "**"},
      Nothing
      ],
     SuperscriptBox[MakeBoxes[x, form], ToBoxes[Length[{args}], form]],
     If[Length[{rest}] > 0,
      {"**", MakeBoxes[NonCommutativeMultiply[rest], form]},
      Nothing
      ]
     }];
MakeBoxes[NonCommutativeMultiply[arg_], form_] := MakeBoxes[arg, form]

SetAttributes[NonCommutativeMultiply, Flat];
q[i_] ** p[i_] := I + p[i] ** q[i];
q[i_] ** p[j_] := p[j] ** q[i];
q[i_] ** q[j_] /; ! OrderedQ[{i, j}] := q[j] ** q[i]
p[i_] ** p[j_] /; ! OrderedQ[{i, j}] := p[j] ** p[i]

a_ ** (b_ + c_) := a ** b + a ** c;
(b_ + c_) ** a_ := b ** a + c ** a;

(* Allowing for powers in input and output *)
p /: p[i_]^n_Integer := 
  NonCommutativeMultiply @@ ConstantArray[p[i], n];
q /: q[i_]^n_Integer := 
  NonCommutativeMultiply @@ ConstantArray[q[i], n];

Como puedes ver, fui con p y q para denotar las variables conjugadas para distinguirlas de xyz como direcciones. Necesitarás usar ** para multiplicarlos juntos, pero también puedes usar poderes:

comm[a_, b_] := a ** b - b ** a
comm[q[x], p[x]]
comm[q[x], p[y]]
comm[p[x] ** q[x], p[x]]
comm[q[x] ** p[x]^3, p[x]]

I – 2 p[x] ** q[x]

0

-2 p[x]^ 2 ** q[x] + Yo p[x]

-I p[x]^ 3 + 2 p[x]^ 4 ** q[x]

Editar

Puede agregar la siguiente definición si desea poder elevar a poderes simbólicos:

q[i_] ** p[i_]^n_ := I n p[i]^(n - 1) + p[i]^n ** q[i]

James F. Feagin Métodos cuánticos con Mathematica libro tiene una implementación elegante de esto en el capítulo 15.1 Álgebra del conmutador.

Está en la línea de la respuesta de @ Sjoerd (pero pensé que proporcionaría la referencia al libro anterior), primero definiendo identidades típicas para el NonCommutativeMultiply símbolo:

Unprotect[NonCommutativeMultiply];

A_ ** (B_ + C_) := A ** B + A ** C
(B_ + C_) ** A_ := B ** A + C ** A
A_ ** c_?NumberQ := c A
c_?NumberQ ** A_ := c A
A_ ** (B_ c_?NumberQ) := c A ** B
(A_ c_?NumberQ) ** B_ := c A ** B
A_ ** (B_ c_Rational) := c A ** B
(A_ c_Rational) ** B_ := c A ** B
A_ ** (B_ c_Power) := c A ** B
(A_ c_Power) ** B_ := c A ** B

y luego definir una expresión de conmutación fundamental. por ejemplo, para el caso de OP:

commutator[A_, B_] := A ** B - B ** A
fundamentalCommutation[expr_] := ExpandAll[expr //. p[i_] ** q[i_] :> q[i] ** p[i] - I h]

que de hecho recupera la acción derivada del operador de impulso:

h /: NumberQ[h] = True;
{commutator[p[x]/(-I h), q[x]], 
commutator[p[x]/(-I h), q[x] ** q[x]],
commutator[p[x]/(-I h), q[x] ** q[x] ** q[x]]} //fundamentalCommutation

{1, 2 q[x], 3 q[x] ** q[x]}

Entonces es fácil usar una expresión de conmutación fundamental diferente, por ejemplo, para trabajar con operadores de subida y bajada:

fundamentalComm[expr_] := ExpandAll[expr //. a ** ad :> ad ** a + 1]
{commutator[a, ad], commutator[ad, a], commutator[a ** ad, ad]} // fundamentalComm

{1, -1, ad}

Eso se puede hacer con el paquete NCAlgebra (álgebra no conmutativa), consulte la documentación.

Ejemplo:

(* Import package *)
<< NC`
<< NCAlgebra`
<< NCGBX`

SetNonCommutative[x, y, px, py]
SetMonomialOrder[x, y, px, py] (* x to the left, p to the right *)
NCSetOutput[NonCommutativeMultiply -> True] (* pretty output *)

(* commutation relations *)
gb = NCMakeGB[{
   x ** y - y ** x,
   px ** py - py ** px,
   x ** py - py ** x,
   y ** px - px ** y,
   x ** px - px ** x - I,
   y ** py - py ** y - I}, 20];

(* Define expression that should be simplified *)
Comm[A_, B_] := A ** B - B ** A;
H = px ** px + py ** py + x ** x + y ** y + x ** x ** x ** x + y ** y ** y ** y;
expression = Comm[H, px] // NCExpand;

NCReplaceRepeated[expression, gb] // NCExpand
--> I x - x ** px ** x + x ** x ** px + I x ** x ** x - x ** px ** x ** x ** x + x ** x ** x ** x ** px

Según los documentos, creo que lo anterior debería haber funcionado, pero aparentemente no funciona. Parece que NCReplaceRepeated y NCExpand deben aplicarse varias veces hasta que el resultado “converja”:

foo[X_] := [email protected][X, gb]
expression // foo // foo // foo // foo
--> 2 I x + 4 I x ** x ** x

---

---

Utiliza Nuestro Buscador