(******************************************************************************)

(* :Title: Spin Matrices                                                      *)
(* :Author: Jeff Olson                                                        *)
(* :Summary:
	Provides definitions for the Pauli spin matrices and the Dirac gamma
	matrices. Also defines matrix representations for the Clifford algebras
	Cl(3) and Cl(1,3).
                                                                              *)
(* :Package Version: 1.1                                                      *)
(* :Copyright:                                                                *)
(* :Context: JOlson`SpinMatrices`                                             *)
(* :Category: Group Theory and Algebra                                        *)
(* :History:
	v1.1
		* redefined Dirac matrices to be consistent with Peskin and Schroeder
		* added GradedSigmaMatrices and GradedGammaMatrices
		* fixed reload bug
                                                                              *)
(* :Keywords:                                                                 *)
(* :Sources:                                                                  *)
(* :Warnings:                                                                 *)
(* :Mathematica Version: 4.0                                                  *)
(* :Limitations:                                                              *)
(* :Discussion:

	The Dirac gamma matrices are defined in a Weyl basis using the "west coast"
	metric, (+, -, -, -). The sign conventions are consistent with those of
	Peskin and Schroeder if you regard the index as being "up" (contravariant).
	To convert to the "east coast" metric, (-, +, +, +), execute the following
	command after reading in this file:

	  GradedGammaMatrices = MapIndexed[#1(-I)^(#2[[1]]-1)&, GradedGammaMatrices]

	You can convert to an arbitrary basis with the command:

	  GradedGammaMatrices = Map[(u.#.Inverse[u]) &, GradedGammaMatrices, {2}]

	where u is your favorite 4x4 unitary matrix. For example,

	  u = (1/Sqrt[2]){{1,0,1,0},{0,1,0,1},{-1,0,1,0},{0,-1,0,1}}

	converts to a Dirac basis, and

	  u = (1/Sqrt[2]){{1,0,0,-1},{0,1,1,0},{-I,0,0,-I},{0,-I,I,0}}

	converts to a Majorana basis.
                                                                              *)
(* :Requirements:                                                             *)
(* :Examples:                                                                 *)

(******************************************************************************)
(******************************************************************************)
BeginPackage["JOlson`SpinMatrices`"]

Unprotect[
	PauliMatrix, PauliMatrixDecomposition, SpinMatrix,
	SigmaMatrices, SigmaMatricesGrade, SigmaMatrix, SigmaPseudoScalar,
	GammaMatrices, GammaMatricesGrade, GammaMatrix, GammaPseudoScalar,
	DiracGammaMatrices, DiracGammaMatrix, DiracSigmaMatrices, DiracSigmaMatrix
]

ClearAll[
	PauliMatrix, PauliMatrixDecomposition, SpinMatrix,
	SigmaMatrices, SigmaMatricesGrade, SigmaMatrix, SigmaPseudoScalar,
	GammaMatrices, GammaMatricesGrade, GammaMatrix, GammaPseudoScalar,
	DiracGammaMatrices, DiracGammaMatrix, DiracSigmaMatrices, DiracSigmaMatrix
]

ClearAll[PauliMatrices, GradedSigmaMatrices, GradedGammaMatrices]

SpinMatrix::usage = "SpinMatrix[theta, phi] gives a 2x2 spin matrix for arbitary
	angles theta and phi. Spin matrices are Hermitian, unitary, traceless and
	have a determinant of -1."

PauliMatrix::usage = "PauliMatrix[n] gives the 2x2 Pauli spin matrix for
	n = 1, 2, 3. PauliMatrix[0] gives the 2x2 identity matrix."

PauliMatrices::usage = "PauliMatrices is a list of the 4 2x2 Pauli matrices."

(******************************************************************************)
(******************************************************************************)
Begin["`Private`"]

ClearAll[stindex, sindex]

stindex = (0 | 1 | 2 | 3);
sindex = (1 | 2 | 3);

AntiSymmetrize[expr_] := 
With[{n = Length[expr]},
	(1/n!)Plus@@((Signature[#]Head[expr]@@expr[[#]])& /@ Permutations[Range[n]])
]

(******************************************************************************
 * Pauli Matrices
 ******************************************************************************)

PauliMatrices = {
	{{1, 0}, {0, 1}},
	{{0, 1}, {1, 0}},
	{{0, -I}, {I, 0}},
	{{1, 0}, {0, -1}}
};

PauliMatrix[n:stindex] := PauliMatrices[[n + 1]]

PauliMatrixDecomposition[m_?MatrixQ] :=
	Array[(1/2) Tr[m.PauliMatrix[#]]&, 4, 0] /; (Dimensions[m] === {2, 2})

SpinMatrix[theta_, phi_] = {
	{Cos[theta], Exp[-I phi] Sin[theta]}, 
	{Exp[I phi] Sin[theta], -Cos[theta]}
}

(******************************************************************************
 * Sigma Matrices
 ******************************************************************************)

GradedSigmaMatrices = {
	{{{1, 0}, {0, 1}}},
	{{{0, 1}, {1, 0}}, {{0, -I}, {I, 0}}, {{1, 0}, {0, -1}}},
	{{{0, I}, {I, 0}}, {{0, 1}, {-1, 0}}, {{I, 0}, {0, -I}}},
	{{{I, 0}, {0, I}}}
};

SigmaMatrices := Flatten[GradedSigmaMatrices, 1]
SigmaMatricesGrade[n:(0|1|2|3)] := GradedSigmaMatrices[[n + 1]]

SigmaMatrix[] := IdentityMatrix[2]

SigmaMatrix[a:sindex] := GradedSigmaMatrices[[2, a]]

SigmaMatrix[a:sindex, b:sindex] :=
Module[{u, v},
	AntiSymmetrize[u.v] /. {u->SigmaMatrix[a], v->SigmaMatrix[b]}
]

SigmaMatrix[a:sindex, b:sindex, c:sindex] :=
Module[{u, v, w},
    AntiSymmetrize[u.v.w] /. {u->SigmaMatrix[a], v->SigmaMatrix[b],
		w->SigmaMatrix[c]}
]

SigmaPseudoScalar := GradedSigmaMatrices[[4, 1]]

(******************************************************************************
 * Gamma Matrices
 ******************************************************************************)

GradedGammaMatrices = {
	{{{1,0,0,0},{0,1,0,0},{0,0,1,0},{0,0,0,1}}},
	{{{0,0,1,0},{0,0,0,1},{1,0,0,0},{0,1,0,0}},
	{{0,0,0,1},{0,0,1,0},{0,-1,0,0},{-1,0,0,0}},
	{{0,0, 0,-I},{0,0,I,0},{0,I,0,0},{-I,0,0,0}},
	{{0,0,1,0},{0,0,0,-1},{-1,0,0,0},{0,1,0,0}}},
	{{{0,-1,0,0},{-1,0,0,0},{0,0,0,1},{0,0,1,0}},
	{{0,I,0,0},{-I,0,0,0},{0,0,0,-I},{0,0,I,0}},
	{{-1,0,0,0},{0,1,0,0},{0,0,1,0},{0,0,0,-1}},
	{{0,-I,0, 0},{-I,0,0,0},{0,0,0,-I},{0,0,-I, 0}},
	{{0,-1,0,0},{1,0,0,0},{0,0,0,-1},{0,0,1,0}},
	{{-I,0,0,0},{0,I,0,0},{0,0,-I,0},{0,0,0,I}}},
	{{{0,0,-I,0},{0,0, 0,-I},{I,0,0,0},{0,I,0,0}},
	{{0,0,0,-I},{0,0,-I,0},{0,-I,0,0},{-I,0,0,0}},
	{{0,0,0,-1},{0,0,1,0},{0,-1,0,0},{1,0,0,0}},
	{{0,0,-I,0},{0,0,0,I},{-I,0,0,0},{0,I,0,0}}},
	{{{I,0,0,0},{0,I,0,0},{0,0,-I,0},{0,0,0,-I}}}
};

GammaMatrices := Flatten[GradedGammaMatrices, 1]
GammaMatricesGrade[n:(0|1|2|3|4)] := GradedGammaMatrices[[n + 1]]

GammaMatrix[] := IdentityMatrix[4]

GammaMatrix[a:stindex] := GradedGammaMatrices[[2, a + 1]]

GammaMatrix[a:stindex, b:stindex] :=
Module[{u, v},
	AntiSymmetrize[u.v] /. {u->GammaMatrix[a], v->GammaMatrix[b]}
]

GammaMatrix[a:stindex, b:stindex, c:stindex] :=
Module[{u, v, w},
    AntiSymmetrize[u.v.w] /. {u->GammaMatrix[a], v->GammaMatrix[b],
		w->GammaMatrix[c]}
]

GammaMatrix[a:stindex, b:stindex, c:stindex, d:stindex] :=
Module[{u, v, w, x},
    AntiSymmetrize[u.v.w.x] /. {u->GammaMatrix[a], v->GammaMatrix[b],
		w->GammaMatrix[c], x->GammaMatrix[d]}
]

GammaPseudoScalar := GradedGammaMatrices[[5, 1]]

(******************************************************************************
 * Dirac Matrices
 ******************************************************************************)

DiracGammaMatrices := GammaMatricesGrade[1]
DiracSigmaMatrices := I GammaMatricesGrade[2]

DiracGammaMatrix[mu:stindex] := GammaMatrix[mu]
DiracSigmaMatrix[mu:stindex, nu:stindex] := I GammaMatrix[mu, nu]
DiracGammaMatrix[5] := I GammaPseudoScalar

End[ ]
(******************************************************************************)
(******************************************************************************)

Protect[
	PauliMatrix, PauliMatrixDecomposition, SpinMatrix,
	SigmaMatrices, SigmaMatricesGrade, SigmaMatrix, SigmaPseudoScalar,
	GammaMatrices, GammaMatricesGrade, GammaMatrix, GammaPseudoScalar,
	DiracGammaMatrices, DiracGammaMatrix, DiracSigmaMatrices, DiracSigmaMatrix
]

EndPackage[ ]
(******************************************************************************)
(******************************************************************************)