View difference between Paste ID: pnA58JSQ and 9zNtaZmU

 SO(4,2) Casimirs in doubleton representation. In this notebook I am constructing a representation of SO(4,2) or SU(2,2) group using 2 pairs of annihilation/creation operators and then I am computing the Casimir invariants for this group in that representation. If you encounter any Fermion/InveX objects, please ignore them as they are not relevant for this particular representation.
 
 $HistoryLength = 0;
 
 Definition of Save and read functions
 
 SaveIt[filename_, expr_] :=
   Module[{output},
    output = Export[filename <> ".dat", ToString[expr // InputForm],
      "String"];
    ClearMemory;
    output];
 SaveIt[varnamestring_] :=
   Module[{output},
    output = Export[varnamestring <> ".dat",
      ToString[ToExpression[varnamestring] // InputForm], "String"];
    ClearMemory;
    output];
 ReadIt[filename_] :=
   Module[{output},
    output = ToExpression[
      Import[StringReplace[filename, ".dat" -> ""] <> ".dat", "String"]];
    ClearMemory;
    output];
 ClearMemory := Module[{}, Unprotect[In, Out];
    Clear[In, Out];
    Protect[In, Out];
    ClearSystemCache[];];
 
 Definition of Bosonic oscillators
 
 Clear[Boson, BosonC, BosonA]
 Boson /: MakeBoxes[Boson[cr : (True | False), sym_], fmt_] :=
  With[{sbox = If[StringQ[sym], sym, ToBoxes[sym]]},
   With[{abox =
      If[cr, SuperscriptBox[#, FormBox["\[Dagger]", Bold]], #] &@sbox},
    InterpretationBox[abox, Boson[cr, sym]]]]
 BosonA[sym_: String "a"] := Boson[False, sym]
 BosonC[sym_: String "a"] := Boson[True, sym]
 
-Definition of Inverse X operators (*These objects are not needed for this particular computation*)
+
 
-Clear[InveX]
+
-InveX /: MakeBoxes[InveX[pow : _Integer, sym_], fmt_] :=
+
 Unprotect[NonCommutativeMultiply];
-  With[{abox = FractionBox[1, SuperscriptBox[#, pow]] &@sbox},
+
-   InterpretationBox[abox, InveX[pow, sym]]]]
+
 NonCommutativeMultiply /: MakeBoxes[NonCommutativeMultiply[a__], fmt_] :=
-Definition of Operators (*These objects are not needed for this particular computation*)
+
   InterpretationBox[cbox, NonCommutativeMultiply[a]]]
-Clear[Operator]
+
-Operator /: MakeBoxes[Operator[sym_], fmt_] :=
+
- With[{abox = ToBoxes[sym]}, InterpretationBox[abox, Operator[sym]]]
+
 
 Definition of clean - the function which orders and simplifies expressions
 
 ClearAll@expand
 (*the attribute is new*)
 SetAttributes[expand, HoldAll]
 
 (*equivalent to your code but in my opinion/expectation clearer \
 cleaner and slightly faster*)
 
 Unevaluated[
   expand[expr_] :=
    Block[{NonCommutativeMultiply (*or times*)},
     expr /. {times[left___, cnum_ /; FreeQ[cnum, (_Boson)],
         right___] :> cnum*times[left, right],
       times[left___,
         cnum_ /; (! FreeQ[cnum, Times[n___?NumericQ, ___Boson]]),
         right___] :>
-Clear[expand, deriv, clean]
+       Times @@ Apply[Power, Drop[FactorList[cnum], -1], 2]*
         times[left, First[Last[FactorList[cnum]]], right],
-deriv[InveX[pow_, s_], s_] := -pow*InveX[pow + 1, s]
+      times[left___, Boson[False, s_], Boson[True, s_], right___] :>
        times[left, right] +
-expand[expr_] :=
+        times[left, Boson[True, s], Boson[False, s], right],
-  Module[{times},
+      times[left___, fst : Boson[_, s_], sec : Boson[_, t_],
-   expr /. NonCommutativeMultiply[b___] :>
+        right___] :>
-        times[b] //. {times[left___,
+       times[left, sec, fst, right] /;
-         cnum_ /; FreeQ[cnum, (_Boson | _InveX | _Fermion | _Operator)],
+        FreeQ[Ordering[{s, t}], {1, 2}], times[b_Boson] :> b
-         right___] :> cnum*times[left, right],
+      (*moved and rewrote this rule*),
-       times[left___,
+      times[] -> 1}]] /. {HoldPattern[times] -> NonCommutativeMultiply}
-         cnum_ /; (! FreeQ[cnum, Times[n___?NumericQ, ___Boson]]),
+expand[Alternatives[NonCommutativeMultiply, CenterDot][
-         right___] :>
+   a1_, (a2_ + a3_)]] := expand[a1 ** a2] + expand[a1 ** a3]
-        Times @@ Apply[Power, Drop[FactorList[cnum], -1], 2]*
+expand[Alternatives[NonCommutativeMultiply, CenterDot][(a1_ + a2_),
-         times[left, First[Last[FactorList[cnum]]], right],
+   a3_]] := expand[a1 ** a3] + expand[a2 ** a3]
-       times[left___, fst : Fermion[_, s_], sec : Boson[_, t_], right___] :>
+
-        times[left, sec, fst, right],
+Clear[clean]
-       times[left___, Boson[False, s_], Boson[True, s_], right___] :>
+
-        times[left, right] +
+
-         times[left, Boson[True, s], Boson[False, s], right],
+
-       times[left___, fst : Boson[_, s_], sec : Boson[_, t_], right___] :>
+
-        times[left, sec, fst, right] /;
+
-         FreeQ[Ordering[{s, t}], {1, 2}],
+
-       times[b_Boson] :> b} /. times[arg__] :> NonCommutativeMultiply[arg] /. times[] -> 1];
+
-expand /: expand[a1_\[CenterDot](a2_ + a3_)] :=
+
- expand[a1\[CenterDot]a2] + expand[a1\[CenterDot]a3]
+
-expand /: expand[(a1_ + a2_)\[CenterDot]a3_] :=
+
- expand[a1\[CenterDot]a3] + expand[a2\[CenterDot]a3]
+
-expand /: expand[InveX[pow1_, s_]\[CenterDot]InveX[pow2_, s_]] :=
+
- expand[InveX[pow1 + pow2, s]]
+
 Clear[\[Psi], \[Chi], \[CapitalGamma], \[CapitalSigma], i, j, k, l, m, n, p, \
 q, g, T, G, P, Tr1, Tr2, Tr3, Cartan, Comm, Killing, Joseph, Commutator, \
 Zero, zero, KillComm, KillMet, DoubleTr, GComm, Dim]
 Dim = 6;
 Ad = BosonC[a]; A = BosonA[a]; Bd = BosonC[b]; B = BosonA[b]; Xd =
  BosonC[x]; X = BosonA[x]; Yd = BosonC[y]; Y = BosonA[y];
 
 Defining the algebra.
 
 Dirac \[CapitalGamma] matrices:
 
 \[CapitalGamma][
    1] = {{1, 0, 0, 0}, {0, 1, 0, 0}, {0, 0, -1, 0}, {0, 0, 0, -1}};
 \[CapitalGamma][
    2] = {{0, 0, 0, -1}, {0, 0, -1, 0}, {0, 1, 0, 0}, {1, 0, 0, 0}};
 \[CapitalGamma][
    3] = {{0, 0, 0, I}, {0, 0, -I, 0}, {0, -I, 0, 0}, {I, 0, 0, 0}};
 \[CapitalGamma][
    4] = {{0, 0, -1, 0}, {0, 0, 0, 1}, {1, 0, 0, 0}, {0, -1, 0, 0}};
 \[CapitalGamma][
    5] = {{0, 0, I, 0}, {0, 0, 0, I}, {I, 0, 0, 0}, {0, I, 0, 0}};
 Zero = {{0, 0, 0, 0}, {0, 0, 0, 0}, {0, 0, 0, 0}, {0, 0, 0, 0}};
 
 Spinors and metric:
 
 g = DiagonalMatrix[{-1, 1, 1, 1, 1, -1}];
 \[Psi] = {{A}, {B}, {-Xd}, {-Yd}};
 \[Chi] = {{Ad, Bd, X, Y}};   (*This is the Dirac conjugate of \[Psi]*)
 
 Subscript[\[CapitalGamma], ij] matrices:
 
 Table[\[CapitalSigma][i,
     j] = -I ( \[CapitalGamma][i].\[CapitalGamma][j] - \[CapitalGamma][
          j].\[CapitalGamma][i])/4, {i, 1, 4}, {j, 1, 4}];
 
 \[CapitalSigma][5, 6] = -\[CapitalGamma][5]/2; \[CapitalSigma][6,
   5] = \[CapitalGamma][5]/2;
 
 Table[\[CapitalSigma][i,
     5] = -I \[CapitalGamma][i].\[CapitalGamma][5]/2; \[CapitalSigma][5, i] =
    I \[CapitalGamma][i].\[CapitalGamma][5]/2; \[CapitalSigma][i,
     6] = -\[CapitalGamma][i]/2; \[CapitalSigma][6, i] =  \[CapitalGamma][i]/
     2, {i, 1, 4}];
 
 \[CapitalSigma][5, 5] = Zero;
 \[CapitalSigma][6, 6] = Zero;
 
 Generators of SO(4,2) denoted by G[i,j]
 
 Table[G[i, j] =
    Sum[\[CapitalSigma][i, j][[m,
       n]] \[Chi][[1, m]]\[CenterDot]\[Psi][[n, 1]], {m, 1, 4}, {n, 1, 4}], {i,
     1, Dim}, {j, 1, Dim}];
 
 Check the commutation relations of \[CapitalSigma] matrices
 
 (*Table[Print[i,",",j,",",k,",",l,"=",Simplify[(\[CapitalSigma][i,j].\
 \[CapitalSigma][k,l]-\[CapitalSigma][k,l].\[CapitalSigma][i,j]+ I( g[[i,k]]\
 \[CapitalSigma][j,l]-  g[[i,l]]\[CapitalSigma][j,k] -  \
 g[[j,k]]\[CapitalSigma][i,l] +  \
 g[[j,l]]\[CapitalSigma][i,k]))]],{i,1,Dim},{j,1,Dim},{k,1,Dim},{l,1,Dim}];*)
 
 Check the commutation relations of group generators
 
 (*Table[Print[i,",",j,",",k,",",l,"=",clean[(G[i,j]\[CenterDot]G[k,l]-G[k,l]\
 \[CenterDot]G[i,j]+ I( g[[i,k]]G[j,l]-  g[[i,l]]G[j,k] -  g[[j,k]]G[i,l] +  \
 g[[j,l]]G[i,k]))]],{i,1,Dim},{j,1,Dim},{k,1,Dim},{l,1,Dim}];*)
 
 Generators of SO(3,1) and rest of the conformal generators
 
 Clear[M, \[Eta], \[CapitalPi], \[CapitalKappa], \[CapitalDelta]]
 (*\[CapitalPi] are translations, \[CapitalKappa](this is greek capital K \
 obtained by esc K esc)are special conformal and \[CapitalDelta] is \
 dilatations*)
 
 \[Eta] = DiagonalMatrix[{-1, 1, 1, 1}];
 Table[M[i, j] = G[i, j], {i, 1, 4}, {j, 1, 4}];
 Table[\[CapitalKappa][i] = G[i, 6] - G[i, 5], {i, 1, 4}];
 Table[\[CapitalPi][i] = G[i, 6] + G[i, 5], {i, 1, 4}];
 \[CapitalDelta] = -G[5, 6];
 
 Casimirs
 
 Quadratic Casmir
 
 Clear[ind1, ind2, ind3, ind4, Cas2, Z]
 
 Z = Ad\[CenterDot]A + Bd\[CenterDot]B - Xd\[CenterDot]X - Yd\[CenterDot]Y;
 
 Cas2 = clean[
    Sum[g[[ind1, ind3]]\[CenterDot]G[ind3, ind2]\[CenterDot]g[[ind2,
       ind4]]\[CenterDot]G[ind4, ind1], {ind1, 1, 6}, {ind2, 1, 6}, {ind3, 1,
      6}, {ind4, 1, 6}]];
 clean[Cas2 + (3/2) (Z\[CenterDot]Z - 4)];
 SaveIt["Cas2"];
 Cas2sq = clean[Cas2\[CenterDot]Cas2];
 SaveIt["Cas2sq"];
 
 Cubic Casmir
 
 (*Clear[ind1,ind2,ind3,ind4,ind5,ind6,cas3]
 
 Timing[cas3=Sum[g[[ind1,ind4]]g[[ind2,ind5]]g[[ind3,ind6]]G[ind4,ind2]\
 \[CenterDot]G[ind5,ind3]\[CenterDot]G[ind6,ind1],{ind1,1,6},{ind2,1,6},{ind3,\
 1,6},{ind4,1,6},{ind5,1,6},{ind6,1,6} ];];
 Cas3=clean[cas3];
 SaveIt["Cas3.dat"];
 clean[Cas3 -2I Cas2];*)
 
 Quartic Casimir
 
 (*Clear[ind1,ind2,ind3,ind4,ind5,ind6,ind7,ind8,cas4]
 
 cas4=Sum[g[[ind1,ind5]]g[[ind2,ind6]]g[[ind3,ind7]]g[[ind4,ind8]]G[ind5,ind2]\
 \[CenterDot]G[ind6,ind3]\[CenterDot]G[ind7,ind4]\[CenterDot]G[ind8,ind1],{\
 ind1,1,6},{ind2,1,6},{ind3,1,6},{ind4,1,6},{ind5,1,6},{ind6,1,6},{ind7,1,6},{\
 ind8,1,6}];
 Cas4=clean[cas4];
 SaveIt["Cas4"];
 clean[Cas4-(1/6) Cas2sq+4 Cas2]*)
 
 Cas4 = ReadIt["Cas4"];
 
 clean[Cas4 - (1/6) Cas2sq + 4 Cas2]
 
 0
 
 6th order Casimir
 
 (*Clear[ind1,ind2,ind3,ind4,ind5,ind6,ind7,ind8,ind9,ind10,ind11,ind12,cas6,\
 Cas6,dim]
 
 dim=6;
 
 Timing[cas6=ParallelSum[g[[ind1,ind7]]g[[ind2,ind8]]g[[ind3,ind9]]g[[ind4,\
 ind10]]g[[ind5,ind11]]g[[ind6,ind12]]G[ind7,ind2]\[CenterDot]G[ind8,ind3]\
 \[CenterDot]G[ind9,ind4]\[CenterDot]G[ind10,ind5]\[CenterDot]G[ind11,ind6]\
 \[CenterDot]G[ind12,ind1],{ind1,1,dim},{ind2,1,dim},{ind3,1,dim},{ind4,1,dim},\
 {ind5,1,dim},{ind6,1,dim},{ind7,1,dim},{ind8,1,dim},{ind9,1,dim},{ind10,1,dim}\
 ,{ind11,1,dim},{ind12,1,dim}];]*)
 
 (*Cas6=clean[cas6];*)
 
 (*Clear[ind1,ind2,ind3,ind4,ind5,ind6,ind7,ind8,ind9,ind10,ind11,ind12,cas6,\
 Cas6,dim]
 
 dim=6;
 
 AbsoluteTiming[Table[cas6[i,j]=ParallelSum[g[[i,ind7]]g[[j,ind8]]g[[ind3,ind9]\
 ]g[[ind4,ind10]]g[[ind5,ind11]]g[[ind6,ind12]]G[ind7,j]\[CenterDot]G[ind8,\
 ind3]\[CenterDot]G[ind9,ind4]\[CenterDot]G[ind10,ind5]\[CenterDot]G[ind11,\
 ind6]\[CenterDot]G[ind12,i],{ind3,1,dim},{ind4,1,dim},{ind5,1,dim},{ind6,1,\
 dim},{ind7,1,dim},{ind8,1,dim},{ind9,1,dim},{ind10,1,dim},{ind11,1,dim},{\
 ind12,1,dim}],{i,1,dim},{j,1,dim}];]*)
 
 (*AbsoluteTiming[Table[Cas6[i,j]=clean[cas6[i,j]],{i,1,dim},{j,1,dim}]]*)
 
 3-3 split
 
 (*Clear[Cas6133,cas6133]
 
 Table[cas6133[ind1,ind4]=Sum[g[[ind1,ind7]]g[[ind2,ind8]]g[[ind3,ind9]]G[ind7,\
 ind2]\[CenterDot]G[ind8,ind3]\[CenterDot]G[ind9,ind4],{ind7,1,6},{ind2,1,6},{\
 ind8,1,6},{ind3,1,6},{ind9,1,6}],{ind1,1,6},{ind4,1,6}];
 Table[Cas6133[i,j]=clean[cas6133[i,j]],{i,1,6},{j,1,6}];
 SaveIt["Cas6133"];*)
 
 ClearMemory[];
 
 (*Clear[Cas6233,cas6233]
 
 Table[cas6233[ind4,ind1]=Sum[g[[ind4,ind10]]g[[ind5,ind11]]g[[ind6,ind12]]G[\
 ind10,ind5]\[CenterDot]G[ind11,ind6]\[CenterDot]G[ind12,ind1],{ind10,1,6},{\
 ind5,1,6},{ind11,1,6},{ind6,1,6},{ind12,1,6}],{ind4,1,6},{ind1,1,6}];
 Table[Cas6233[i,j]=clean[cas6233[i,j]],{i,1,6},{j,1,6}];
 SaveIt["Cas6233"];*)
 
 ClearMemory[];
 
 (*Clear[Cas6333,cas6333]
 
 cas6333=Sum[Cas6133[ind1,ind4]\[CenterDot]Cas6233[ind4,ind1],{ind1,1,6},{ind4,\
 1,6}];
 SaveIt["cas6333"];
 Cas6333=clean[cas6333];
 SaveIt["Cas6333"];*)
 
 Clear[Cas2cub]
 Cas2cub = clean[Cas2\[CenterDot]Cas2sq];
 SaveIt["Cas2cub"];
 
 $Aborted
 
  (*clean[Cas6333-\[Alpha] Cas2quart]*)
 
 Cas63 = ReadIt["Cas6333"];
 Cas2quart = ReadIt["Cas2quart"];
 
 clean[Cas63 - (1/36) Cas2cub + 2 Cas2sq - 16 Cas2]
 
 0