(* ::Package:: *)

BeginPackage["grt`"];

grt::usage=
"
grt: a package to compute the Curvature tensor, Ricci tensor, 
Einstein tensor, Christoffel symbols, etc. for arbitrary metrics.

(c) Pascal M. Vaudrevange (pascal@vaudrevange.com)
released under GPL
Version 22.Feb.2010


First, load a metric with 

	LoadMetric[coords, metric]

where coords is a list of coordinates of length ndim and metric is 
the ndim \[Times] ndim metric tensor. Note that the first coordinate has index 1. 
For example, Minkowski space would be

  coords={t,x,y,z}
  metric={{1,0,0,0},{0,-1,0,0},{0,0,-1},{0,0,0,-1}}

All objects are indexed the following way:

	A[\!\(\*SuperscriptBox[\"\[Mu]\", \"-\"]\),\!\(\*SubscriptBox[\"\[Nu]\", \"-\"]\)] = \!\(\*SubscriptBox[SuperscriptBox[\"A\", \"\[Mu]\"], \"\[Nu]\"]\)
	A[\!\(\*SubscriptBox[\"\[Mu]\", \"-\"]\),\!\(\*SubscriptBox[\"\[Nu]\", \"-\"]\)] = \!\(\*SubscriptBox[\"A\", \"\[Mu]\[Nu]\"]\)
	A[\!\(\*SuperscriptBox[\"\[Mu]\", \"-\"]\),\!\(\*SuperscriptBox[\"\[Nu]\", \"-\"]\)] = \!\(\*SuperscriptBox[\"A\", \"\[Mu]\[Nu]\"]\)
	etc.

where \[Mu],\[Nu] are any numbers between 1, ndim.
The indices of all tensor objects MUST indicate whether it is a lower 
or upper index. For example, A[1,1] is illegal. To test for the position 
of an index, use the supplied functions Uppper[] and Lower[].

For the curious: The upper/lower index is defined by 

	SuperMinus[\[Mu]_Integer]={\[Mu],'u'};
	SubMinus[\[Mu]_Integer]={\[Mu],'l'};

For a list of defined symbols, enter 

	?grt`*"


LoadMetric::usage=
"Loads the metric and coordinates into the grt package."

g::usage=
"Metric tensor g[\!\(\*SubscriptBox[\"a\", \"-\"]\),\!\(\*SubscriptBox[\"a\", \"-\"]\)]=\!\(\*SubscriptBox[\"g\", \"ab\"]\)"

\[CapitalGamma]::usage=
"Christoffel Symbol 

	\[CapitalGamma][\!\(\*SuperscriptBox[\"a\", \"-\"]\),\!\(\*SubscriptBox[\"m\", \"-\"]\),\!\(\*SubscriptBox[\"n\", \"-\"]\)] = \!\(\*SubscriptBox[SuperscriptBox[\"\[CapitalGamma]\", \"a\"], \"mn\"]\) = \!\(\*FractionBox[\"1\", \"2\"]\)\!\(\*SuperscriptBox[\"g\", \"ab\"]\) (\!\(\*SubscriptBox[\"g\", 
RowBox[{\"bm\", \",\", \"n\"}]]\)-\!\(\*SubscriptBox[\"g\", 
RowBox[{\"gn\", \",\", \"m\"}]]\)+\!\(\*SubscriptBox[\"g\", 
RowBox[{\"mn\", \",\", \"b\"}]]\))

where \!\(\*SubscriptBox[\"f\", 
RowBox[{\",\", \"n\"}]]\) is the partial derivative \!\(\*SubscriptBox[\"\[PartialD]\", \"n\"]\)f.
"

R::usage=
"Curvature (Riemann) tensor 

	R[\!\(\*SuperscriptBox[\"b\", \"-\"]\),\!\(\*SubscriptBox[\"m\", \"-\"]\),\!\(\*SubscriptBox[\"s\", \"-\"]\),\!\(\*SubscriptBox[\"q\", \"-\"]\)]= \!\(\*SubscriptBox[SuperscriptBox[\"R\", \"b\"], \"msq\"]\) = \!\(\*SubscriptBox[SuperscriptBox[\"\[CapitalGamma]\", \"b\"], 
RowBox[{\"mq\", \",\", \"s\"}]]\)-\!\(\*SubscriptBox[SuperscriptBox[\"\[CapitalGamma]\", \"b\"], 
RowBox[{\"ms\", \",\", \"q\"}]]\)+\!\(\*SubscriptBox[SuperscriptBox[\"\[CapitalGamma]\", \"b\"], \"ns\"]\)\!\(\*SubscriptBox[SuperscriptBox[\"\[CapitalGamma]\", \"n\"], \"mq\"]\)-\!\(\*SubscriptBox[SuperscriptBox[\"\[CapitalGamma]\", \"b\"], \"nq\"]\)\!\(\*SubscriptBox[SuperscriptBox[\"\[CapitalGamma]\", \"n\"], \"ms\"]\),

or

Ricci Tensor

	R[\!\(\*SubscriptBox[\"m\", \"-\"]\),\!\(\*SubscriptBox[\"q\", \"-\"]\)]=\!\(\*SubscriptBox[\"R\", \"mq\"]\)= \!\(\*SubscriptBox[SuperscriptBox[\"R\", \"s\"], \"msq\"]\)

where \!\(\*SubscriptBox[\"f\", 
RowBox[{\",\", \"n\"}]]\) is the partial derivative \!\(\*SubscriptBox[\"\[PartialD]\", \"n\"]\)f.
"

RicciScalar::usage=
"RicciScalar=\!\(\*SubscriptBox[SuperscriptBox[\"R\", \"m\"], \"m\"]\)"

G::usage=
"Einstein tensor G[\!\(\*SubscriptBox[\"a\", \"-\"]\),\!\(\*SubscriptBox[\"b\", \"-\"]\)]=\!\(\*SubscriptBox[\"G\", \"ab\"]\)=\!\(\*SubscriptBox[\"R\", \"ab\"]\)-\!\(\*FractionBox[\"1\", \"2\"]\) R \!\(\*SubscriptBox[\"g\", \"ab\"]\)"

Detg::usage=
"Determinant Detg=|g| (can be negative)"

ValidP::usage=
"ValidP[\[Mu]] tests if \[Mu] is a valid upper or lower index,automatically threads over lists."

Upper::usage=
"Upper[\[Mu]] tests if \[Mu] is an upper index, automatically threads over lists.

Examples:
	Upper[\!\(\*SuperscriptBox[\"1\", \"-\"]\)]=True
	Upper[\!\(\*SubscriptBox[\"1\", \"-\"]\)]=False"

Lower::usage=
"Lower[\[Mu]] tests if \[Mu] is a lower index, automatically threads over lists.

Examples:
	Lower[\!\(\*SubscriptBox[\"1\", \"-\"]\)]=True
	Lower[\!\(\*SuperscriptBox[\"1\", \"-\"]\)]=False"

Quabla::usage=
"Quabla[f]=\[Square]f= \!\(\*SuperscriptBox[\"g\", \"ab\"]\) \!\(\*SubscriptBox[\"f\", 
RowBox[{\",\", 
RowBox[{\"a\", \";\", \"b\"}]}]]\) is the covariant box operator acting on scalar 
functions, where \!\(\*SubscriptBox[\"f\", 
RowBox[{\",\", 
RowBox[{\"a\", \";\", \"b\"}]}]]\)=\!\(\*SubscriptBox[\"D\", 
RowBox[{\"b\", \" \"}]]\)\!\(\*SubscriptBox[\"\[PartialD]\", \"a\"]\)f"

Show\[CapitalGamma]::usage=
"Show\[CapitalGamma] prints the non-zero components of \!\(\*SubscriptBox[SuperscriptBox[\"\[CapitalGamma]\", \"a\"], \"bc\"]\)"

ShowCurvatureTensor::usage=
"ShowCurvatureTensor prints the non-zero compontents of the Curvature (Riemann) tensor \!\(\*SubscriptBox[SuperscriptBox[\"R\", \"a\"], \"bcd\"]\)."

ShowRicciTensor::usage=
"ShowRicciTensor prints the non-zero compontents of the Ricci tensor \!\(\*SubscriptBox[\"R\", \"ab\"]\)."

ShowEinsteinTensor::usage=
"ShowEinstenTensor prints the non-zero components of the Einstein Tensor \!\(\*SubscriptBox[\"G\", \"ab\"]\)."


Begin["`Private`"];
Print["grt: a package to compute Christoffel symbols, Curvature tensor, Ricci Tensor, 
Einstein tensor etc. for arbitrary metrics.

(c) Pascal M. Vaudrevange (pascal@vaudrevange.com)
released under GPL
Version 22. Feb. 2010"];


LoadMetric[InCoord_,InMetric_]:=Module[{},
				coord=InCoord;
				metric=InMetric;
				Print["\!\(\*SubscriptBox[\"g\", \"\[Mu]\[Nu]\"]\)=",metric//MatrixForm];
				Print["coordinates = ", coord];
				ndim=Length[coord];
				If[UnsameQ[Dimensions[metric],{4,4}], 
					Print["Metric does not have the correct dimensions"];
				];
				inversemetric:=inversemetric=Simplify[Inverse[metric]];
Connection:=Connection=Module[{a,b,m,n},
			      Simplify[
				       Table[
					     1/2 Sum[
						     g[SuperMinus[a],SuperMinus[b] ](D[g[SubMinus[b],SubMinus[m]],coord[[n]]] +D[g[SubMinus[b],SubMinus[n]],coord[[m]]]- D[g[SubMinus[m],SubMinus[n]],coord[[b]]]),
						     {b,1,ndim}
						     ],
					     {a,1,ndim},
					     {m,1,ndim},
					     {n,1,ndim}
					     ]
				       ]
			      ];
CurvatureTensor:=CurvatureTensor=Module[{b,m,s,q,n},
		Simplify[
			Table[
				D[Connection[[b,m,q]],coord[[s]]]-
				D[Connection[[b,m,s]],coord[[q]]]+
				Sum[
					Connection[[b,n,s]] Connection[[n,m,q]] - Connection[[b,n,q]] Connection[[n,m,s]],
					{n,1,ndim}
				],
			{b,1,ndim},
			{s,1,ndim},
			{q,1,ndim},
			{m,1,ndim}
			]
		]
	];

RicciTensor:=RicciTensor=Module[{s,m,q},
			Table[
				Sum[
					CurvatureTensor[[s,m,s,q]],
					{s,1,ndim}
				],
				{m,1,ndim},
				{q,1,ndim}
			]
		];

EinsteinTensor:=EinsteinTensor=Simplify[RicciTensor-1/2 RicciScalar  * metric];
]


SuperMinus[\[Mu]_Integer]={\[Mu],"u"};


SubMinus[\[Mu]_Integer]={\[Mu],"l"};


ValidP[\[Mu]_]:=Module[{res,i},
		       res=True;
		       Switch[ Depth[\[Mu]],
		       2,res=(Length[\[Mu]]==2),
                       3,Do[
			    res=(res && ValidP[\[Mu][[i]]]),
			 {i,1,Length[\[Mu]]}
			 ],
		       _,res=False;Print["Error in ValidP"]
		       ];
		       res
		]


Upper[\[Mu]_]:=Module[{res,i},
		      res=True;
		      Switch[Depth[\[Mu]],
		      2,res=(\[Mu][[2]]=="u"),
                      3,Do[
			   res=(res && Upper[\[Mu][[i]]]),
			{i,1,Length[\[Mu]]}
			],
		      _, res=False; Print["Error in Upper"]
		      ];
		      res
	      ]


Lower[\[Mu]_]:=Module[{res,i},
			res=True;
			Switch[Depth[\[Mu]],
				2,res=(\[Mu][[2]]=="l"),
				3,Do[
					res=(res && Lower[\[Mu][[i]]]),
					{i,1,Length[\[Mu]]}
					],
				_, res=False; Print["Error in Lower"]
			];
			res
		]


g[\[Mu]_,\[Nu]_]:=Module[{res},
			If[(Length[\[Mu]]==  2 ) && ( Length[\[Nu]]==2),
                Which[
					Lower[{\[Mu],\[Nu]}], res=metric[[\[Mu][[1]],\[Nu][[1]]]],
					Upper[{\[Mu],\[Nu]}], res=inversemetric[[\[Mu][[1]],\[Nu][[1]]]],
					True,If[SameQ[\[Mu][[1]],\[Nu][[1]]],res=1,res=0]
			],
			Print["Error in \!\(\*SubscriptBox[\"g\", \"\[Mu]\[Nu]\"]\): \[Mu]=", \[Mu], ", \[Nu]=",\[Nu]];
			];
		res
	];


\[CapitalGamma][\[Mu]_,\[Nu]_,\[Lambda]_]:=Module[{\[Sigma],\[Rho],\[Alpha]},
				If[ValidP[{\[Mu],\[Nu],\[Lambda]}],
					Sum[
						g[\[Mu],SubMinus[\[Alpha]]] g[\[Nu],SuperMinus[\[Rho]]] g[\[Lambda],SuperMinus[\[Sigma]]] Connection[[\[Alpha], \[Rho], \[Sigma]]],
						{\[Sigma],1,ndim},
						{\[Rho],1,ndim},
						{\[Alpha],1,ndim}
					],
					Print["Error in \[CapitalGamma]"];
				]
			];


R[\[Mu]_,\[Nu]_,\[Rho]_,\[Sigma]_]:=Module[{\[Alpha],\[Beta],\[Gamma],\[Delta]},
			If[ValidP[{\[Mu],\[Nu],\[Rho],\[Sigma]}],
				Sum[
					g[\[Mu],SubMinus[\[Alpha]]] g[\[Nu],SubMinus[\[Beta]]] g[\[Rho],SuperMinus[\[Gamma]]] g[\[Sigma],SuperMinus[\[Delta]]]  CurvatureTensor[[\[Alpha],\[Beta],\[Gamma],\[Delta]]],
					{\[Alpha],1,ndim},
					{\[Beta],1,ndim},
					{\[Gamma],1,ndim},
					{\[Delta],1,ndim}
				],
				Print["Error in \!\(\*SubscriptBox[\"R\", \"\[Mu]\[Nu]\[Rho]\[Sigma]\"]\)"];
			]
		];



R[\[Mu]_,\[Nu]_]:=Module[{\[Alpha],\[Beta]},
			If[ValidP[{\[Mu],\[Nu]}],
				Sum[
					g[\[Mu],SuperMinus[\[Alpha]]] g[\[Nu],SuperMinus[\[Beta]] ] RicciTensor[[\[Alpha],\[Beta]]],
					{\[Alpha],1,ndim},
					{\[Beta],1,ndim}
				],
				Print["Error in Ricci tensor \!\(\*SubscriptBox[\"R\", \"\[Mu]\[Nu]\"]\)"];
			]
		];


RicciScalar:=Simplify[Tr[inversemetric.RicciTensor]];


G[\[Mu]_,\[Nu]_]:=Module[{\[Alpha],\[Beta]},
			If[ValidP[{\[Mu],\[Nu]}],
				Sum[
					g[\[Mu],SuperMinus[\[Alpha]]] g[\[Nu],SuperMinus[\[Beta]] ] EinsteinTensor[[\[Alpha],\[Beta]]],
					{\[Alpha],1,ndim},
					{\[Beta],1,ndim}
				],
				Print["Error in Einstein tensor \!\(\*SubscriptBox[\"G\", \"\[Mu]\[Nu]\"]\)"];
			]
		];


Detg:=Module[{},
		Det[metric]
];


NonZero[object_]:=Module[{},Print["NonZero: General Printing routine: Implement me!"]];


Quabla[f_]:=Module[{a,b,n},
			Simplify[Sum[
				g[SuperMinus[a],SuperMinus[b]] (D[f,coord[[a]],coord[[b]]]-
							Sum[
								Connection[[n,a,b]] D[f,coord[[n]]],
								{n,1,ndim}
							]
						),
				{b,1,ndim},
				{a,1,ndim}
			]
			]
		];


Show\[CapitalGamma]:=Module[{a,b,c},
			Table[
				If[
					UnsameQ[Connection[[a,b,c]],0],
					Print[Subscript[Superscript["\[CapitalGamma]",a],b,c],"=",Connection[[a,b,c]]];
				],
				{a,1,ndim},
				{b,1,ndim},
				{c,1,ndim}
			];
		];


ShowCurvatureTensor:=Module[{a,b,c,d},
			Table[
				If[
					UnsameQ[CurvatureTensor[[a,b,c,d]],0],
					Print[Subscript[Superscript["R",a],b,c,d],"=",CurvatureTensor[[a,b,c,d]]];
				],
				{a,1,ndim},
				{b,1,ndim},
				{c,1,ndim},
				{d,1,ndim}
			];
		];


ShowRicciTensor:=Module[{a,b},
			Table[
				If[
					UnsameQ[RicciTensor[[a,b]],0],
					Print[Subscript["R",a,b],"=",RicciTensor[[a,b]]];
				],
				{a,1,ndim},
				{b,1,ndim}
			];
	];


ShowEinsteinTensor:=Module[{a,b},
			Table[
				If[
					UnsameQ[EinsteinTensor[[a,b]],0],
					Print[Subscript["G",a,b],"=",EinsteinTensor[[a,b]]];
				],
				{a,1,ndim},
				{b,1,ndim}
			];
	];


End[];
EndPackage[];
