xTensor

Fast abstract tensor computer algebra

José M. Martín-García
(c) 2002-2021, under GPL

jose@xact.es
http://www.xact.es/
http://groups.google.com/group/xAct

0. Info and copyright

(**********************************************************************)
(************************ 0. Info and copyright ***********************)
(**********************************************************************)

Today

xAct`xTensor`$Version={"1.2.0",{2021,10,17}};
xAct`xTensor`$xPermVersionExpected={"1.2.3",{2015,8,23}};

$SessionID

0.0. TODO LIST

Soon

- What should we do with SeparateMetric on delta[a,-b] ?
- Index-modifiers and Dagger.
- None of the functions is able to tell that v[a] + v[{a,B}] is wrong.
- Guillaume's suggestions for improved symmetrization. Need computation of transversals.
- Suggest the use of Implode / Explode to handle derivatives. Problems with derivative-related symmetries and with induced derivatives.
- There are still problems with dim=1. In particular MakeRule[ contracted Riemann, Ricci, MetricOn->All ] kills the kernel when defining a covariant derivative!
- Perhaps we need another sign variable controlling where we contract the orthogonal vector with the n-dim eta/epsilon tensors to get the n-1-dim versions.
- Allow multiindex derivative operators. Partially done with CovD[expr, CD[-a], PD[-b], ...]. Section on connections not updated.
- Rethink DependenciesOf. How is it possible that DependenciesOfTensor[delta] is simpler than DependenciesOfTensor[Basis] if they are the same object in principle?
- What about MakeRule and Dagger?
- ChangeCovD[expr, cd1, cd2] does not work if cd1 and cd2 are "direct-sum derivatives" and cd1 appears in expr with an index of a subvbundle. It is just a matter of changing some Q or pmQ functions by IndexOnQ because the latter sees subvbundles, but not the former. There is actually much redundancy between those functions.
- The simplification algorithms do not see Basis[{-1},a] and Basis[{-1},b] as two instances of the same vector.
- Tensors now depend on parameters, but covariant derivatives do not yet. This is related to the question of whether parametric derivatives commute with covariant derivatives (even ordinary covariant derivatives).
- Analyze why and when do we need pattern indices and which functions must act on them.
- Block abstract indices with a Block[Evaluate[Flatten@$AbstractIndices], expr] in $Pre. Be careful with C,D,K,N,O.
- Sort indices a11, a2, a$11, a$2, etc correctly. Most importantly, with priority "positional"/"antipositional".
- Patterns in MakeRule should be given both through PatternIndices or as actual pattern indices.
- Check consistency of dimensionality with the products of epsilons.
- Rethink the SortCovDs rules to see if they are valid for non-abstract indices.
- Do we need to define QFunctionQ[...]? The `Q functions are not recognized by Validate.
- Introduce epsilon tensors for the induced metrics.
- Perhaps MathinputExpand is too slow, because it uses FixedPoint.
- Add a definition of FirstDerQ for derivatives with multiple indices in Spinors, as suggested by Thomas.
- Bitensors can be imitated by declaring a tensor to depend on two different manifolds, assumed to be copies of each other. Every geometrical structured must be then duplicated. How can we automatize that idea, without having to duplicate everything by hand? In particular, Adam has pointed out that in xCoba this becomes odd, because Christoffels are generated complaining that they cannot communicate derivatives acting on different manifolds.

Not soon

- Introduce the idea of mapping between manifolds, including inmersions. We need the concept of vector on a trajectory (e.g. the fourvelocity of a particle, or equivalently the tangent to a line). This is related to the 1-dim manifold problem.
- Algorithm for trace decomposition of a tensor.
- Full compatibilization of Sort priorities and canonicalization
- Encode UserTypeDef
- Unify the different Contract* commands in a single structure. See notebook Contractions.nb for tests.
- Possibility of saving a session.
- Encode forms.
- Encode Grassmann variables.
- Inverses.
- We could generalize the concept of inert-head.

Questions

- Can we have a Christoffel between a derivative on a manifold M and a derivative on a submanifold of M?
- Is it possible to implement antilinear operators with abstract indices? It doesn't seem so.
- Is it possible to define constant tensors on the inner vbundle? Is it possible to define constant tensors (wrt to all derivatives) at all?

Comments

- Parameters are assumed to be real.
- Dagger[x y] is defined to be Dagger[x] Dagger[y]. In general Dagger[f[x,y]] is defined Dagger[f][Dagger[x],Dagger[y]].
- The antisymmetric product Wedge is half-developed.
- The idea of modified indices (IModQ) is half-developed.

0.1. GPL

(* xTensor, fast abstract tensor computer algebra *)

(* Copyright (C) 2002-2021 Jose M. Martin-Garcia *)

(* This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published
 by the Free Software Foundation; either version 2 of the License,
  or (at your option) any later version.

This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
 General Public License for more details.

You should have received a copy of the GNU General Public License
 along with this program; if not, write to the Free Software
 Foundation, Inc., 59 Temple Place-Suite 330, Boston, MA 02111-1307,
  USA. 
*)

0.2. Info package

(* :Title: xTensor *)

(* :Author: Jose M. Martin-Garcia *)

(* :Summary: Efficient abstract tensor computer algebra *)

(* :Brief Discussion:
   - Perform generic abstract tensor calculations.
   - Define manifolds, vector bundles, tensors, covariant derivatives and metrics.
   - Define symmetries as groups of permutations. Package xPerm.
   - Define Lie derivatives, Lie brackets and variational derivatives.
   - Define constant-symbols, parameters and parametric derivatives.
   - Simplifications: use Portugal's algorithms. Package xPerm.
   - Define bases and charts. Compute components. Package xCoba.
   - Define the concept of tensor equation and tensor rule.
*)
  
(* :Context: xAct`xTensor` *)

(* :Package Version: 1.2.0 *)

(* :Copyright: Jose M. Martin-Garcia (2002-2021) *)

(* :History: see xTensor.History file *)

(* :Keywords: *)

(* :Source: xTensor.nb *)

(* :Warning: *)

(* :Mathematica Version: 6.0 and later *)

(* :Limitations: Many. xTensor knows what its author knows! *)

Four leading rules:
	1. Mathematical structure
	2. Compliance with Mathematica's way of working
	3. Efficiency
	4. Simplicity of notations

Main design decisions:
	1. Mathematical tensor notation: Abstract indices formalism (see Penrose&Rindler, Wald, Ashtekar).
	2. Input/Output based on Mathematica symbols, not on strings. Strings give you more flexibility for notations, but you need to develop a syntactic parser, which obstructs the interaction of the user and the internals.
	3. Organization of the information: we shall define expressions denoting objects and functions. The definitions will be associated to the heads of the expressions, either as upvalues, ownvalues or downvalues. We do not include the properties of the objects as arguments in their expressions. Again, it is not possible to associate definitions to strings. This rule is relaxed in version 1.0, allowing non-atomic objects in some cases.
	4. Indexed objects will have the form name[indices]. We do not tag objects, due to several reasons:
		a) Expressions like Tensor[T, {A,-B}] are harder to input than T[-A,B]
		b) The limitation in depth for upvalues is greater for tagged objects.
		c) Even though it is possible to have Tensor[T, ...] and Spinor[T, ...], we cannot associated definitions consistently to symbol T.
		d) The internals should be simple enough so that the users can define new rules without having to use MakeRule and the like.
	5. Indices are represented in the simplest form I can think of (a for an up-index, -a for a down-index). Because there is no tagging for indices, we need to define what is an index: it is anything that can be found at positions in expressions reserved just for indices (index-slots). Currently they are
		a) tensor[indices]
		b) covd[index][ expr ] or the newer CovD[expr, ___, covd[index], ___]
		c) inerthead[ expr, ___, IndexList[ indices ], ___ ]
		d) product[ expr1, expr2, ... ]
This means that tensor indices cannot be mixed with other types of arguments in the same sequence. This is a strong rule. Note that we cannot combine all of them into a single structure. We have at least nonindexedhead[indices] and possiblyindexedhead[ indexedexpressions ]. We could try a mixture of
		A) possiblyindexedhead[ indices ] representing the elementary tensors
		B) possiblyindexedhead[ indexedexpressions ] representing the operators on all kinds of tensors
But the additional arguments of the inert-heads do not fit well here. They should have been in the head. Same thing happens with label indices.
	6. Control of evaluation: most functions in xTensor evaluate their arguments on input. This is what the user expects. However, there are exceptions with those functions that can be used to analyze or change the input: for instance FindIndices and ReplaceIndex.

0.3. BeginPackage

Protect against multiple loading of the package:

With[{xAct`xTensor`Private`xTensorSymbols=DeleteCases[Join[Names["xAct`xTensor`*"],Names["xAct`xTensor`Private`*"]],"$Version"|"xAct`xTensor`$Version"|"$xPermVersionExpected"|"xAct`xTensor`$xPermVersionExpected"|"xAct`xTensor`$ReadingVerbose"]},
Unprotect/@xAct`xTensor`Private`xTensorSymbols;
Clear/@xAct`xTensor`Private`xTensorSymbols;
];

Last package read in a session:

If[Unevaluated[xAct`xCore`Private`$LastPackage]===xAct`xCore`Private`$LastPackage,xAct`xCore`Private`$LastPackage="xAct`xTensor`"];

xAct`xCore`Private`$LastPackage

Fix for the conflict with Mathematica 9:

xAct`xTensor`Symmetrize;
Off[System`Symmetrize::shdw];

Explicit (not hidden) import of xCore,  xPerm and ExpressionManipulation (the latter is not automatically read from version 0.6.2 of xCore):

BeginPackage["xAct`xTensor`",{"xAct`xCore`","xAct`xPerm`"}]

Information on the link to xperm.c:

$xpermExecutable

$xpermLink

Check version of xPerm. We simply compare dates:

If[Not@OrderedQ@Map[Last,{$xPermVersionExpected,xAct`xPerm`$Version}],Throw@Message[General::versions,"xPerm",xAct`xPerm`$Version,$xPermVersionExpected]];

Message:

Print[xAct`xCore`Private`bars];
Print["Package xAct`xTensor`  version ",xAct`xTensor`$Version[[1]],", ",xAct`xTensor`$Version[[2]]];
Print["CopyRight (C) 2002-2021, Jose M. Martin-Garcia, under the General Public License."];

We specify the context xAct`xTensor` to avoid overriding the Disclaimer of xPerm and xCore. However we need to turn off the message General:shdw temporarily:

Off[General::shdw];
xAct`xTensor`Disclaimer[]:=Print["These are points 11 and 12 of the General Public License:\n\nBECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM `AS IS´ WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.\n\nIN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES."];
On[General::shdw];

If xTensor is the last package begin read, print the GPL message:

If[xAct`xCore`Private`$LastPackage==="xAct`xTensor`",
Unset[xAct`xCore`Private`$LastPackage];
Print[xAct`xCore`Private`bars];
Print["These packages come with ABSOLUTELY NO WARRANTY; for details type Disclaimer[]. This is free software, and you are welcome to redistribute it under certain conditions. See the General Public License for details."];
Print[xAct`xCore`Private`bars];
];

We already have these symbols in the xTensor` context:

?xAct`xTensor`*

0.4. Bases and charts. Relation with xCoba

Almost everything related to bases and charts should go into xCoba. However there are a few things that I want to treat here in xTensor, and this section is a description of them.

The single most important thing is the manipulation of basis-indices and component-indices (bc-indices in the following). These types of indices are considered in most sections of xTensor, but of course section 5 on notations and section 8 on formatting are the most important cases. I want to keep all those additional definitions for bc-indices in xTensor; otherwise half of the definitions on identifications and formatting would go into xTensor and the other half into xCoba, with a large risk of developing inconsistencies. Those parts of the code working with bc-indices in xTensor have been marked with the word BASIS. Currently there are two alternative notations for basis indices, denoted with BASIS1 and BASIS2 (mostly controlled through IMOD definitions). A second important issue is that of densities: most of it is included in xTensor: functions WeightOf, WeightOfTensor and metric determinants. However, the general concept of determinant and the eta tensors are in xCoba.

Functions in xTensor having influence on bases and charts:
	- BasisQ and ChartQ are the symbol-type identification functions. Associated global variables: $Bases and $Charts
	- BIndexQ, CIndexQ and BCIndexQ
	- CIndexForm, $CIndexForm
Functions in xCoba which are used in xTensor, but already with xAct`xCoba` context:
	- xAct`xCoba`VBundleOfBasis is used to find out the vbundle of c-indices
	- xAct`xCoba`CNumbersOf[basis] is used in CIndexQ
	- xAct`xCoba`BasisColor is used in the formatting routines
	- xAct`xCoba`DefBasis and xAct`xCoba`DefChart
	- xAct`xCoba`UndefBasis and xAct`xCoba`UndefChart are called by Undef
	- xAct`xCoba`DaggerCIndex
	- xAct`xCoba`Private`DaggerBIndex
	- xAct`xCoba`DependenciesOfBasis
	- xAct`xCoba`PDOfBasis
	- xAct`xCoba`BasisOfCovD
	- xAct`xCoba`Coordinate is used by CIndexForm

We declare the symbols here:

xAct`xCoba`DefBasis;
xAct`xCoba`UndefBasis;
xAct`xCoba`DefChart;
xAct`xCoba`UndefChart;
xAct`xCoba`DependenciesOfBasis;
xAct`xCoba`DaggerCIndex;
xAct`xCoba`Private`DaggerBIndex;
xAct`xCoba`VBundleOfBasis;
xAct`xCoba`CNumbersOf;
xAct`xCoba`Coordinate;
xAct`xCoba`BasisColor;
xAct`xCoba`PDOfBasis;

0.5. Bad decisions in xTensor. Too late to change them

xTensor, and actually most of xAct, has grown organically, as my own needs first and then the needs of other authors required. Some decisions were originally made without taking into account future extensions, and have been later found to be inconvenient. But now they are too deeply ingrained in the system, and would be too much work for me (and too much hassle for the users) to change them, at least in many cases. Here there is a list of the main things, in order of importance:

	1) The CD[-a][ expr ] notation for covariant derivatives is inconvenient in output. This has been partially alleviated by TensorDerivative, but the former remains as the standard.
	
	2) The asymmetry between the syntax of upper and lower indices.
	
	3) We are too restrictive asking for objects being symbols. This is being progressively relaxed, and it is not true anymore for the two main types: Tensor and CovD.
	
	4) Label indices are absurd. Their information should have been in the tensor head.
	
	5) There is no indexed zero tensor, and so rank information is lost during some computations. We have recently added Zero, but we only use it in internal computations.
	
	6) We assign to vbundles properties that are really of their fibers (vspaces), like dimension.

1. Usage messages

(**********************************************************************)
(******************* 1. Symbols, names and messages *******************)
(**********************************************************************)

{TimeUsed[],SessionTime[],TimeUsed[]/SessionTime[]}

1.0. Comments

If[$ReadingVerbose,Print["Reading section 1: Usage messages."],Null,Null]

This section simply decides which functions are public and which are not. The usage messages of private functions are not included in the package.

1.1. Usage of functions. Public

1.1.0. Info and copyright

(* Versions and GPL disclaimer *)
xAct`xTensor`$Version::usage="$Version is a global variable giving the version of the package xTensor in use.";
xAct`xTensor`$xPermVersionExpected="$xPermVersionExpected is a global variable giving the oldest possible version of the package xPerm which is required by the version of the package xTensor in use.";
xAct`xTensor`Disclaimer::usage="Disclaimer[] gives the General Public License (GPL) disclaimer message.";

(* Verbose while reading the package? *)
xAct`xTensor`$ReadingVerbose::usage="$ReadingVerbose is a Boolean global variable that turns on log-messages while the xTensor package is being read. By default it is not set.";

1.1.2. Types. Conventions and signs

(* Generic options in Def commands *)
$ProtectNewSymbols::usage="$ProtectNewSymbols is a Boolean global variable specifying the default value for the option ProtectNewSymbol of all DefType commands. The default initial value is False.";
ProtectNewSymbol::usage="ProtectNewSymbol is a Boolean option for all DefType commands that specifies whether the defined symbol will be protected or not. The default value is given by the global variable $ProtectNewSymbols.";
DefInfo::usage="DefInfo is an option for all DefType commands specifying an additional message to output at definition time. DefInfo[x] returns the DefInfo image associated with x at definition time.";
$DefInfoQ::usage="$DefInfoQ is a boolean global variable controlling whether the info definition messages are printed. By default it is True, but setting it to False deactivates all Def messages.";
$UndefInfoQ::usage="$UndefInfoQ is a boolean global variable controlling whether the info undefinition messages are printed. By default it is True, but setting it to False deactivates all Undef messages.";

(* Formatting of objects *)
xTensorFormStart::usage="xTensorFormStart[class] starts formatting for a class of objects. Valid classes are: ConstantSymbol, Parameter, InertHead, Tensor, CovD, LieD. xTensorFormStart[] starts formatting for all those classes.";
xTensorFormStop::usage="xTensorFormStop[class] stops formatting for a class of objects. Valid classes are: ConstantSymbol, Parameter, InertHead, Tensor, CovD, LieD. xTensorFormStop[] stops formatting for all those classes.";
PrintAs::usage="PrintAs[symbol] gives the output string or boxes for symbol in StandardForm.\n\nPrintAs is also an option for the DefType commands that specifies the output form of a defined symbol. It can be PrintAs -> string or PrintAs -> boxes. If boxes are to be constructed in a delayed way then use PrintAs -> Hold[delayedboxes]. Finally it can also be PrintAs -> function, such that the output will be ToString[function[symbol]].";
PrintAsCharacter::usage="PrintAsCharacter[symbol] returns a character to be used in the typesetting of fundamental objects in xTensor. For example \"R\" for Riemann, \"G\" for Einstein, etc.";

(* Relations among symbols *)
VisitorsOf::usage="VisitorsOf[symbol] gives the list of all symbols which require symbol to exist before they can be defined. symbol can only be removed if this list is empty.";
HostsOf::usage="HostsOf[symbol] gives the list of symbols which are required to exist previously, before symbol was defined, and which cannot be undefined as long as symbol exists.";
MasterOf::usage="MasterOf[servant] gives the master symbol of the symbol servant. The latter is defined and removed when, and only when, the former is defined and removed, respectively.";
ServantsOf::usage="ServantsOf[symbol] gives the list of symbols which have been simultaneously defined with symbol. They will be removed when, and only when, symbol is removed.";
Master::usage="Master is an option for DefType commands specifying the master symbol of the defined symbol. By default, no master is associated.";

(* Reserved words for types *)
AbstractIndex::usage="AbstractIndex represents the type for symbols denoting abstract indices of a vector bundle.";
Manifold::usage="Manifold represents the type for smooth, differentiable manifolds.";
Mapping::usage="Mapping represents the type for smooth mappings between manifolds.";
VBundle::usage="VBundle represents the type for smooth, differentiable vector bundles.";
Tensor::usage="Tensor represents the type for smooth tensor fields in the product of several vector bundles.";
Metric::usage="Metric represents the type for smooth metric tensor fields on a vector bundle.";
CovD::usage="CovD represents the type for smooth connections living on some manifold.";
InertHead::usage="InertHead represents the type for tensor wrappers of tensors.";
ScalarFunction::usage="ScalarFunction represents the type for scalar functions.";
ConstantSymbol::usage="ConstantSymbol represents the type for constant symbols.";
Parameter::usage="Parameter represents the type for parameter symbols.";
Basis::usage="Basis represents both the type and the tensor head for a basis vector/covector field.";
Chart::usage="Chart represents the type for smooth coordinate charts on manifolds.";

(* Data-bases *)
$AbstractIndices::usage="$AbstractIndices is a global variables storing the list of all currently defined abstract indices, including those internally generated.";
$ConstantSymbols::usage="$ConstantSymbols is a global variable storing the list of all currently defined constant symbols.";
$Tensors::usage="$Tensors is a global variable storing the list of all currently defined tensors.";
$CovDs::usage="$CovDs is a global variable storing the list of all currently defined covariant derivatives, including the fiducial partial derivative PD.";
$Manifolds::usage="$Manifolds is a global variable storing the list of all currently defined manifolds.";
$Mappings::usage="$Mappings is a global variable storing the list of all currently defined mappings.";
$VBundles::usage="$VBundles is a global variable storing the list of all currently defined vector bundles.";
$ProductManifolds::usage="$ProductManifolds is a global variable storing the list of all currently defined product manifolds. It is a subset of $Manifolds.";
$SumVBundles::usage="$SumVBundles is a global variable storing the list of all currently defined direct-sum vector bundles. It is a subset of $VBundles.";
$Metrics::usage="$Metrics is a global variable storing the list of all currently defined metrics. It is a subset of $Tensors.";
$ProductMetrics::usage="$ProductMetrics is a global variable storing the list of all currently defined product metrics. It is a subset of $Metrics.";
$InertHeads::usage="$InertHeads is a global variable storing the list of all currently defined inert heads of indexed expressions.";
$ScalarFunctions::usage="$ScalarFunctions is a global variable storing the list of all currently defined functions acting on scalars.";
$Rules::usage="$Rules is a global variable storing the list of all rules registered as global rules.";
$Bases::usage="$Bases is a global variable containing the list of all symbols registered as bases (not necessarily coordinate bases) on the bundles in $VBundles.";
$Charts::usage="$Charts is a global variable containing the list of all symbols registered as charts on the manifolds in $Manifolds. It is a subset of $Bases.";
$Parameters::usage="$Parameters is a global variable storing the list of all currently defined parameters.";
$Products::usage="$Products is a global variable storing the list of all currently defined products.";

(* Collecting function *)
FindAllOfType::usage="FindAllOfType[expr, type] gives the list of all occurrences of elements of the given type in expr, including their indices for types like Tensor, CovD, etc.";

(* Undefinition *)
Undef::usage="Undef[symbol] undefines the symbol, whatever its type may be. The only exception are abstract indices.";

(* Name validation in session *)
ValidateSymbolInSession::usage="ValidateSymbolInSession[symbol] throws an error if symbol is already used in this session as a constant-symbol, parameter, manifold, vector bundle, abstract index, tensor (or metric), form, covariant derivative, basis (or chart), inert head or scalar function. Otherwise it gives Null.";

(* Q-functions on symbols *)
AbstractIndexQ::usage="AbstractIndexQ[symbol] gives True if symbol has been registered as an abstract index. Note that it gives False on down-indices.";
ConstantSymbolQ::usage="ConstantSymbolQ[symbol] gives True if symbol has been registered as a constant symbol, and False otherwise.";
ManifoldQ::usage="ManifoldQ[expr] gives True if expr has been registered as a manifold, and False otherwise.";
MappingQ::usage="MappingQ[symbol] gives True if symbol has been registered as a mapping, and False otherwise.";
VBundleQ::usage="VBundleQ[symbol] gives True if symbol has been registered as a vector bundle, and False otherwise.";
ParameterQ::usage="ParameterQ[symbol] gives True if symbol has been registered as a parameter and False otherwise.";
xTensorQ::usage="xTensorQ[expr] gives True if expr has been registered as a tensor, and False otherwise. Do not confuse with Mathematica's TensorQ.";
CovDQ::usage="CovDQ[expr] gives True if expr has been registered as a covariant derivative operator, and False otherwise.";
MetricQ::usage="MetricQ[expr] gives True if expr has been registered as a metric, and False otherwise.";
BasisQ::usage="BasisQ[symbol] gives True if symbol has been registered as a basis or chart, and False otherwise. BasisQ[basis, vbundle] gives True if basis is one of the bases of the vector bundle vbundle, and False otherwise.";
ChartQ::usage="ChartQ[symbol] gives True if symbol has been registered as a chart, and False otherwise. ChartQ[chart, manifold] gives True if chart is one of the charts of manifold, and False otherwise.";
InertHeadQ::usage="InertHeadQ[head] gives True if head[object] must be treated as object form the point of view of symmetries and canonicalization in xTensor, and False otherwise.";
ScalarFunctionQ::usage="ScalarFunctionQ[f] gives True if f has been defined as a mathematical function acting on scalars, or a derivative of one of those, and False otherwise.";
ProductQ::usage="ProductQ[symbol] gives True if symbol has been registered as a product on indexed objects.";

(* Q-functions on other expressions *)
FirstDerQ::usage="FirstDerQ[expr] gives True if expr is of the form covd[i], LieD[v], ParamD[par] or OverDot, or False otherwise. In particular it gives False on multiple (nested) derivatives like ParamD[par1, par2].";
UpVectorQ::usage="UpVectorQ[expr] gives True if expr has only one free up-index, and False otherwise. UpVectorQ[expr, vbundle] gives True if also the free index of expr belongs to the vector bundle vbundle.";
DownVectorQ::usage="DownVectorQ[expr] gives True if expr has only one free down-index, and False otherwise. DownVectorQ[expr, vbundle] gives True if also the free index of expr belongs to the vector bundle vbundle.";
ConstantQ::usage="ConstantQ[x] gives True if x is a number or a numeric symbol or a constant symbol. Otherwise it gives False.";

(* Inert heads *)
DefInertHead::usage="DefInertHead[head] defines an inert head such that head[expr] is treated as expr from the tensorial point of view.";
UndefInertHead::usage="UndefInertHead[head] undefines the inert head.";
LinearQ::usage="LinearQ is a Boolean option for DefInertHead and DefProduct stating that the symbol defined is linear with respect to constants in its tensorial argument(s). The default value is False.\n\nLinearQ[head] gives True if head has been defined as a linear inert-head or product, and False otherwise.";
ContractThrough::usage="ContractThrough is an option for DefInertHead specifying a list of metrics and/or the delta tensor which can be contracted through the defined inert-head.";
ContractThroughQ::usage="ContractThroughQ[head, metric] says whether the given metric can be contracted through the inert head. The default value is False.";
ERROR::usage="ERROR[expr] is an expression where an error has been detected. ERROR is an inert head with a single argument.";
Keep::usage="Keep[expr] represents the tensorial expression expr, but prevents its expansion under the action of other functions.";
DependenciesOfInertHead::usage="DependenciesOfInertHead[ih] returns the implicit dependencies (manifols and/or parameters) of the inert head ih.";

(* Complex conjugation *)
Dagger::usage="Dagger[expr] returns the complex conjugate of an expression. Dagger is an inert head. Use DaggerIndex on indices.\n\nDagger is also an option for several DefType commands, specifying how they behave under complex conjugation: possible values are Real, Imaginary, Complex, Hermitian and Antihermitian, the latter two only applying to tensors.";
DaggerIndex::usage="DaggerIndex[ind] returns the conjugated index to ind. DaggerIndex[IndexList[i1, ..., in]] returns the list (also with head IndexList) of respective conjugated indices. Label indices are considered real by default.";
DaggerQ::usage="DaggerQ[expr] gives True if expr is complex (Dagger[expr] different from expr) and False otherwise.";
TransposeDagger::usage="TransposeDagger[tensor[inds]] exchange the positions of the complex conjugated indices following this rule: the n-th index of the complex vbundle C is exchanged with the n-th index of the vbundle Dagger[C]. If the number of indices in tensor belonging to C and Dagger[C] is not the same, an error is thrown. There is no conjugation in this process, simply swapping of indices. TransposeDagger[tensor[inds], vbs] only transposes indices of vbs (a vbundle or a list of them).";
Pair::usage="Pair[A, B†] represents a conjugated pair of indices on conjugated vbundles.";
Imaginary::usage="Imaginary is a possible value for the option Dagger.";
Hermitian::usage="Hermitian is a possible value for the option Dagger of DefTensor.";
Antihermitian::usage="Antihermitian is a possible value for the option Dagger of DefTensor.";
HermitianQ::usage="HermitianQ[tensor] gives True if tensor is a complex Hermitian tensor, and False otherwise. In particular, this function returns False on real tensors.";
AntihermitianQ::usage="AntihermitianQ[tensor] gives True if tensor is a complex antihermitian tensor, and False otherwise.";

(* Scalar functions *) 
DefScalarFunction::usage="DefScalarFunction[f] defines f to be a scalar function of one or several scalar arguments.";
UndefScalarFunction::usage="UndefScalarFunction[f] undefines the scalar function f.";

(* Parameters *)
DefParameter::usage="DefParameter[t] defines t to be a real parameter on which indexed objects can depend.";
UndefParameter::usage="UndefParameter[t] undefines the parameter t.";

(* Scalars *)
ScalarQ::usage="ScalarQ[expr] gives true if expr is a scalar, that is, it has no free index.";
Scalar::usage="Scalar[expr] denotes that expr is a scalar (no free indices) expression. The expression is simplified as much as possible extracting scalars and constants.";
$SeparateScalarsFromScalar::usage="$SeparateScalarsFromScalar is a global variable specifying whether Scalar[x] should be converted into x for a non-indexed scalar x.";
$ScalarColor::usage="$ScalarColor is a global variable specifying the color of the parentheses surrounding the formatting of a Scalar expression.";

(* Products *)
DefProduct::usage="DefProduct[prod, pbs, pos] defines prod to be an algebra product of indexed objects, in which pos is the product of scalars and pbs is the product of scalars by elements of the algebra. The second and third arguments may be omitted, both having default value Times.";
UndefProduct::usage="UndefProduct[prod] undefines the product prod.";
AssociativeProductQ::usage="AssociativeProductQ[prod] gives whether the product prod is associative or not.\n\nAssociativeProductQ is also a boolean option of DefProduct, specifying whether the product being defined is associative. Its default value is True.";
GradedProductQ::usage="GradedProductQ[prod] says whether the algebra associated to the product prod is graded or not. If it is, grades are computed using Grade[expr, prod].\n\nGradedProductQ is also a boolean option of DefProduct, specifying whether the product being defined is graded or not. Its default value is False.";
CommutativityOfProduct::usage="CommutativityOfProduct[prod] describes the symmetry of the product prod. It can be \"Commutative\", \"Anticommutative\", \"SuperCommutative\", \"SuperAnticommutative\" or None. It can also be a function f of two arguments returning the sign under exchange of any two consecutive factors.\n\nCommutativityOfProduct is also an option of DefProduct, specifying the symmetry of the product being defined. Its default value is None.";
IdentityElementOfProduct::usage="IdentityElementOfProduct[prod] returns the neutral element of the product prod.\n\nIdentityElementOfProduct is also an option of DefProduct, specifying the neutral element of the product being defined. Its default value is None.";
ScalarsOfProduct::usage="ScalarsOfProduct[prod] returns a function that gives True on the scalars of the product algebra prod, and gives False otherwise.\n\nScalarsOfProduct is also an option of DefProduct, specifying that function at definition time. Its default value is NumericQ.";
ProductByScalar::usage="ProductByScalar[prod] returns the product used to multiply elements of the algebra by scalars of the algebra defined by the product prod. The result may be the product pbs or {Left, pbs} or {Right, pbs} depending on whether pbs is orderless or must be used as pbs[scalar, x] or pbs[x, scalar], respectively.";
ProductOfScalars::usage="ProductOfScalars[prod] returns the product used to multiply scalars of the the product algebra defined by the product prod.";
DefineCommutator::usage="DefineCommutator is a boolean option of DefProduct, specifying whether the the associated product Commutator[prod] must be defined together with the product prod being defined. Its default value is False.";
Commutator::usage="Commutator[prod][a, b] represents the commutator associated to the product prod, that is prod[a, b] - prod[b, a]. Commutator[prod] is an Anticommutative product. If prod is associative then Commutator[prod] obeys the Jacobi identity and defines a Lie algebra.";
Anticommutator::usage="Anticommutator[prod][a, b] represents the anticommutator associated to the product prod, that is prod[a, b] + prod[b, a]. Commutator[prod] is a Commutative product.";
Supercommutator::usage="Supercommutator[prod][a, b] represents the supercommutator associated to the product prod, that is prod[a, b] - (-1)^(|a|·|b|) prod[b, a], where |a| is the grade of a. Supercommutator[prod] is a SuperAnticommutative product. If prod is associative then Supercommutator[prod] obeys a graded Jacobi identity and defines a graded Lie algebra.";
ExpandCommutator::usage="ExpandCommutator[expr] expands all commutators, anticommutators, and supercommutators to their underlying base products.";
Grade::usage="Grade[expr, prod] returns the grade of the expression expr with respect to the product prod.";
GradeOfTensor::usage="GradeOfTensor[T, prod] gives the grade of the tensor T in the product prod.\n\nGradeOfTensor is also an option of DefTensor specifying the grade of the tensor being defined in various products, as in GradeOfTensor->{wedge->1, clifford->2}.";
GradeOfCovD::usage="GradeOfCovD[cd, prod] gives the grade of the covariant derivative cd in the product prod.";
GradeOfProduct::usage="GradeOfProduct[prod, prod2] returns the grade with respect to product prod2 added by the presence of a product prod of expressions.\n\nGradeOfProduct is also an option of DefProduct, specifying that the value of GradeOfProduct[prod, prod] when the product prod is defined.";
xSortOrder::usage="xSortOrder is an option of DefProduct specifying an Order-like function used to sort the factors of the product being defined. Its default value is Automatic, which represents the standard ordering used by the Times product in xTensor.";

(* Conventions and signs *)
$epsilonSign::usage="$epsilonSign is a global sign giving the default value for the function epsilonOrientation. This variable is kept for backward compatibility.";
$RiemannSign::usage="$RiemannSign defines the global sign of the Riemann tensor from derivatives of a connection: Riemann[-a,-b,-c,d] = $RiemannSign * ( PD[-b][Christoffel[d,-a,-c] + ...)";
$RicciSign::usage="$RicciSign defines the global sign of the Ricci tensor from contraction of the Riemann tensor: Ricci[-a,-b] = $RicciSign * Riemann[-a,-c,-b,c]";
$TorsionSign::usage="$TorsionSign defines the global sign of the torsion tensor of a covariant derivative: cd[-a]@cd[-b]@f[] - cd[-b]@cd[-a]@f[] = - $TorsionSign Torsioncd[c,-a,-b] cd[-c]@f[].";
$ExtrinsicKSign::usage="$ExtrinsicKSign defines the global sign of the extrisic curvature tensor in terms of the derivative of a vector field: ExtrinsicK[-a,-b] = $ExtrinsicKSign Projector[ cd[-a][ n[-b] ] ].";
$AccelerationSign::usage="$AccelerationSign defines the global sign of the acceleration vector in terms of the derivative of a vector field: Acceleration[-a] = $AccelerationSign n[b] cd[-b][ n[-a] ] / norm.";

(* Creating names *)
GiveSymbol::usage="GiveSymbol[object, case] constructs a symbol for the required object in the special given case. Both must be symbols or strings.";
GiveOutputString::usage="GiveOutputString[object, case] gives the string to be used as output in StandardForm. Both object and case must be symbols or strings.";

1.1.3. G-Indices

(* Types of g-indices. BASIS1. BASIS2 is not yet documented *)
DefAbstractIndex::usage="DefAbstractIndex[symbol] defines symbol to be an abstract index without associating it to a vector bundle yet.";
UndefAbstractIndex::usage="UndefAbstractIndex[index] undefines index, making it unusable.";
GIndexQ::usage="GIndexQ[x] gives True if x is a valid generalized index (an abstract index, a label index, a valid basis index, or a valid direction). Patterns are not accepted. Otherwise it gives False. GIndexQ[x, vbundle] gives True if x is a valid generalized index belonging to the vector bundle vbundle.";
AIndexQ::usage="AIndexQ[x] gives True if x is recognized as a valid abstract index, and False otherwise. AIndexQ[x, vbundle] gives True if x is a valid abstract index belonging to the vector bundle vbundle.";
BIndexQ::usage="BIndexQ[x] gives True if x is a valid basis index: {i, basis}, where i is an abstract index. BIndexQ[x, basis] gives True if x is a valid basis index belonging to basis. BIndexQ[x, vbundle] gives True if x is a valid basis index belonging to the vector bundle vbundle.";
CIndexQ::usage="CIndexQ[x] gives True if x is a valid component index: {i, basis}, where i is an integer cnumber compatible with basis. CIndexQ[x, basis] gives True if x is a valid component index belonging to basis. CIndexQ[x, vbundle] gives True if x is a valid component index belonging to some basis of the vector bundle vbundle.";
DIndexQ::usage="DIndexQ[x] gives True if x is a valid directional index of the form Dir[v], where v is a covariant or contravariant vector. DIndexQ[x, vbundle] gives True if x is a valid directional index belonging to the vector bundle vbundle.";
LIndexQ::usage="LIndexQ[x] gives True if x is a label (an expression with head LI, perhaps multiplied by -1), and False otherwise.";
PIndexQ::usage="PIndexQ[ind] gives True if ind is a valid pattern for an index: _, _h, a_h, a_h?Q where a must be a valid abstract index and h must be one of Symbol, Dir, LI, List, Blank, Pattern, PatternTest. Other kinds of pattern, in particular Condition, are not accepted.";
ABIndexQ::usage="ABIndexQ[x] gives True if x is an ABIndex (abstract index or basis index) and False otherwise. ABIndexQ[x, basis] gives True if x is an ABIndex belonging to basis and False otherwise. ABIndexQ[x, vbundle] gives True if x is an ABIndex belonging to the vector bundle vbundle and False otherwise.";
BCIndexQ::usage="BCIndexQ[x] gives True if x is a BCIndex (basis index or component index), and False otherwise. BCIndexQ[x, basis] gives True if x is a BCIndex belonging to basis and False otherwise. BCIndexQ[x, vbundle] gives True if x is an BCIndex belonging to the vector bundle vbundle and False otherwise.";
CDIndexQ::usage="CDIndexQ[x] gives True if x is a CDIndex (component index or directional index), and False otherwise. CDIndexQ[x, basis] gives True if x is a CDIndex belonging to basis and False otherwise. CDIndexQ[x, vbundle] gives True if x is an CDIndex belonging to the vector bundle vbundle and False otherwise.";
Dir::usage="Dir[v] is a directional index in any tensorial slot. Its single argument v is assumed to be a vector or a covector.";
LI::usage="LI is the head for label indices.";
Labels::usage="Labels is the \"vector bundle\" to which all labels belong.";
UpIndex::usage="UpIndex[ind] converts ind into an up-index: On expressions of the form -expr it returns expr. On basis- and component-indices UpIndex[{1, basis}] and UpIndex[{1, -basis}] return {1, basis}. On directions Dir[...] the function UpIndex returns a covector. On other cases it returns the input expr.";DownIndex::usage="DownIndex[ind] converts ind into a down-index, returning opposite results to UpIndex.";
ChangeIndex::usage="ChangeIndex[ind] converts up-indices to down-indices and viceversa.";
UpIndexQ::usage="UpIndexQ[a] gives True if a is an upper index and False otherwise. It gives False on patterns.";
DownIndexQ::usage="DownIndexQ[a] gives True if a is a lower index and False otherwise. It gives False on patterns.";
EIndexQ::usage="EIndexQ[ind] identifies indices which can obey the Einstein convention, returning opposite results to BlockedQ. We call them Einstein, contractible or traceable indices.";
BlockedQ::usage="BlockedQ[ind] returns True on blocked indices: types C, D and L. On other cases (traceable indices) it returns False, including indices of types A, B and patterns.";
PairQ::usage="PairQ[a, b] returns True if indices a, b form an Einstein pair of contracted indices. Currently this is only possible for a pair a, -a of abstract indices or a pair {a, B}, {-a,-B} of basis indices of the same basis B.";
IndexList::usage="IndexList[i1, i2, ...] is a list of g-indices.";
$IndexListColor::usage="$IndexListColor is a global variable specifying the color to format the braces of IndexList expressions in StandardForm. The default color is blue, RGBColor[0,0,1].";
PatternIndex::usage="PatternIndex[name, type] constructs a pattern index for the given type (AIndex, DIndex or LIndex), with the given name. PatternIndex[name, type, character] also specifies the given character (Up or Down). PatternIndex[name, type, character, vbundle] restricts the pattern to the vector bundle vbundle (use character Null when accepting both Up and Down).";
AIndex::usage="AIndex represents the logic type for abstract indices. It also represents the abstract basis corresponding to abstract indices.";
BIndex::usage="BIndex represents the logic type for basis indices.";
CIndex::usage="CIndex represents the logic type for component indices.";
DIndex::usage="DIndex represents the logic type for directional indices.";
LIndex::usage="LIndex represents the logic type for label indices.";
PIndex::usage="PIndex represents the logic type for pattern indices.";
Off[General::shdw];
xAct`xTensor`Up::usage="Up represents the logic type for up-indices.";
xAct`xTensor`Down::usage="Down represents the logic type for down-indices.";
On[General::shdw];
Free::usage="Free represents the logic type for free indices.";
Dummy::usage="Dummy represents the logic type for dummy indices.";
Blocked::usage="Blocked represents the logic type for blocked indices (components, directions and labels).";
IModQ::usage="IModQ[expr] returns True if expr is a valid index-modifier, and False otherwise.";

(* Sorting g-indices *)
IndexSort::usage="IndexSort[list] sorts the elements of list (assumed to be g-indices) according to three priorities set up by SetIndexSortPriorities. Currently: ";
IndexOrderedQ::usage="IndexOrderedQ[{i1, i2, ...}] gives True if the list of g-indices is sorted according to IndexSort and False otherwise.";
DisorderedPairQ::usage="DisorderedPairQ[i1, i2] gives True if the list of indices {i1, i2} is not in canonical order according to IndexSort, and False otherwise.";
SetIndexSortPriorities::usage="SetIndexSortPriorities[p1, p2, p3] sets the three priorities for g-index sorting. The pi are strings among these: priorities p1 and p2 are chosen from two of the pairs `up´/`down´ and `free´/`dummy´. Priority 3 can be chosen from one of the pairs `lexicographic´/`antilexicographic´ and `positional´/`antipositional´.";

(* Finding indices *)
FindIndices::usage="FindIndices[expr] returns an IndexList with the (order kept) union of all-gindices of expr. Indices in directional arguments, Scalar expressions or scalar-functions are not found. FindIndices has attribute HoldFirst, and hence requires very often the use of Evaluate.";
AnyIndices::usage="AnyIndices is an internal symbol of xTensor returned by the expression FindIndices[0]. AnyIndices[vbundle] also represents an arbitrary sequence of abstract indices in the given vbundle.";
$FindIndicesAcceptedHeads::usage="$FindIndicesAcceptedHeas is a global variable giving the list of heads for which FindIndices does not complain and continues looking for indexed objects inside. It is initialized to {Hold}.";
FindFreeIndices::usage="FindFreeIndices[expr] gives an IndexList with the (order not kept) free indices of expr, throwing an error if they are not homogeneous in all terms of expr. FindFreeIndices[expr, selector] uses SelectIndices on FindFreeIndices[expr] with the given selector. FindFreeIndices has attribute HoldFirst, and hence requires very often the use of Evaluate.";
FindDummyIndices::usage="FindDummyIndices[expr] gives an IndexList with the (up-) indices wich are contracted in expr. FindDummyIndices[expr, selector] uses SelectIndices on FindDummyIndices[expr] with the given selector. FindDummyIndices has attribute HoldFirst, and hence requires very often the use of Evaluate.";
FindBlockedIndices::usage="FindBlockedIndices[expr] gives an IndexList with the (order not kept) blocked indices of expr. FindBlockedIndices[expr, selector] uses SelectIndices on FindBlockedIndices[expr] with the given selector. FindBlockedIndices has attribute HoldFirst, and hence requires very often the use of Evaluate.";
IsIndexOf::usage="IsIndexOf[object, index] gives True if (Verbatim) index is one of the indices of object, and False otherwise. IsIndexOf[object, index, tensor] gives IndexOf[object, index] unless object is an inert head expression with head IH; in that case there is the further check ContractThroughQ[IH, tensor].";
IndicesOf::usage="IndicesOf[selectors][expr] returns a list (head IndexList) of the indices in expression selected by the given selectors. Different selectors are applied succesively from left to right. Possible selectors are Free, Dummy, Blocked, Up, Down, AIndex, BIndex, CIndex, DIndex, LIndex, or a manifold, a vbundle, a basis, a tensor (including Basis), or a covd.";

(* Replacing indices *)
ReplaceIndex::usage="ReplaceIndex[expr, rule] replaces indices of objects in expr as given by rule (a single rule or a list of rules of the form i1->i2). Note that the rules a->b and -a->-b are independent and both must be given if this is what we want. ReplaceIndex[expr, {{rule1, ...}, {rule2, ...}, ...}] is automatically threaded, giving a list of expressions.";
ReplaceDummies::usage="ReplaceDummies[expr] replaces dummy indices in expr by new (dollar-) dummy indices. ReplaceDummies[expr, inds] chooses new indices from inds before starting generation of new indices.";
SameDummies::usage="SameDummies[expr] returns expr minimizing the number of different dummies used among the summands of the expr. No new dummy is introduced.";
$ComputeNewDummies::usage="$ComputeNewDummies is a global Boolean variable which specifies whether new (dollar-) indices must be generated during the action of ReplaceDummies.";
SplitIndex::usage="SplitIndex[expr, splitrules] returns an array whose elements are expr with certain indices replaced as given by the splitrules. A split-rule must be of the form index -> Indexlist[i1, i2, ...], meaning that index is to be replaced by i1, i2, ... respectively in each of the terms of the array. It is possible to give a list of splitrules or a compacted form IndexList[index1, index2, ...] -> IndexList[i1 ,i2, ...], where each of the indices indexi is to be splitted as IndexList[i1, i2, ...].";
TraceDummy::usage="TraceDummy[expr, trules] traces dummy indices in expr as given by the trace-rules trules. These are rules of the form index -> IndexList[i1, i2, ...], where index can be a pattern.";
$TraceDummyVerbose::usage="$TraceDummyVerbose is a global Boolean variable turning on and off log messages from the command TraceDummy.";

(* Formatting indices *)
IndexForm::usage="IndexForm[index] returns the string which will be used to format the generalized index (assumed not to have a minus sign in front). By default, abstract indices are simply converted into a string, basis and component indices are colored according to the basis they belong to, directional indices are converted into the name of the vector or into \"#\" when they are composite expressions, and patterns are underlined. (Component indices are dealt with through the associated function CIndexForm.) If changed, IndexForm must be manipulated with great care.";
$CIndexForm::usage="$CIndexForm is a Boolean global variable. If True the coordinate indices are represented in tensor slots as the name of the associated coordinate. If False (the default) no such replacemente is performed.";
CIndexForm::usage="CIndexForm[cnumber, chart] returns the string to be used to represent the coordinate index {cnumber, chart} in a tensor slot.";
PrimeDagger::usage="PrimeDagger[ind] for a daggered index ind returns the formatting of the index replacing the dagger by a prime.";

1.1.4. Manifolds, mappings and vector bundles

(* Manifolds *)
IndexRange::usage="IndexRange[a, p] and IndexRange[{a, p}] return the list of symbols between symbols a and p (using CharacterRange internally). IndexRange[{a1, p1}, {a2, p2}, ...] returns the union (using Union, and hence sorted) of the ranges defined by the given pairs of indices.";
DefManifold::usage="DefManifold[M, dim, {a, b, c,...}] defines M to be an n-dimensional differentiable manifold with dimension dim (a positive integer or a constant symbol) and tensor abstract indices a, b, c, ... .  DefManifold[M, {M1, ..., Mm}, {a, b, c,...}] defines M to be the product manifold of previously defined manifolds M1 ... Mm. For backward compatibility dim can be a list of positive integers, whose length is interpreted as the dimension of the defined manifold.";
UndefManifold::usage="UndefManifold[manifold] undefines manifold.";
DimOfManifold::usage="DimOfManifold[M] yields the dimension of manifold M.";

(* Cartesian products *)
CartesianProduct::usage="CartesianProduct[O1, O2, ...] represents the Cartesian product of the objects Oi.";

(* Manifold splitting *)
SplitManifold::usage="SplitManifold[M, {m1, ..., mn}] identifies the manifold M as the (external) Cartesian product of the manifolds mi. Both the M manifold and the mi manifolds are assumed to exist already. The dimension of M must coincide with the sum of the dimensions of the mi manifolds.";
SplittingsOfManifold::usage="SplittingsOfManifold[M] returns a list of known CartesianProduct splittings of the manifold M.";
SubmanifoldsOfManifold::usage="SubmanifoldsOfManifold has been removed from xTensor in version 1.1.0. Please use SplittingsOfManifold for similar functionality.";
SubmanifoldQ::usage="SubmanifoldQ[large, small] gives True if manifold small is contained in or equal to manifold large, and False otherwise.";
DisjointManifoldsQ::usage="DisjointManifoldsQ[manifolds1, manifolds2] gives True if none of the manifolds of the list manifolds1 is a submanifold or a supermanifold of the manifolds of the list manifolds2, and False otherwise.";
DisjointVBundlesQ::usage="DisjointVBundlesQ[vbundles1, vbundles2] gives True if none of the vbundles of the list vbundles1 is a subvbundle or a supervbundle of the vbundles of the list vbundles2, and False otherwise.";

(* Dependencies *)
DependenciesOf::usage="DependenciesOf[expr] gives the list of manifolds and parameters upon which expr depends.";
ManifoldsOf::usage="ManifoldsOf[expr] gives the list of manifolds on which expr lives.";
ParametersOf::usage="ParametersOf[expr] gives the list of parameters on which expr depends.";
AnyDependencies::usage="AnyDependencies is an internal symbol of xTensor returned by DependenciesOf acting on an unknown expression (unregistered symbols, patterns, etc.).";
OtherDependencies::usage="OtherDependencies is an option for DefCovD and DefMetric specifying that all derivatives and tensors defined have the given list of additional dependencies (manifolds and parameters) and not only the manifold on which the derivative or metric are defined.";

(* Boundaries *)
ManifoldBoundary::usage="ManifoldBoundary[M] represents the manifold (without boundary) of the manifold (with boundary) M.";
EmptyManifold::usage="EmptyManifold is a manifold with no points. ManifoldBoundary[M] of a manifold M without boundary returns EmptyManifold.";

(* Mappings *)
DefMapping::usage="DefMapping[phi, M1->M2] defines phi to be a mapping having manifold M1 as domain and manifold M2 as image.";
UndefMapping::usage="UndefMapping[phi] undefines the mapping phi.";
MappingDomain::usage="MappingDomain[phi] returns the domain manifold of the mapping phi.";
MappingImage::usage="MappingImage[phi] returns the image manifold of the mapping phi, in general a supermanifold of phi[domain].";
ImmersionQ::usage="ImmersionQ is a Boolean option of DefMapping. ImmersionQ[phi] returns True if the mapping phi is an immersion on its image, and False otherwise.";
SubmersionQ::usage="SubmersionsQ is a Booleann option of DefMapping. SubmersionQ[phi] returns True if the mapping phi is a submersion on its image, and False otherwise.";
DiffeomorphismQ::usage="DiffeomorphismQ[phi] returns True if the mapping phi is a local diffeomorphism between its domain and image, and False otherwise.";
InverseMapping::usage="InverseMapping[phi] returns the inverse of the mapping phi, if phi is invertible (at least left or right invertible), and throws an error otherwise.";
IdentityMapping::usage="IdentityMapping[M] represents the identity mapping from the manifold M to itself.";

(* Vector bundles *)
DefVBundle::usage="DefVBundle[vbundle, M, dim, {a, b, c,...}] defines vbundle to be a vector bundle with base manifold M and fiber vector space with dimension given by dim (a positive integer) and represented by the abstract indices {a, b, c, ...}.";
UndefVBundle::usage="UndefVBundle[vbundle] undefines the vector bundle vbundle.";
AnyVBundles::usage="AnyVBundles is an internal symbol of xTensor returned by SlotsOfTensor acting on the Zero tensor.";
BaseOfVBundle::usage="BaseOfVBundle[vbundle] gives the base manifold of the vector bundle vbundle.";
Tangent::usage="Tangent[M] returns the tangent bundle of the manifold M. For a symbolic M the name of the bundle is constructed by default prepending the name of the manifold with Tangent.\n\nTangent is also an option for DefManifold, giving the name of the tangent bundle.";
TangentBundleOfManifold::usage="TangentBundleOfManifold = Tangent. Kept for backward compatibility.";
IndicesOfVBundle::usage="IndicesOfVBundle[vbundle] returns the abstract indices associated to vector bundle vbundle. There are two lists: that of the registered indices and that of the internally generated indices.";
LastIndex::usage="LastIndex[vbundle] gives a pair {i, n} such that dollar-indices will be formed using the symbol i (see function DummyIn) and computer-generated indices will be formed using the symbol i and the integer n (see function NewIndexIn). LastIndex[vbundle, map] given the corresponding pair for the pullback vbundle PullBackVBundle[vbundle, map].";
DimOfVBundle::usage="DimOfVBundle[vbundle] yields the dimension of vector bundle vbundle.";
TangentBundleQ::usage="TangentBundleQ[vbundle] gives True if vbundle is the tangent vector bundle of some manifold, and False otherwise.";
MetricEndowedQ::usage="MetricEndowedQ[vbundle] gives True if the vector bundle vbundle has at least one registered metric (which will be contained in MetricsOfVBundle[vbundle]) or False otherwise.";
MetricsOfVBundle::usage="MetricsOfVBundle[vbundle] gives the list of metrics that have been defined on the vector bundle vbundle. Only the first one will be used to raise and lower indices.";

(* Direct sums  and tensor products*)
CirclePlus::usage="CirclePlus[vb1, vb2, ...] represents the direct sum of the vector bundles vb1, vb2, ...";
CircleTimes::usage="CircleTimes[O1, O2, ...] represents the tensor product of the objects O1, O2, ...";

(* VBundle splitting *)
SplitVBundle::usage="SplitVBundle[V, {v1, ..., vn}] identifies the vbundle V as the direct sum of the vbundles vi. Both the V vbundle and the vi vbundles are assumed to exist already. The dimension of V must coincide with the sum of the dimensions of the vi vbundles.";
SplittingsOfVBundle::usage="SplittingsOfVBundle[vb] returns a list of known direct sum splittings of the vbundle vb.";
SubvbundlesOfVBundle::usage="SubvbundlesOfVBundle has been removed from xTensor in version 1.1.0. Please use SplittingsOfVBundle for similar functionality.";
SubvbundleQ::usage="SubvbundleQ[large, small] gives True if vector bundle small is contained in or equal to vector bundle large, and False otherwise.";
SubdummiesIn::usage="SubdummiesIn[vbundle] gives a list of unique (dollar) indices on the respective subvbundles of vbundle.";
SetSplitTensors::usage="SetSplitTensors[vbundle, Tlist] declares the tensors in the list Tlist to be projectors and their duals for the given vbundle, that must have been declared previously as a sum vbundle (using either DefVBundle or DefManifold). Currently xTensor can only decompose into two subvbundle, and hence Tlist must contain four tensors with character {down, up}, in any order. ";
SplitTensor::usage="SplitTensor[T] decomposes the tensor T as a sum of projected parts using the projectors declared with SetSplitTensors.";

Project::usage="Project[expr, P, inds] project the indices inds with the projector P, by explicit multiplication of expr by copies of P. The inds argument admits a single index, and IndexList or an IndicesOf expression.";
Projected::usage="Projected[T, {P, Q, ...}][a, b, ...] represents the tensor T projected with projector P in index a, Q in index b, ... Non-projected slots are denoted by the formal projector delta. Each projector can be replaced by a sum of projectors. The whole list of projectors can be replaced by a single projector or sum of projectors acting on all indices of the expression.";
ProjectorQ::usage="ProjectorQ[P] returns True if tensor P has been declared as a projector with MakeProjectors, and False otherwise.";
MakeProjectors::usage="MakeProjectors[{P1[-a, b], ..., Pn[-a, b]}, {dim1, ..., dimn}] defines tensors P1, ..., Pn, assumed to existe already, to be complementary projectors on the vbundle of the indices -a, b. Projector Pi projects onto a subspace of dimension dimi. The option OrthogonalWithMetric specifies a metric with respect to which the projectors are orthogonal.";
OrthogonalWithMetric::usage="OrthogonalWithMetric is an option of MakeProjectors specifiying the metric with respect to which a given set of complementary projectors are also a set of orthogonal projectors. The default value Null represents no metric.";
$ProjectedFormat::usage="$ProjectedFormat is a Boolean global variable selecting the type of formatting of indices of Projected tensors. With False the projectors are staggered with the indices, in gray font. With True the projectors are placed on top of upper indices or underneath lower indices. This should not be a Boolean variable...";
ContractProjector::usage="ContractProjector[expr, P] transforms products of projector P with other tensors in expr into Projected notation. ContractProjector[expr] contracts all projectors.";
FromProjected::usage="FromProjected[expr] converts Projected expressions into explicit products of tensors and projectors.";

(* Indices *)
VBundleOfIndex::usage="VBundleOfIndex[i] gives the vector bundle to which the g-index i belongs. Otherwise it throws an error message.";
RegisterIndices::usage="RegisterIndices[vb, inds] associates the given list inds of abstract indices to the vbundle vb.";
DummyIn::usage="DummyIn[vbundle] gives a unique abstract dollar-index on the vector bundle vbundle, using the last of the user-defined indices.";
DummyAs::usage="DummyAs[ind] gives a dummy abstract index in the vector bundle of ind, having the same up/down character.";
AddIndices::usage="AddIndices[vbundle, indlist] adds the abstract indices in indlist to the user-defined part of the indices associated to the the vector bundle vbundle.";
RemoveIndices::usage="RemoveIndices[vbundle, indlist] removes the abstract indices in indlist from the user-defined part of the indices associated to the vector bundle vbundle.";
NewIndexIn::usage="NewIndexIn[vbundle] gives and registers a new computer-defined abstract index associated to the vector bundle vbundle. The index is constructed using the last index of the user-defined part and a sequential number starting at 1. This is an internal function, and users are expected to use GetIndicesOfVBundle instead.";
GetIndicesOfVBundle::usage="GetIndicesOfVBundle[vbundle, n, list] gives a list of n abstract indices on the vector bundle vbundle, checking that they are not in list. If there are not enough indices in IndicesOfVBundle[vbundle] then new indices are generated using NewIndexIn.";

(* Tracing *)
TraceProductDummy::usage="TraceProductDummy[expr, index] expands the dummy index of a sum-vbundle in expr to dummy indices of its subvbundles. TraceProductDummy[expr] expands all dummies. TraceProductDummy[expr, {i1, i2, ...}] expands the dummies i1, i2,... TraceProductDummy[expr, {VBundle[VB1], i1, ...}] expands the indices i1,... and all dummies of the sum-vbundle VB1, ...";

1.1.5. ConstantSymbols

DefConstantSymbol::usage="DefConstantSymbol[symbol] defines symbol to be a constant with respect to all derivatives (covariant derivatives, Lie derivatives, variational derivatives and parameter derivatives).";
UndefConstantSymbol::usage="UndefConstantSymbol[symbol] undefines the constant symbol.";

1.1.6. Tensors

$TensorBoxes::usage="$TensorBoxes is a global variable specifying the internal notation to be used for indexed tensors. From version 1.0 of xTensor the default is \"GridBox\" but before it was \"ScriptBox\".";

(* Tensors *)
DefTensor::usage="DefTensor[T[-a, b, c, ...], {M1, ...}] defines T to be a tensor field on manifolds and parameters M1,... and the base manifolds associated to the vector bundles of its indices. DefTensor[T[-a, b, c, ...], {M1, ...}, symmetry] defines a tensor with symmetry given by a generating set or strong generating set of the associated permutation group.";
UndefTensor::usage="UndefTensor[tensor] undefines tensor.";
VanishingQ::usage="VanishingQ is a Boolean option for DefTensor stating that the defined tensor must be given a zero value.";
ForceSymmetries::usage="ForceSymmetries is a Boolean option for DefTensor. If True symmetries are registered even if involved indices do not have the same up/down character.";
FrobeniusQ::usage="FrobeniusQ is a Boolean option for DefTensor stating that the defined vector obeys the Frobenius condition with every torsionless covariant derivative.";
SetOrthogonal::usage="SetOrthogonal[tensor[inds], vector[ind]] defines automatic rules for tensor such that tensor[inds]*vector[ind] is zero. SetOrthogonal[tensor[inds], vector] defines those rules for all abstract indices of tensor[inds].";
OrthogonalTo::usage="OrthogonalTo is an option for several DefType functions. For DefTensor it gives a list of vectors which are orthogonal to the tensor defined, one for each index. For DefCovD it gives a vector which is orthogonal to the whole derivative.";
SetProjected::usage="SetProjected[tensor[inds], proj[i1, i2]] defines automatic rules for tensor such that tensor[inds]*proj[i1, i2] returns tensor again, but with new indices. SetProjected[tensor[inds], proj] defines those rules for all abstract indices of tensor[inds].";
ProjectedWith::usage="ProjectedWith is an option for several Def functions. For DefTensor it gives a list of 2-tensors which project the tensor defined into itself. For DefCovD it gives a projector for the whole derivative.";
OrthogonalToVectorQ::usage="OrthogonalToVectorQ[v][T] for a vector v and a tensor T returns True if T is orthogonal in all its slots to v, and False otherwise. The value is remembered as un upvalue of T.\n\nOrthogonalToVectorQ[v][expr] for a vector v and an indexed expression expr returns True if the expression is orthogonal in all its slots to v, and False otherwise. The value is not remembered.";
SymmetryGroupOfTensor::usage="SymmetryGroupOfTensor[tensor] gives the generating set or strong generating set of the symmetries of tensor, using Cycles notation on the numeric slots of the tensor.";
SymmetryTableauxOfTensor::usage="SymmetryTableauxOfTensor[tensor] gives the list of symmetry tableaux of tensor, using numeric slots.";
SlotsOfTensor::usage="SlotsOfTensor[tensor] gives the list of vector bundles with up/down marks corresponding to the slots of tensor as it was defined. Slots related by the symmetries of tensor must belong to the same vector bundle and must have the same up/down character, unless the option ForceSymmetries is used.";
TensorID::usage="TensorID[tensor] returns a list with information on how to compute the components of the tensor.";
WeightOfTensor::usage="WeightOfTensor[tensor] gives the weight of tensor as a tensorial density. It is always a linear combination of names of bases. It is 0 if tensor is not a density. Upvalues for tensor are stored only if tensor is a density. WeightOfTensor is also an option for DefTensor giving the weight of the defined tensor.";
WeightOf::usage="WeightOf[expr] returns the density weight of the expression. The weight of the basis-determinant of the metric is defined to be 2*basis.";
DependenciesOfTensor::usage="DependenciesOfTensor[tensor] gives the list of manifolds and parameters on which the tensor depends.";

(* Other *)
Zero::usage="Zero[e1, ..., en] is 0 no matter what the arguments are.";
HeadOfTensor::usage="HeadOfTensor[T[a, b, ...], {a, b, ...}] returns T. HeadOfTensor[k T[a, b, ...], {a, b, ...}] returns MultipliyHead[k, T].";
MultiplyHead::usage="MultiplyHead[k, T][a, b, ...] returns k T[a, b, ...].";
delta::usage="delta[-a, b] represents the identity tensor on any vector bundle. In the presence of a metric the object delta[b, -a] is also allowed, being related to the former as given by that metric.";
Gdelta::usage="Gdelta[-a1, ..., -an, b1, ..., bn] represents the generalized delta tensor on any vector bundle.";
ExpandGdelta::usage="ExpandGdelta[expr] expands Gdelta as a linear combination of products of delta.";
Sdelta::usage="Sdelta[sym][inds] represents a tensor with symmetry sym in the first half of its slots and symmetry sym in the second half of its slots.";
ExpandSdelta::usage="ExpandSdelta[expr] expands Sdelta[sym] as a linear combination of products of delta.";
SeparateDir::usage="SeparateDir[expr] converts all directional indices (expressions Dir[v]) in expr into products of the direction v and the corresponding tensor.";
ContractDir::usage="ContractDir[expr, v] converts contracted vectors v into Dir[v[.]] expressions in expr.";

(* PushForward and PullBack *)
PullBack::usage="PullBack[expr, phi, firules] computes the pull back of the tensor expression expr along the mapping phi, changing free indices of expr into free indices of the domain tangent vbundle as given by the list of rules firules.";
PullBackVBundle::usage="PullBackVBundle[vb, phi] represents the pull back of the vector bundle bun under the mapping phi. It is also treated as a (nonatomic) vbundle.";
Precompose::usage="Precompose[T, phi] represents the precomposition of the tensor field T with the mapping phi, a section of a pullback vbundle. The result has dependencies given by the domain of the mapping phi.";
PullBackTensor::usage="PullBackTensor[T, phi] represents the pull back of the tensor T under the mapping phi. It is also treated as a (nonatomic) tensor.";
PullBackCovD::usage="PullBackCovD[CD, phi] represents the pull back of the covariant derivative CD under the mapping phi. It is also treated as a (nonatomic) covariant derivative.";
ExpandPullBack::usage="ExpandPullBack[expr] expands the PullBackTensor[T, phi] expressions into a contraction of Precompose[T, phi] with explicit dphi or Inv[dphi] factors.";
TangentTensor::usage="TangentTensor[phi] returns the tangent (or differential) of the mapping phi. This is a 2-tensor along the mapping phi, with its first slot being the cotangent vbundle of the domain of phi and the second slot being the pullback of the tangent bundle of the image of phi.";
PushForward::usage="PushForward[expr, phi, firules] computes the push forward of the tensor expression expr along the mapping phi, changing free indices of expr into free indices of the image tangent vbundle as given by the list of rules firules.";
LinearPush::usage="LinearPush[T, dphi] represents a tensor along the mapping phi, whose differential is dphi. It is equivalent to a contraction of the contravariant slots of T with dphi, and of the covariant slots of T with the inverse of dphi.";
InvertibleQ::usage="InvertibleQ[dphi] returns True if dphi is an invertible 2-tensor, and False otherwise. InvertibleQ[dphi, Left] returns True if dphi is left-invertible, and False otherwise. InvertibleQ[dphi, Right] returns True if dphi is right-invertible, and False otherwise.";
PushForwardTensor::usage="PushForwardTensor[T, phi] represents the push forward of the tensor T under the mapping phi. It is also treated as a (nonatomic) tensor.";
ExpandPushForward::usage="ExpandPushForward[expr] expands the PushForwardTensor[T, phi] expressions into a contraction of Precompose[T, iphi] with explicit diphi or Inv[diphi] factors, where iphi is the inverse mapping of phi.";
At::usage="At[texpr, sub] represents the restriction of the tensorial expression texpr to the submanifold sub, which may be a point.";
TensorAt::usage="TensorAt[T, sub] represents the restriction of the tensor T to the submanifold sub, which may be a point.";

ATensor::usage="ATensor[name, slots, deps, sym] represents an abstract tensor with the given properties.";

1.1.7. Rules

(* Rules *)
PermuteIndices::usage="PermuteIndices[expr, indices, perm] permutes the indices of expr given by the list indices (head IndexList) with the permutation perm, in general a linear combination of permutations.";
MakeRule::usage="MakeRule[{LHS, RHS}] gives a list of delayed rules with left and right hand sides as given by LHS and RHS respectively, but moving indices to consider all possible equivalent rules. See notes for its options PatternIndices, MetricOn, UseSymmetries and TestIndices. MakeRule[{LHS, RHS, conditions}] adds conditions to the rules.";
ToRule::ToRule="ToRule[lhs==rhs] evaluates the given equation and returns a rule lhs:>Module[{..}, rhs] constructed with MakeRule. ToRule also accepts rules and lists in input, and takes all options of MakeRule.";
AutomaticRules::usage="AutomaticRules[symbol, {rule1, rule2, ...}] declares the rules as upvalues or downvalues for symbol, or append them to $Rules if symbol is too deep in the rules.";
IndexRule::usage="IndexRule[lhs, rhs] construct a DelayedRule expression between indexed expressions lhs and rhs, evaluating rhs in advance.";
IndexRuleDelayed::usage="IndexRuleDelayed[lhs, rhs] construct a DelayedRule expression between indexed expressions lhs and rhs, without evaluating rhs.";
IndexSet::usage="IndexSet[lhs, rhs] defines a relation between indexed expressions lhs and rhs, evaluating rhs in advance.";
IndexSetDelayed::usage="IndexSet[lhs, rhs] defines a relation between indexed expressions lhs and rhs, withoug evaluating rhs.";
DoubleRightTee::usage="Infix form for IndexRule. Note that it has a very high precedence (much higher than that of = ).";
RightTeeArrow::usage="Infix form for IndexRule. Note that it has a very high precedence (much higher than that of -> ).";
PatternIndices::usage="PatternIndices is an option for MakeRule expressing the indices that will be converted into patterns in the final expression of the rule. Possible values are None (default), All or a list of indices.";
MetricOn::usage="MetricOn is an option for MakeRule. MetricOn->None (default) means that no index can be raised or lowered. MetricOn->All means that all indices can be raised or lowered. MetricOn->{i1, i2, ...} explicitly gives the list of indices that can be raised or lowered with the metric. This option is not relevant if there is no metric.";
TestIndices::usage="TestIndices is a Boolean option for MakeRule. TestIndices->True (default) means that patterntests are added to the indices of the rules to check that they belong to the right vector bundle.";
UseSymmetries::usage="UseSymmetries is a Boolean option for MakeRule. UseSymmetries->True (default) means that symmetries of the tensors are considered to construct the rules.";
ContractMetrics::usage="ContractMetrics is a Boolean option for MakeRule that specifies that all metric objects must be contracted (if possible) in the RHS of the rules. Its default value is False.";Verbose::usage="Verbose is a Boolean option for MakeRule, AutomaticRules and ToCanonical. Verbose->True gives lots of log-info about the internals of the calculation. Its default value is False.";

1.1.8. Covariant derivatives

Leibnitz::usage="Leibnitz[expr][-a, b] gives a sum of copies of expr*delta in which each free upper index has been replaced by b and each lower index has been replaced by -a.";

(* Covariant derivatives *)
$CovDFormat::usage="$CovDFormat is a global variable containing a string with the formatting form of covariant derivatives. Possible values are currently: \"Prefix\" (default) for nabla-like notation, and \"Postfix\" for comma-like notation.";
$ParamDFormat::usage="$ParamDFormat is a global variable containing a string with the formatting form of parametric derivatives. Possible values are currently: \"Prefix\" (default) or \"SinglePrefix\" for partial-like notation, and \"Postfix\" for comma-like notation.";
DefCovD::usage="DefCovD[covd[-a], {post, pre}] defines covd to be a connection on the tangent bundle of index a. DefCovD[covd[-a], vbundle, {post, pre}] defines covd to be a connection on the tangent bundle of index a and the inner vbundle (which must have the same base manifold). The connection will be represented in StandardForm using the character pre in \"Prefix\" notation and the character post in \"Postfix\" notation.";
UndefCovD::usage="UndefCovD[covd] undefines covd.";
PD::usage="PD denotes the fiducial connection without curvature nor torsion (called ordinary derivative by Wald).";
Curvature::usage="Curvature is an option for DefCovD giving whether a newly defined covariant derivative has curvature or not. There are several possible values: Riemann (the connection has curvature only on the tangent bundle), FRiemann (only on the inner bundle, and its conjugate), True (on both vbundles), False (no curvature), a vbundle on which we want to have curvature, or a list of such vbundles. The default value is True.\n\nCurvature is also a Boolean option for DefMetric, saying whether a metric defined on a tangent bundle has a Levi-Civita connection with curvature or not.";
CurvatureRelations::usage="CurvatureRelations is a Boolean option for DefCovD giving whether automatic rules relating the curvature tensors of a newly define covariant derivative should be defined or not. Its default value is True.\n\n CurvatureRelations[covd, Riemann] gives a list of the relations between the contracted Riemann of cov and the Ricci tensor. CurvatureRelations[covd, Ricci] give the corresponding list of relations between the contracted Ricci and the RicciScalar if there is a metric. CurvatureRelations[covd] gives the union of those two lists.";
FromMetric::usage="FromMetric is an option for DefCovD giving the metric associated to the covariant derivative. Use FromMetric -> metric or FromMetric -> Null.";
ExtendedFrom::usage="ExtendedFrom is an option for DefCovD (generally used when defining a covd on an inner vbundle), specifying that the Riemann, Ricci, Christoffel and Torsion tensors must be shared with another, already existing, covd.";
WeightedWithBasis::usage="WeightedWithBasis is an option for DefCovD (though typically used through DefMetric) to extend a Levi-Civita connection on densities in a given basis (which can be AIndex as special case). Its default value is Null.\n\nWeightedBasis[covd] returns the basis along which the Levi-Civita connection covd has been extended, or Null otherwise.";
SymmetryGroupOfCovD::usage="SymmetryGroupOfCovD[covd] gives the symmetry group of the covariant derivative covd when it acts as a multiple index derivative.";
DependenciesOfCovD::usage="DependenciesOfCovD[covd] gives the list of dependencies (manifolds and parameters) on which the covariant derivative covd depends.";

(* Associated tensors *)
Christoffel::usage="Christoffel[covd1, covd2][a, -b, -c] returns the Christoffel tensor relating the connections covd1 and covd2, and defines it if it does not exist yet. Christoffel[covd][a, -b, -c] is equivalent to Christoffel[covd, PD][a, -b, -c].";
AChristoffel::usage="AChristoffel[covd1, covd2][A, -b, -C] returns the Christoffel tensor relating the connections covd1 and covd2 on an inner vbundle, and defines it if it does not exist yet. This proceeds by immediate conversion of AChristoffel into Christoffel. AChristoffel[covd][A, -b, -C} is equivalent to AChristoffel[covd, PD][A, -b, -C].";
Torsion::usage="Torsion[covd] returns the torsion tensor associated to a connection covd.\n\nTorsion is also a Boolean option for DefCovD that specifies whether the defined covariant derivative has torsion or not. Its default value is False.";
Riemann::usage="Riemann[covd] returns the Riemann curvature tensor associated to a connection covd acting on a tangent bundle.";
FRiemann::usage="FRiemann[covd] returns the Riemann curvature tensor associated to a connection covd acting on an inner (not tangent) vector bundle.";
RiemannDown::usage="RiemannDown[covd] returns the Riemann curvature tensor associated to the connection covd of a frozen metric, with its four indices being lower indices, so that it has full Riemann symmetry.";
Ricci::usage="Ricci[covd] returns the Ricci curvature tensor associated to a connection acting on a tangent bundle.";
TFRicci::usage="TFRicci[covd] returns the Traceless Ricci curvature tensor associated to a connection covd acting on a tangent bundle.";
RicciScalar::usage="RicciScalar[covd] returns the Ricci curvature scalar associated to a metric-compatible connection covd acting on a tangent bundle.";
Einstein::usage="Einstein[covd] returns the Einstein curvature tensor associated to a metric-compatible connection covd acting on a tangent bundle.";
Weyl::usage="Weyl[covd[ returns the Weyl curvature tensor associated to a metric-compatible connection covd acting on a tangent bundle.";
Kretschmann::usage="Kretschmann[covd] returns the Kretschmann curvature scalar associated to a metric-compatible connection covd acting on a tangent bundle.";
LC::usage="LC[g] returns the Levi-Civita covariant derivative associated to the metric g.";

Implode::usage="Implode[expr, covd] converts covd derivatives of tensors into new tensors formed from the names of the tensor and the covd.";
$ImplodeInfoQ="$ImplodeInfoQ is a boolean global variable which specifies whether definition of imploded tensors is to be reported or not.";
Explode::usage="Explode[expr, covd] converts imploded tensors into their corresponding form with explicit covd operators. Metric factors may appear in this process.";

epsilon::usage="epsilon[g] returns the totally antisymmetric tensor associate to the metric g.";
ExtrinsicK::usage="ExtrinsicK[h] returns the extrinsic curvature tensor associated a the induced metric h.";
Acceleration::usage="Acceleration[n] returns the acceleration vector associated to the vector n, registered as the vector orthogonal to some induced metric.";
Projector::usage="Projector[h] returns the projector tensor on the tangent subvbundle defined by the induced metric h.";

(* Info on covds *)
CurvatureQ::usage="CurvatureQ[covd] gives True if covd has been defined as a covariant derivative with curvature and False otherwise.";
TorsionQ::usage="TorsionQ[covd] gives True if covd has been defined as a covariant derivative with torsion and False otherwise.";
SymbolOfCovD::usage="SymbolOfCovD[covd] gives the pair of strings that represent the covariant derivative covd in StandardForm in formats \"Postfix\" and \"Prefix\" respectively.";
ManifoldOfCovD::usage="ManifoldOfCovD[covd] gives the manifold where the covariant derivative covd lives. It is always a dependency of covd.";
VBundlesOfCovD::usage="VBundlesOfCovD[covd] gives a list of vector bundles on which the derivative acts. The list can contain: one element (a tangent vector bundle), two elements (a tangent vector bundle and an inner real vector bundle) or three elements (a tangent bundle and an inner complex bundle with its conjugate).";
MetricOfCovD::usage="MetricOfCovD[covd] gives the metric from which covd derives, if covd is a metric covariant derivative. Otherwise it gives Null.";

(* Manipulation of covds *)
ContractCurvature::usage="ContractCurvature[expr] replaces all contracted Riemann tensors by Ricci and all contracted Ricci tensors by RicciScalar. ContractCurvature[expr, covd] does it only for the given covariant derivative. ContractCurvature[expr, covd, Riemann] only replaces Riemann by Ricci. ContractCurvature[expr, covd, Ricci] only replaces Ricci by RicciScalar.";
CheckZeroDerivative::usage="CheckZeroDerivative[expr] performs some checks on expr to see if there are derivatives of some manifolds acting on fields on other manifolds, which hence can be removed.";
$CheckZeroDerivativeVerbose::usage="$CheckZeroDerivativeVerbose is a Boolean global variable which says whether the action of CheckZeroDerivative must be reported or not. By default it is set to False.";
CheckZeroDerivativeStart::usage="CheckZeroDerivativeStart[covd] starts automatic zero checking of derivative covd.";
CheckZeroDerivativeStop::usage="CheckZeroDerivativeStop[covd] stops automatic zero checking of derivative covd.";
BreakChristoffel::usage="BreakChristoffel[expr, chr, covd] transforms all instances of chr[inds] (from covd1 to covd2) in expr into Christoffel[covd1, covd][inds]-Christoffel[covd2, covd][inds]. BreakChristoffel[expr, chr] is converted into BreakChristoffel[expr, chr, PD]. BreakChristoffel[expr, covd] breaks all Christoffel tensors using covd as intermediate connection. BreakChristoffel[expr] is converted into BreakChristoffel[expr, PD].";
ChangeTorsion::usage="ChangeTorsion[expr, covd1, covd2] changes the torsion tensor of covd1 by the torsion tensor of covd2 using the antisymmetric part of the Christoffel relating covd1 and covd2. The second argument is listable. ChangeTorsion[expr, covd1] is converted into ChangeTorsion[expr, covd1, PD]. ChangeTorsion[expr] is converted into ChangeTorsion[expr, $CovDs].";
TorsionToChristoffel::usage="TorsionToChristoffel = ChangeTorsion. Kept for backwards compatibility.";
ChangeCovD::usage="ChangeCovD[expr, covd1, covd2] changes any instance of the covariant derivative covd1 in expr into a covariant derivative covd2 and Christoffel tensors relating both connections. The second argument is listable. ChangeCovD[expr, covd1] is converted into ChangeCovD[expr, covd1, PD]. ChangeCovD[expr] is converted into ChangeCovD[expr, $CovDs].";
CovDToChristoffel::usage="CovDToChristoffel = ChangeCovD. Kept for backwards compatibility.";
ChangeCurvature::usage="ChangeCurvature[expr, covd1, covd2] changes the curvature tensors (Riemann, Ricci, RicciScalar and FRiemann) of covd1 into the curvature tensors of covd2 using the Christoffels relating covd1 and covd2. The second argument is listable. ChangeCurvature[expr, covd1] is converted into ChangeCurvature[expr, covd1, PD]. ChangeCurvature[expr] is converted into ChangeCurvature[expr, $CovDs].";
RiemannToChristoffel::usage="RiemannToChristoffel = ChangeCurvature. Kept for backwards compatibility.";
RiemannToWeyl::usage="RiemannToWeyl[expr, covd] expands expr expressing all Riemann tensors of covd in terms of the Weyl and other tensors of covd. If the second argument is a list of covariant derivatives the command is applied sequentially on expr. RiemannToWeyl[expr] expands all Riemann tensors.";
WeylToRiemann::usage="WeylToRiemann[expr, covd] expands expr expressing all Weyl tensors of covd in terms of the Riemann and other tensors of covd. If the second argument is a list of covariant derivatives the command is applied sequentially on expr. WeylToRiemann[expr] expands all Weyl tensors.";
RicciToTFRicci::usage="RicciToTFRicci[expr, covd] expands expr expressing all Ricci tensors of covd in terms of the TFRicci and other tensors of covd. If the second argument is a list of covariant derivatives the command is applied sequentially on expr. RicciToTFRicci[expr] expands all Ricci tensors.";
TFRicciToRicci::usage="TFRicciToRicci[expr, covd] expands expr expressing all TFRicci tensors of covd in terms of the Ricci and other tensors of covd. If the second argument is a list of covariant derivatives the command is applied sequentially on expr. TFRicciToRicci[expr] expands all TFRicci tensors.";
RicciToEinstein::usage="RicciToEinstein[expr, covd] expands expr expressing all Ricci tensors of covd in terms of the Einstein and RicciScalar tensors of covd. If the second argument is a list of covariant derivatives the command is applied sequentially on expr. RicciToEinstein[expr] expands all Ricci tensors.";
EinsteinToRicci::usage="EinsteinToRicci[expr, covd] expands expr expressing all Einstein tensors of covd in terms of the Ricci and RicciScalar tensors of covd. If the second argument is a list of covariant derivatives the command is applied sequentially on expr. EinsteinToRicci[expr] expands all Einstein tensors.";
RiemannToRiemannDown::usage="RiemannToRiemannDown[expr, covd] expands expr expressing all Riemann tensors of covd (the Levi-Civita derivative of a frozen metric) in terms of the RiemannDown tensor of covd. If the second argument is a list of covariant derivatives the command is applied sequentially on expr. RiemannToRiemannDown[expr] expands all Riemann tensors of frozen metrics.";
RiemannDownToRiemann::usage="RiemannDownToRiemann[expr, covd] expands expr expressing all RiemannDown tensors of covd (the Levi-Civita derivative of a frozen metric) in terms of the Riemann tensor of covd. If the second argument is a list of covariant derivatives the command is applied sequentially on expr. RiemannDownToRiemann[expr] expands all RiemannDown tensors of frozen metrics.";

(* Parametric derivatives *)
OverDot::usage="OverDot[expr] represents a simple ordinary derivative of expr with respect to some internal parameter (say time) which is independent of the coordinates of the manifolds where expr live. It commutes with partial derivatives, but not with other covariant derivatives or with Lie derivatives because in general the vector field of the Lie derivative could depend upon the parameter as well.";
ParamD::usage="ParamD[params][expr] represents the multiple ordinary derivative of expr with respect to the sequence params of parameters, automatically sorted into canonical order.";

(* Sorting derivatives *)
SortCovDs::usage="SortCovDs[expr, covd] exchange repeatedly two instances of the covariant derivative covd, introducing Riemann tensors if needed, until the indices of the derivatives are sorted in canonical order. ";
CommuteCovDs::usage="CommuteCovDs[expr, covd, {a, b}] converts subexpressions covd[b]@covd[a]@expr1 of expr into covd[a]@covd[b]@expr1 plus Riemann terms linear in expr1.";
SortCovDsStart::usage="SortCovDsStart[covd] automatizes the commutation of covariant derivative covd.";
SortCovDsStop::usage="SortCovDsStop[covd] removes automatic commutation of covariant derivative covd.";

TensorD::usage="TensorD[expr, der1, der2, ...] computes the given derivatives of expr, returning the result using TensorDerivative notation. The deri can be either covariant derivatives or Lie derivatives or parametric derivatives.";
TensorDerivative::usage="TensorDerivative[T, der] represents the name of the tensor obtained by differentitation of the tensor T. The derivative der can be either a covariant derivative or a Lie derivative or a parametric derivative. TensorDerivative[T, der1, der2, ...] represents a high-order derivative.";
ToTensorDerivative::usage="ToTensorDerivative[expr] converts derivatives in expr from standard covd[-a][T[b,c]] notation to TensorDerivative[T,covd][b,c,-a] notation. Note that the derivative index is placed last in the latter notation.";
FromTensorDerivative::usage="FromTensorDerivative[expr] converts derivatives in expr from TensorDerivative[T,covd][b,c,-a] notation to standard covd[-a][T[b,c]] notation. Note the the derivative index is the last in the former notation.";

1.1.9. Lie derivatives

(* Lie derivatives *)
LieD::usage="LieD[v][expr] represents the Lie derivative of expr along the contravariant vector field v. LieD[v, covd][expr] computes the Lie derivative of expr using the covariant derivative covd.";
Bracket::usage="Bracket[v1, v2][i] represents the Lie Bracket of vector fields v1 and v2, giving a vector field with index i.";
LieDToCovD::usage="LieDToCovD[expr, covd] transforms LieD[v][expr1] into LieD[v, covd][expr1] so that the Lie derivative of expr1 along v is computed in terms of the covariant derivative covd.";
DirCovDToLieD::usage="DirCovDToLieD[expr, v] changes all directional derivatives along the vector v to Lie derivatives along the same vector field. The vector v is the name of the vector, without an index.";
BracketToCovD::usage="BracketToCovD[expr, covd] changes all Lie brackets in expr by their expressions in terms of the derivative covd (with optional value PD).";

1.1.10. Variational derivatives

(* Variational derivatives *)
VarD::usage="VarD[T, covd][expr, rest] computes the variational derivative of expr*rest with respect to the tensor field T. Integrations by parts will be performed with the covariant derivative covd.";
ImplicitTensorDepQ::usage="ImplicitTensorDepQ[T1, T2] returns False if tensor T1 does not depend implicitly on tensor T2, an hence the variational derivative of T1 with respect to T2 is zero. This is the default behaviour for any two different tensors. The trivial subcase ImplicitTensorDepQ[T, T] returns True. Nontrivial tensor dependencies must be set by hand, if possible as upvalues for T1. ";

1.1.11. Canonicalization

(* Stripping *)
ToStripped::usage="ToStripped[expr] returns the stripped form of the expression expr.";
FromStripped::usage="FromStripped[sexpr] converts back the stripped expression sexpr into a standard expression.";
Stripped::usage="Stripped[T, t][inds] represents the stripped form of the object t, of type T, with indices inds";

(* Monomials *)
BreakInMonomials::usage="BreakInMonomials[expr] returns expr with terms separated into products of monomials (head Monomial) and scalars.";
Monomial::usage="Monomial[expr] represents a monomial (a product of objects sharing contracted indices).";

(* Canonicalization *)
Symmetry::usage="Symmetry is the head of symmetry expressions.";
xSort::usage="xSort[expr] returns a unique sorted form of the expression expr, using the internal Object notation.";
UxSort::usage="UxSort[object] converts back the object, given in internal Object notation, into a standard tensorial expression.";
xSortPrecedence::usage="xSortPrecedence[t] returns an integer value that determines the precedence of tensor t in xSort. Precedence values are sorted with Sort and hence smaller values correspond to earlier places in the sorted list.";
$MixedDers="$MixedDers is a global variable stating whether the canonicalization process must take into account the fact that there are connections different from that of the metric. The initial default value is True.";
ToCanonical::usage="ToCanonical[expr] gives a canonical reorganization of the tensors and their indices in expr, according to the symmetries of tensors and positions of dummies and repeated indices.";
UseMetricOnVBundle::usage="UseMetricOnVBundle is an option for ToCanonical giving the vector bundles where the (first) metric (if any) should be used in the process of canonicalization. Possible values for this option are All, None or a list of vector bundles.";
ImposeSymmetry::usage="ImposeSymmetry[expr, inds, GS] imposes the symmetry given by the generating set (or strong generating set) GS on the indices inds of expr.";
xAct`xTensor`Symmetrize::usage="Symmetrize[expr, {i1, ..., in}] symmetrizes the expr with respect to the n abstract indices i1, ..., in. By convention, the result has a factor 1/n! multiplying. Symmetrize[expr] symmetrizes all free indices.";
Antisymmetrize::usage="Antisymmetrize[expr, {i1, ..., in}] antisymmetrizes the expr with respect to the n abstract indices i1, ..., in. By convention, the result has a factor 1/n! multiplying. Antisymmetrize[expr] antisymmetrizes all free indices.";
PairSymmetrize::usage="PairSymmetrize[expr, {{i1,j1}, ..., {in,jn}}] symmetrizes expr with respect to exchange of both indices among any two pairs, i.e., under simultaneous change of i3<->i7 and of j3<->j7.";
PairAntisymmetrize::usage="PairAntisymmetrize[expr, {{i1,j1}, ..., {in,jn}}] antisymmetrizes expr with respect to exchange of both indices among any two pairs, i.e., under simultaneous change of i3<->i7 and of j3<->j7.";
Cyclize::usage="Cyclize[expr, {i1, ..., in}] returns expr cyclizing the given indices. Note that the result depends on the order of the indices in the list."; 
SymmetryOf::usage="SymmetryOf[expr] gives a description (a result with head Symmetry) of the symmetry of the expression expr. This includes a generating set for that symmetry using Cycles notation on the indices of expr.";
CommutePDs::usage="CommutePDs is a Boolean option for SymmetryOf specifying whether it is possible or not to commute PD derivatives.";
ConstantMetric::usage="ConstantMetric is a Boolean option for SymmetryOf specifying whether all derivatives should be considered to be metric compatible when determining the symmetry of an expression.";
$CommuteCovDsOnScalars::usage="$CommuteCovDsOnScalars is a Boolean global variable stating whether two non-torsion equal covds must be considered as commuting by SymmetryOf. The default initial variable is True.";

(* Manipulation of Scalar *)
NoScalar::usage="NoScalar[expr] removes Scalar from expr, introducing new dummy indices.";
BreakScalars::usage="BreakScalars[expr] separates scalars inside a single Scalar head.";
PutScalar::usage="PutScalar[expr] surrounds scalars with the head Scalar.";

STFPart::usage="STFPart[expr, metric] returns the symmetric, trace-free part of expr with respect to all its free abstract indices. STFPart[expr, metric, indices] allows to specify a list of indices to symmetrize.";
Sym::usage="Sym[expr, inds, sym] represents the symmetrization of the expression expr in the indices inds as given by the symmetry group sym. It plays a similar role to ImposeSymmetry, but without expanding the expression.";

1.1.12. Metrics

(* Metrics *)
DefMetric::usage="DefMetric[signdet, metric[-a,-b], covd, covdsymbol] defines metric[-a, -b] with signdet 1 or -1 and associates the covariant derivative covd[-a] to it.";
DefProductMetric::usage="DefProductMetric[metric[-a,-b], {{M1, scalar1[]}, ...}, covd, covdsymbol] defines the metric scalar1[]^2 metric1[-a,-b] + scalar2[]^2 metric2[-A,-B] + ... and its associated curvature tensors.";
UndefMetric::usage="UndefMetric[metric] undefines metric and all its associated servants.";
FlatMetric::usage="FlatMetric is a Boolean option for DefMetric specifying whether the defined metric is flat or not.";
Inv::usage="Inv is a prefix symbol used to define the inverse of a (frozen) metric or any linear operator (2-tensor).";
InducedFrom::usage="InducedFrom is an option for DefMetric with form {G, v}, stating that the defined metric is actually the induced metric G on a codimension-1 hypersurface orthogonal to the non-null vector v (with respect to metric G). For a non-induced metric the option has the value Null, which is the default.\n\nInducedFrom[hmetric] returns the pair {G, v} from which the projected metric hmetric has been induced, or Null if hmetric is not an induced metric.";
ConformalFactor::usage="ConformalFactor[metric1, metric2] returns an scalar expression X such that the metrics are related by the conformal transformation metric1[-a,-b] = X metric2[-a,-b].";
ConformalRules::usage="ConformalRules[tensor1, tensor2] returns a list of rules relating the given two tensors by a (general) conformal transformation. These rules are automatically stored by DefMetric when using the option ConformalTo. For other tensors the rules must be specified manually as a tagset for one of the tensors. ConformalRules[list1, list2] joins the lists of transformations for respective tensors in the lists, which hence must have the same length.";
ConformalTo::usage="ConformalTo is an option for DefMetric with form {metexpr, confactor} specifying that the defined metric is conformal to the product of metexpr and confactor, the former a metric expression and the latter a scalar expression to be used as conformal factor.";
SetConformalTo::usage="SetConformalTo[metric[-a, -b], {g[-a, -b], confactor}] declares metric[-a, -b] to be equal to confactor * g[-a, -b], that is they are metrics related by a conformal transformation. The conformal factor is stored as an upvalue for the head ConformalFactor, the conformal transformation is stored as an upvalue for ConformalRules, and the Christoffel relating their respective Levi-Civita connections is also stored.";
epsilonOrientationInBasis::usage="epsilonOrientationInBasis is an option for DefMetric specifying a pair {basis, o} where o is the factor between the epsilon tensor of the metric being defined and the eta tensors of the given basis. By default this pair is {AIndex, $epsilonSign}.";
epsilonOrientation::usage="epsilonOrientation[metric, basis] gives the factor between the epsilon tensor of metric and the eta tensors of basis. Its default value is $epsilonSign, for backward compatibility.";

FlatMetricQ::usage="FlatMetricQ[metric] gives True if metric has been defined as a flat metric, or False otherwise.";
SignDetOfMetric::usage="SignDetOfMetric[metric] gives the sign of the determinant of metric in real bases.";
SignatureOfMetric::usage="SignatureOfMetric[metric] gives the signature of the metric, in the form of a list of three elements: {p1s, m1s, zeros} giving the numbers of +1's, -1's and zeros, respectively, always in this order.";
Determinant::usage="Determinant[metric, basis][] returns the scalar density tensor (with weight +2 in basis) representing the determinant of metric with both indices expanded in the given basis. The tensor is defined if it does not exist yet. The default value for basis is AIndex.";
CovDOfMetric::usage="CovDOfMetric[metric] gives the covariant derivative operator associated to metric at definition time. CovDOfMetric[metric, torsion] gives the covariant derivative operator associated to metric and having the given torsion tensor. Specifying Zero torsion returns the Levi-Civita connection of the metric.";
VBundleOfMetric::usage="VBundleOfMetric[metric] gives the vector bundle where metric lives, or an error if metric is not known.";

ContractMetric::usage="ContractMetric[expr, metric] contracts all instances of metric in expr. If the second argument is a list of metrics the command is applied sequentially on expr. ContractMetric[expr] contracts all metrics.";
OverDerivatives::usage="OverDerivatives is a Boolean option for ContractMetric.";
SeparateMetric::usage="SeparateMetric[g, b][expr, i] separates the index i in the expression expr using the metric g and a dummy index in basis b. The default for b is AIndex, introducing an abstract index. The default for g is the first metric of the vbundle of the index i. The default for i is the list of indices in expr which do not have their natural character (that specified at definition time for tensors, or covariant for all derivatives).";
AllowUpperDerivatives::usage="AllowUpperDerivatives is a Boolean option for ContractMetric. If True, an inverse metric can be contracted with a covariant derivative giving a derivative with a contravariant index. If False, that cannot be done.";
ChristoffelToMetric::usage="ChristoffelToMetric = ChristoffelToGradMetric. Kept for backwards compatibility.";
ChristoffelToGradMetric::usage="ChristoffelToGradMetric[expr, metric] expands expr expressing all Christoffels of metric in terms of the metric. If the second argument is a list of metrics the command is applied sequentially on expr. ChristoffelToGradMetric[expr] expands all Christoffel symbols.";
GradMetricToChristoffel::usage="GradMetricToChristoffel[expr, metric, covd] expands expr expressing all covd-derivatives of metric as Christoffel tensors from the Levi-Civita connection of the metric to covd. If the second and/or third arguments are lists the command is applied sequentially on expr in all possible cases. GradMetricToChristoffel[expr, metric] expands to all defined covariant derivatives. GradMetricToChristoffel expands to all defined metrics and covariant derivatives.";
ChristoffelToGradConformal::usage="ChristoffelToGradConformal[expr, metric1, metric2] expands expr expressing all Christoffel[covd1, covd2], where covdi is the Levi-Civita connection of metrici, in terms of derivatives (using covd2) of the conformal factor relating those metrics. The covariant derivatives covdi can be used in input instead of the metrici.";

MetricToProjector::usage="MetricToProjector[expr, metric] expands expr expressing the metric tensor in terms of a projector and its orthogonal vector field. If the second argument is a list of metrics the command is applied sequentially on expr. MetricToProjector[expr] expands all metric tensors.";
ProjectorToMetric::usage="ProjectorToMetric[expr, proj] expands expr expressing the projector proj in terms of the corresponding metric and orthogonal vector field. If the second argument is a list of projectors the command is applied sequentially on expr. ProjectorToMetric[expr] expands all projectors.";
ProjectWith::usage="ProjectWith[projector][expr] projects all free indices of expression using the given projector. Note the double pair of brackets, which simplifies the replacement of the projecting inert head with the actual projecting function using a rule like ih -> ProjectWith[proj].";
GradNormalToExtrinsicK::usage="GradNormalToExtrinsicK[expr, imetric] transforms the derivatives of the normal vector to the induced metric imetric into extrinsic curvature tensors. If the second argument is a list then the function is applied sequentially on all elements. GradNormalToExtrinsicK[expr] expands all induced metrics.";
ExtrinsicKToGradNormal::usage="ExtrinsicKToGradNormal[expr, imetric] transforms the extrinsic curvature tensors associated to the induced metric imetric into derivatives of its normal vector. If the second argument is a list then the function is folded sequentially on all elements. ExtrinsicKToGradNormal[expr] expands all induced metrics.";
ProjectDerivative::usage="ProjectDerivative[expr, cd] converts the induced derivative cd into the original derivative but projected. If the second argument is a list then the function is folded sequentially on all elements. ProjectDerivative[expr] converts all induced derivatives.";
InducedDecomposition::usage="InducedDecomposition[expr, {imetric, vector}] decomposes the tensors in expr in their longitudinal and transversal parts with respect to the induced metric imetric and its orthogonal vector.";
ToInducedDerivative::usage="ToInducedDerivative[expr, supercd, cd] converts the supercd-derivatives into the sum of an induced cd-derivative, a Lie derivative along the orthogonal vector of the projection and additional extrinsic curvature terms.";
VectorOfInducedMetric::usage="VectorOfInducedMetric[metric] returns the vector to which the induced metric is orthogonal.";
GaussCodazzi::usage="GaussCodazzi[expr, imetric] projects curvature tensors of the Levi-Civita connection of the metric from which imetric is induced into their projected components.";

(* Product metrics *)
MetricScalar::usage="MetricScalar[metric, subvbundle] gives the scalar that relates metric (of a product manifold) with the metric of the subvbundle.";
ExpandProductMetric::usage="ExpandProductMetric[expr, metric] expands expr decomposing all instances of the product metric and its derived curvature tensors in terms of the objects of the subvbundle that form the vbundle of metric. If the second argument is a list of product metrics the command is applied sequentially on expr.";

(* Tetra *)
Tetra::usage="Tetra[metric] returns the name of the tetra-metric associated to metric.";
TetraRule::usage="TetraRule[metric] gives the list of rules translating the tetra-metric of metric into products of metric and an imaginary term with the volume form of metric.";

1.1.13. Calculations

(* Calculations *)
ScreenDollarIndices::usage="ScreenDollarIndices[expr] replaces internal dummies (dollar-indices) by new non-dollar dummies for output.";
Simplification::usage="Simplification[expr] simplifies expr by calling Simplify[ ToCanonical[expr] ].";
Validate::usage="Validate[expr] checks that the tensorial expression expr 1) does not have unknown heads, 2) does not have objects with invalid index structure, 3) does have homogeneous free indices and 4) does not have repeated indices. There is a wrapping Catch.";
(* UncatchedValidate::usage="UncatchedValidate[expr] is equivalente to Validate[expr] but without the wrapping Catch."; *)
IndexSolve::usage="IndexSolve[eqn, tensor] solves a linear equation eqn for tensor, returning a rule (see MakeRule). Currently that tensor cannot have contracted indices. Options to IndexSolve are understood as options to MakeRule.";
IndexCoefficient::usage="IndexCoefficient[expr, form] gives the coefficient of form (any indexed object with no division present) in expr.";
ChangeFreeIndices::usage="ChangeFreeIndices[expr, newfrees] changes the free indices in expr (after sorting them with IndexSort) by indices in the list newfrees, changing the dummies of expr which could interfere with any of those new indices.";
EqualExpressionsQ::usage="EqualExpressionsQ[expr1, expr2] returns True if there is a permutation of the free indices of expr1 such that its canonical form equals that of expr2, and False otherwise.";
IndexCollect::usage="IndexCollect[expr, form, function] imitates the action of Collect, but allowing indexed expressions in form. This is still a very limited function, almost experimental.";
SetCharacters::usage="SetCharacters[expr, tensor, chars] returns expr with all instances of tensor[inds] corrected to match the characters chars, a list of elements Up or Down. The command introduces deltas, which automatically transform into metrics or Basis objects if required.";

1.1.14. Color terms

ColorTerms::usage="ColorTerms[expr] uses the function ColorPositions (from the package ExpressionManipulation) to color the elements of the first level of expr, tagging them with their respective positions.";
ColorPositionsOfPattern::usage="ColoPositionsOfPattern[pattern][expr] uses the function ColorPositions (from the package ExpressionManipulation) to color the occurrences of pattern in expr, tagging them with their respective positions. Options can be passed to ColorPositions within the first pair of brackets.";

1.2. Begin Private

1.2.1. A Mathematica 5 bug with contexts. Fixed in Mathematica 6. Now deactivated

Nothing here goes into the package.

Currently there are four contexts in the $ContextPath. Note that none of them is Global`.

$ContextPath

and the current context is (because we are constructing the package)

$Context

There is a bug in Mathematica 5 (solved in 6). It creates symbols in $Context even if they already exists in one of the contexts of $ContextPath:

Note the contexts of the five capitals:

Context/@{C,D,K,N,O}

For reference, let us introduce capitals A and B. Capital A is defined in the package context:

A

Context[A]

Now we start the Private` context:

Begin["`Private`"]

That changes the current $Context:

$Context

but not the $ContextPath:

$ContextPath

Capital B is now defined in the Private context:

B

Therefore these three are all different:

Context/@{A,B,C}

The problem is that if we do

Module[{A$,B$,C$,D$,K$,N$,O$},Print[{A$,B$,C$,D$,K$,N$,O$}]]

This was the result with Mathematica 5:

Context/@{A,B,C,D,K,N,O}

Now it is

Context/@{A,B,C,D,K,N,O}

We see that symbols without dollar have been created in the xAct`xTensor`Private` context (the current $Context). It seems that the dollars in the variables in the Module list have been removed because the ouput variables contain just a single $ and not two, as I would have expected. I think this is a bug because it didn't happen in the previous 4.* versions of Mathematica. Developers from Wolfram Research Inc. tell me that you are not supposed to use something like C$ in the Module list, but I really want to do it. This problem is present in all 5.* versions of Mathematica and has been solved in 6.0.

The most important consequence of this is that now the System` variables are shadowed by the xAct`xTensor`Private` symbols. If we now try to take a derivative nothing happens because D here is xAct`xTensor`Private`D and not System`D:

D[f[x],x]

D[f[x],x]

System`D[f[x],x]

Clean up:

Remove[A,B,C,D,K,N,O]

Remove[xAct`xTensor`A,xAct`xTensor`Private`B]

Now we get again

Context/@{C,D,K,N,O}

End[]

This problem is closely related to the problem of the most appropriate context for the capitals C, D, K, N, O. The fact that Mathematica might generate new symbols in the $Context means that probably this is the best place to put those symbols when they are indices. During a normal session that context will be Global`. Therefore my recommendation is to define indices Global`D, etc, and then use System`D when a derivative is required. However, xTensor will be prepared below to overload the system capitals, and that will be the default option if the user doesn't worry about this problem.

1.2.2. Begin Private

Now we do start the private context:

Begin["`Private`"]

1.2.3. Context for the examples

In this notebook we shall follow this convention: examples are carried out in the Global` context, before ending the package, and therefore it is not possible to access xAct`xTensor`Private`  unless we append it to the $ContextPath:

BeginExamples[]:=(Set[$Context,"Global`"];Global`symbols=Names["Global`*"];Null)
Global`EndExamples[]:=(If[#=!={},Print["There are new symbols in Global`:",#]];Set[$Context,"xAct`xTensor`Private`"];Null)&@Complement[Names["Global`*"],Global`symbols]

The only problem is that writing xAct`xTensor`Private is rather long. We define (ONLY IN THIS NOTEBOOK):

$PreRead=ReplaceAll[#,expr_String:>StringReplace[expr,"xATP"->"xAct`xTensor`Private"]]&

The global variable $PreRead is not used by any of the xAct packages. I find it too dangerous.

1.3. Usage of functions. Private

All these usage messages do not go into the package.

1.3.1. Counting public symbols

$xTensorNames=Names["xAct`xTensor`*"];

$xTensorNames

$xTensorDollarNames=Select[$xTensorNames,StringMatchQ[#,"$*"]&]

$xTensorNonDollarNames=Complement[$xTensorNames,$xTensorDollarNames]

Length/@{$xTensorNonDollarNames,$xTensorDollarNames,$xTensorNames}

Compare with the documentation files:

filename[string_String]:=StringReplacePart[StringReplacePart[string,"",{1,StringLength[$xActDocDirectory]+9}],"",{-3,-1}];
docfiles=filename/@FileNames[$xActDocDirectory<>"/xTensor/*.nb"];

These are the Mathematica builtins which have been overloaded:

Complement[docfiles,$xTensorNames]

?Complex

?Real

?Verbose

These are the missing symbols to document:

toclassify1=Complement[$xTensorNames,docfiles]

Length[%]

toclassify2={"Conformal"->{"ConformalFactor","ConformalRules","ConformalTo","SetConformalTo","ChristoffelToGradConformal"},
"Mapping"->{"At","CartesianProduct","DefMapping","DiffeomorphismQ","ExpandPullBack","ExpandPushForward","IdentityMapping","ImmersionQ","InverseMapping","InvertibleQ","LinearPush","Mapping","MappingDomain","MappingImage","MappingQ","Precompose","PullBack","PullBackCovD","PullBackTensor","PullBackVBundle","PushForward","PushForwardTensor","SubmersionQ","TangentTensor","UndefMapping","$Mappings"},
"Projectors"->{"ContractProjector","DisjointVBundlesQ","ProjectorQ","SetSplitTensors","SplitManifold","SplitTensor","SplitVBundle","FromProjected","Project","Projected","$ProjectedFormat","MakeProjectors","OrthogonalWithMetric","OrthogonalToVectorQ"},
"Symmetries"->{"Cyclize","ExpandSdelta","Sdelta","Sym"},
"Derivatives"->{"LC","DependenciesOfCovD","DirCovDToLieD","FromTensorDerivative","Explode","Implode","ImplicitTensorDepQ","Kretschmann","OtherDependencies","RiemannDown","RiemannDownToRiemann","RiemannToRiemannDown","ToTensorDerivative","$ImplodeInfoQ","TensorD","TensorDerivative","$ParamDFormat","Tetra","TetraRule","SymmetryGroupOfCovD","Leibnitz","GaussCodazzi"},
"Other"->{"AnyVBundles","DummyAs","FromStripped","Keep","LastIndex","PrintAsCharacter","RegisterIndices","SplittingsOfManifold","SplittingsOfVBundle","Stripped","ToStripped","IModQ","$DefInfoQ","$IndexListColor","$ScalarColor","$TensorBoxes","$UndefInfoQ","HeadOfTensor","MultiplyHead"},
"Complex"->{"AntihermitianQ","HermitianQ","Pair"},
"epsilon"->{"epsilonOrientation","epsilonOrientationInBasis"},
"Products"->{"AssociativeProductQ","Commutator","DefineCommutator","DefProduct","Grade","GradedProductQ","GradeOfCovD","GradeOfProduct","GradeOfTensor","IdentityElementOfProduct","ProductByScalar","ProductQ","ScalarsOfProduct","CommutativityOfProduct","UndefProduct","$Products"}
};

Complement[toclassify1,Flatten[Last/@toclassify2]]

Complement[Flatten[Last/@toclassify2],toclassify1]

Remove[filename,docfiles,toclassify1,toclassify2];

1.3.2. Types

(* Removing symbols *)
CheckRemoveSymbol::usage="xTensor`Private`CheckRemoveSymbol[symbol] throws an error if symbol has visitors or its master has other servants. Otherwise it gives Null.";
RemoveSymbol::usage="xTensor`Private`RemoveSymbol[symbol] unprotects (if protected) and removes symbol.";

(* Symbols relations *)
SymbolRelations::usage="xTensor`Private`SymbolRelations[symbol, master, hosts] defines the pair master-servant, and register symbol as a visitor of the given list of hosts. This function is listable in its first argument.";

(* Types *)
$Types::usage="xTensor`Private`$Types is a global variable containing the list of types currently defined in xTensor.";
$QFunctions::usage="xTensor`Private`$QFunctions is a global variable containing the list of Q-functions associated to the types in $Types.";

(* Box-formatting of expressions *)
SetPrintAs::usage="xTensor`Private`SetPrintAs[symbol, string] defines the PrintAs upvalue associated to the symbol to be the given string. It uses xUpSet or xUpSetDelayed to protect/unprotect symbol if required.";
AddDaggerCharacter::usage="xTensor`Private`AddDaggerCharacter[string, Conjugate] appends the $DaggerCharacter to string if it not present already. AddDaggerCharacter[string, dag] returns string for any other value of dag.";
PrintAsString::usage="xTensor`Private`PrintAsString[symbol, pa] returns pa if pa has head String. Otherwise it assumes pa is a function to be applied on symbol and returns ToString[pa[symbol]].";
interpretbox::usage="";
interpretboxcolor::usage="";
boxof::usage="";
MakeSequenceBox::usage="";

(* Def/Undef messages *)
makespace::usage="";
MakeDefInfo::usage="";
MakeUndefInfo::usage="";

1.3.3. Four simple types

$sfunctions::usage="xTensor`Private`$sfunctions is a global variable containing the list of functions which are initially defined as scalar-functions.";

SetDaggerPair::usage="";

1.3.4. The mathematical input

ListOfTerms::usage="xTensor`Private`ListOfTerms[expr] gives the list of elements of expr if its head is Plus and {expr} otherwise. The expression expr is evaluated and expanded (using Expand) before checking its head.";
ListOfFactors::usage="xTensor`Private`ListOfFactors[expr] gives the list of elements of expr if its head is Times and {expr} otherwise. The expression expr is evaluated and factored (usign Factor) before checking its head.";

MathInputExpand::usage="xTensor`Private`MathInputExpand[expr] applies Expand to expr using FixedPoint.";
NonIndexedScalarQ::usage="xTensor`Private`NonIndexedScalarQ[expr] returns True if expr is an explicit scalar: Scalar[x], tensor[], constant, parameter, scalar-function[x].";

1.3.5. Indices

(* Index validation *)
ValidateIndex::usage="xTensor`Private`ValidateIndex[i] checks that i is a valid symbol, that it does not have an associated type, and gives a warning message if it is one of the capitals that Mathematica uses. xTensor`Private`ValidateIndex[i, False] does not give that warning message.";
ValidateGIndex::usage="";
ValidateIndexList::usage="";
ModuleNumberOfIndex::usage="ModuleNumberOfIndex[i] returns the value of $ModuleNumber at the time of definition of the abstract index i. This is used to remove the dollar indices associated to i in UndefAbstractIndex.";
RemoveDollarIndices::usage="";
IndexOnQ::usage="xTensor`Private`IndexOnQ[i, vbundle] gives True if index i belongs to the bundle vbundle (or to a subvbundle of vbundle) and False otherwise. xTensor`Private`IndexQ[i, {vb1, vb2, ...}] gives True if index i belongs to one of the bundles (or their subvbundles) in the list {vb1, vb2, ...}.";

(* Index notations *)
upQ::usage="xTensor`Private`upQ[ind] gives True if ind is an up-index and False otherwise.";
downQ::usage="xTensor`Private`downQ[ind] gives True if ind is a down-index and False otherwise.";
NoDollar::usage="xTensor`Private`NoDollar[ind] returns the symbol ind (possibly including a sign) removing all characters starting from the first $. Values are stored as upvalues of the index ind.";
DollarQ::usage="xTensor`Private`DollarQ[ind] and DollarQ[-ind] give True if ind contains the character $ and False otherwise.";
DaggerIndexQ::usage="";
PatternToIndex::usage="xTensor`Private`PatternToIndex[expr] changes every pattern, patterntest or condition in expr to the name of the pattern, patterntest or condition.";
IndexPosition::usage="xTensor`Private`IndexPosition[list, ind] gives the positions of index ind in list. The index ind can be an up/down-index and the list can have any head.";

(* Defining free and paired indices *)
TakeOrderedEPairs::usage="xTensor`Private`TakeOrderedEPairs[indlist] gives the list of g-indices in list indlist which are paired, keeping the original order.";
TakeFrees::usage="xTensor`Private`TakeFrees[indlist] gives the list of g-indices in list indlist which are not paired. The original order is not kept.";
TakeEIndices::usage="";
TakeEPairs::usage="";

(* Sorting *)
Sort0::usage="xTensor`Private`Sort0 is an internal function sorting the types of indices: 1) labels, 2) patterns, 3) directions, 4) integer bases, 5) symbol bases, 6) abstract-indices.";
Sort1::usage="xTensor`Private`Sort1 is an internal function specifying the first priority for sorting indices.";Sort2::usage="xTensor`Private`Sort2 is an internal function specifying the second priority for sorting indices.";
Sort3::usage="xTensor`Private`Sort3 is an internal function specifying the third priority for sorting indices.";
SortPriority::usage="xTensor`Private`SortPriority[string] returns the function to be used for index sorting associated to the given string priority: one of \"up\"/\"down\", \"free\"/\"dummy\", \"lexicographic\"/\"antilexicographic\"/\"positional\"/\"antipositional\".";
validpriority::usage="";

(* Finding indices *)
IndexName::usage="xTensor`Private`IndexName[i] returns the so-called name of the g-index i. For abstract indices, the name equals the index. For basis indices, it returns the corresponding abstract index or 0 for a component index. For directional indices, labels and Blanks the name is also defined as 0.";
IndexType::usage="";
CheckHomogeneity::usage="";
check::usage="";
CheckRepeated::usage="";
CheckIndexType::usage="";
check2::usage="";
FindIndices1::usage="";
FindFreeAndDummyIndices::usage="xTensor`Private`FindFreeAndDummyIndices[expr] gives a list containing FindFreeIndices[expr] and FindDummyIndices[expr] respectively. See notes for those functions.";
TakeRepeated::usage="xTensor`Private`TakeRepeated[list] returns the list of indices which are repeated in the list (both input and output lists with head IndexList).";
TakeUp::usage="";
UltraindexOf::usage="xTensor`Private`UltraindexOf[expr] checks that expr is a covariant or a contravariant vector and returns its free index. On Pattern expressions it gives None.";
checkultraindex::usage="";

(* Replacing indices *)
ReplaceOneIndex::usage="";
replacepattern::usage="xTensor`Private`replacepattern[patindex, rules, sign] replaces the pattern index patindex according to the rules. If the index is actually changed then a message is sent reporting about it and asking to contact JMM.";
ReplaceBasisIndex::usage="xTensor`Private`ReplaceBasisIndex[biold, binew, rules] replaces the basis index biold. It first tries to use the rules on the abstract index of biold, keeping the basis. If that does not produce a change then binew is returned.";
ReplaceIndexList::usage="";
HoldReplaceIndex::usage="";
ReplaceDummies2::usage="";
FastReplaceDummies::usage="";
SameVBundleRules::usage="";
md::usage="";

1.3.6. Manifolds and vector bundles

(* Manifolds *)
checkDefManifold::usage="";
RegisterIndexInVBundle::usage="xTensor`Private`RegisterIndexInVBundle[ind, vb] registers the abstract index ind (a symbol) in the vbundle vb.";
checkDefVBundle::usage="";
RegisterVBundle::usage="";

(* Dependencies *)
DependenciesOfIndices::usage="xTensor`Private`DependenciesOfIndices";
DependenciesOfIndex::usage="xTensor`Private`DependenciesOfIndex";
SortDependencies::usage="xTensor`Private`SortDependencies";

(* VBundles *)
FirstMetricOfVBundle::usage="xAct`xTensor`Private`FirstMetricOfVBundle[vbundle] gives the first metric of the list MetricsOfVBundle[vbundle]. There is an optional Boolean second argument which decides if an error message is thrown in case that list is empty. The default is True.";
FirstMetricQ::usage="xAct`xTensor`Private`FirstMetricQ[metric] returns True if metric is the first-metric of some vbundle, and False otherwise. xAct`xTensor`Private`FirstMetricQ[metric, vbundle] returns True if metric is the first-metric of vbundle, False if it is not, and throws an error if vbundle has no metrics.";
$FirstMetrics::usage="xAct`xTensor`Private`$FirstMetrics is a global variable containing the list of all metrics which are first-metric of some vbundle.";

1.3.7. Formatting

AddIndex::usage="AddIndex[{downstring, upstring}, index] adds index to downstring or upstring depending on whether index is covariant or contravariant, respectively, and a space to the other. It returns the new pair of strings.\n
    AddIndex[{downstring, upstring}, index, covd] adds the symbol of derivative covd and index to downstring or upstring depending on whether index is covariant or contravariant, respectively, and two spaces to the other. It returns the new pair of strings.";
AddLastQuote::usage="";
DropLastQuote::usage="";
horizonal::usage="";
addIndex::usage="";

screenrules::usage="";
screenindices::usage="";
screenreplace::usage="";

getindex::usage="";
IndexPair::usage="";
UpIndexPair::usage="";

1.3.8. Tensors

checkSetOrthogonal::usage="xTensor`Private`checkSetOrthogonal[inds, ind] checks compatibility between the list of indices inds and the index ind.";
checkSetProjected::usage="";
ValidateTensor::usage="xAct`xTensor`Private`ValidateTensor[tensor[inds]] validates the name, indices and index-structure of the given tensor.";
ValidateDir::usage="";
ParametersOfTensor::usage="xTensor`Private`ParametersOfTensor";
ManifoldsOfTensor::usage="xTensor`Private`ManifoldsOfTensor";

1.3.0. Rules

(* Rules *)
MakeRule1::usage="xAct`xTensor`Private`MakeRule1[{LHS, RHS}] gives a delayed rule with left and right hand sides as given by LHS and RHS respectively. See notes for its options MetricOn and TestIndices. MakeRule1[{LHS, RHS, conditions}] adds conditions to the rules.";
SymmetryEquivalentsOfTensor::usage="xAct`xTensor`Private`SymmetryEquivalentsOfTensor[tensor[indices], freeinds] gives a list of tensors which are equivalent to the given tensor (with free indices freeinds) from the symmetry point of view, but are not equal from the pattern point of view.";
SymmetryEquivalentsOf::usage="";

1.3.10. Covariant derivatives

RiemannToWeylRules::usage="RiemannToWeylRules[covd] gives the list of rules that are applied by RiemannToWeyl.";
WeylToRiemannRules::usage="WeylToRiemannRules[covd] gives the list of rules that are applied by WeylToRiemann.";
RicciToEinsteinRules::usage="RicciToEinsteinRules[covd] gives the list of rules that are applied by RicciToEinstein.";
EinsteinToRicciRules::usage="EinsteinToRicciRules[covd] gives the list of rules that are applied by EinsteinToRicci.";
MetricToProjectorRules::usage="MetricToProjectorRules[metric] gives the list of rules that are applied by MetricToProjector.";
ProjectorToMetricRules::usage="ProjectorToMetricRules[metric] gives the list of rules that are applied by ProjectorToMetric.";
ValidateCovD::usage"ValidateCovD[covd[ind][expr]] validates the name, index and compatibility of the given covariant derivative. It uses Validate on expr.";
ZeroDerivativeQ::usage="";
MakeOrthogonalDerivative::usage="";
MakeProjectedDerivative::usage="";
InducedCovDQ::usage="";

1.3.11. Lie derivatives

ValidateLieD::usage="ValidateLieD[LieD[v][expr]] validates that that v is a contravariant vector and uses Validate on expr.";

1.3.12. Canonicalization

(* Canonicalization *)
ToCanonicalOne::usage="";

(* Sorting tensors *)
ObjectsWithIndices::usage="ObjectsWithIndices[term, index] yields the objects in term (a Times product) that have the given index. ObjectsWithIndices[term, indlist] yields a list of objects in term having one or several of the indices in indlist.";
FindMonomial::usage="FindMonomial[term, index, frees] gives the monomial (contracted product of tensors) in term (a Times product containing tensors) that has the given index. The list frees is the list of free indices of term, supplied to avoid repetition of its computation.";
ObjectOrder::usage="";
CommutingObjects::usage="";

1.3.13. Metrics

(* Metrics *)
ContractMetric1::usage="ContractMetric1[expr, metric] contracts all instances of metric in expr.";
ProductMetricRules::usage="ProductMetricRules[metric] gives the list of rules that are applied by ExpandProductMetric.";
FrozenMetricQ::usage="";

1.3.14. Collect symbols

$xTensorPrivateNames=Names["xAct`xTensor`Private`*"]

Length[%]

2. Types

(******************************* 2.Types ******************************)

{TimeUsed[],SessionTime[],TimeUsed[]/SessionTime[]}

2.0. Comments

Mathematica  is an untyped system, but I think it is convenient to use a type-definition system to do tensor calculus. Here we construct our own type system.

If[$ReadingVerbose,Print["Reading section 2: Types."],Null,Null]

2.0.1. Symbols versus strings

Note the difference between symbols and names: names are always strings; symbols have names. From strings to symbols use Symbol:

Symbol["hello"]

Head[%]

or the more general ToExpression. From symbols to strings use SymbolName:

SymbolName[%%]

Head[%]

or the more general ToString.

A first major decision in the design of xTensor is the following: all objects will be identified with symbols (not strings) in order to associate them the corresponding definitions (it is not possible to associate definitions to strings). This follows both the rule of simplicity and the rule of compliance with Mathematica's way. This decision has, however, several drawbacks:
	1) Many symbols are already used by Mathematica, or by xTensor, xPerm, xCoba, xCore. Those symbols will not be allowed to represent  xTensor objects. We shall define a set of functions that store the known symbols and analyze whether a candidate name for a new object is allowed or not. We will see that there are a few special cases.
	2) Defined symbols will have a "type". A symbol cannot have two types to avoid conflicting information. We could introduce contexts Tensor`, Spinor`, Form`, etc, but it is not clear what it would really improve. I think it is more flexible to let the user decide two different names to distinguish the objects.
	3) A symbol can have ownvalues. For example if T is a tensor we can also say T=1, which will generate all kinds of errors. This is normal Mathematica: if you have a function f[x] you can say f=1. A way of avoiding this could be protecting the symbol of any defined object, but this requires unprotecting symbols when you want to associate new definitions to them. We introduce the global variable $ProtectNewSymbols and the option ProtectNewSymbol to control this point, together with some xCore functions xUpSet and similar which are able to unprotect/reprotect symbols.

f[x_]:=x^2

f[3]

f=1

?f

The ownvalue for f is used before its downvalue:

f[3]

Remove[f,x,hello]

The basic use of symbols rather than strings can be compared to GRTensor's input, based on strings. The strings give you more flexibility in the notations, but heavily rely on the parser. In other words, because the user cannot modify the parser, it is difficult for the user to use tricks of the system without changing the code of the package. Working with symbols has the problems referred to above and does not allow beautiful notations such as using parenthesis for symmetrization of indices. However it is much closer to Mathematica's spirit and allows the user to interact closely with the internals of the package because there is no parser acting as interface. There is an important comment here: if I had to write a system for other users I would write a parser; but because I am the the main user of xTensor, I don't want to have a parser.

2.0.2. Tagging versus no-tagging

Good programming suggests to tag values of a given type with the name of the type, as in Tensor[T, ...] (or Tensor[T][...], as recommended by Maeder), rather than using the simpler form T[...]. Advantages of tagging:
	- Clarity
	- Efficient pattern matching
	- Safety
Disadvantages:
	- Harder to type in and read
	- The depth-1 restriction of upvalues in Mathematica becomes a depth-0 restriction.

Mathematica only defines up-values for symbols at levels 0 and 1 of the full expression. For example the definition T[a]T[-a]:=1 can be associated to the symbol T, but the definition Tensor[T,{a},{}] Tensor[T,{},{a}]:=1 can only be associated to the symbol Tensor, because the symbol T is too deep (level 2):

BeginExamples[]

This is not valid:

T/:Tensor[T,{a},{}]Tensor[T,{},{a}]:=1

?T

This is correct:

T/:T[a]T[-a]:=1

?T

T[a]T[-a]

Clear[T]

An alternative (certainly ugly), based on the idea that the symbolic-head of an expression is always found no matter how many pairs of brackets there are, could be:

T/: T[Tensor][{a},{}]T[Tensor][{},{a}]:=1

?T

Remove[T,a]

EndExamples[]

Currently we do not use tagging. (This is probably the most important design decision in xTensor, and it is unlikely to change in future versions.) We introduce a  number of checking functions xTensorQ, etc. such that objects of the corresponding type are given True upvalues for the function, which is itself defined as False on any other input. The main point is the difference in efficiency. I estimate that the Q functions are slower by a factor between 3 and 6, but they take very little anyway with respect to the global computation time.

I must say that when I have asked the Mathematica developers about this issue they have also recommended me this option, though they also mention the loss of efficiency...

2.0.3. Types of symbols

Currently there are 14 types of definable symbols:
	AbstractIndex: abstract indices
	Tensor: tensors of the form T[ inds ] (with Metric as a special case)
	CovD: operators of the form CD[ ind ][   ] or perhaps CD[ inds ][   ]
	ScalarFunction: function mapping (possibly several) scalars to scalars
	InertHead: a head that does not change the type and properties of an object. Assume its first argument is tensorial, but not the rest
	Product: a product of tensorial objects, generalizing our use of Times
	Manifold
	Mapping
	VBundle
	Parameter
	ConstantSymbol
	Basis (in xCoba)
	Chart (in xCoba)
	Metric: particular type of tensor

Functions that must use types of objects because they expect a generic mathinput expr:
	- FindAllOfType
	- FindIndices
	- ReplaceIndex
	- IsIndexOf
	- SymmetryOf
	- ContractMetric
	- Scalar
	- DependenciesOf
	- WeightOf
Then we have other functions using types, though not through mathinput:
	- ValidateSymbolInSession
	- IndexForm

2.1. Protection of symbols

An additional decision: defined objects are not protected by default .

?$ProtectNewSymbols

Its default value is False:

$ProtectNewSymbols=False;

But here we want to check it:

$ProtectNewSymbols=True;

2.2. Symbol relations

There are symbols which require others to exist previously (like a tensor field needs a manifold) and there are symbols which force simultaneuous existence of others (like a connection requires existence of its Riemann tensor). These two types of relations are important when defining and undefining symbols. We shall introduce the following silly terminology:
	- A symbol (like that tensor) is a "visitor" of a previously defined "host" symbol (like that manifold). Any symbol has a list of visitors and a list of hosts.
	- A symbol (like the connection) is a "master" for the symbols which it requires to be defined, to be called "servants". Any symbol has a master (default Null) and a list of servants.
	
There is the question of whether a symbol can have several masters. I currently think this is impossible because we would have to define and undefine all together, and if that is the case we can well define one of them as master and the rest as servants of that one.
	
Those lists will be upvalues of the symbols when they are not empty. They will have empty default definitions in general.

?HostsOf

?VisitorsOf

?ServantsOf

?MasterOf

ServantsOf[Symbol]={delta,Gdelta,Sdelta,Basis,PD};
HostsOf[_]:={};
VisitorsOf[_]:={};
MasterOf[_]:=Null;
ServantsOf[_]:={};
SetNumberOfArguments[#,1]&/@{HostsOf,VisitorsOf,MasterOf,ServantsOf};
Protect[HostsOf,VisitorsOf,MasterOf,ServantsOf];

A symbol which cannot be removed can be made servant of a non-removable symbol. I choose the symbol Symbol, and certain objects (now delta, Gdelta, Sdelta, Basis and PD) will have Symbol as master.

Trivial coding. Note that we drop the master (and its master, and so on) from the list of hosts; that is, a symbol cannot be simultaneously servant and visitor: if we ask for both it will be a servant. This function assumes that symbol is unprotected because it is called during the declaration of the symbol:

SymbolRelations[list_List,master_Symbol,hosts_List]:=SymbolRelations[#,master,hosts]&/@list;
SymbolRelations[symbol_Symbol,master_Symbol,hosts_List]:=With[{hosts2=Complement[hosts,FixedPointList[MasterOf,master]]},
If[master=!=Null,
MasterOf[symbol]^=master;
xUpAppendTo[ServantsOf[master],symbol]
];
If[hosts2=!={},xUpSet[HostsOf[symbol],Join[HostsOf[symbol],hosts2]]];
Map[If[!MemberQ[VisitorsOf[#],symbol],xUpAppendTo[VisitorsOf[#],symbol]]&,hosts2];
];

The master of a declared symbol can be specified at declaration time, using the option Master:

Protect[Master];

2.3. Removing symbols

This function removes a symbol, unprotecting it first if needed. Note that we do not have the head Symbol in the pattern because sometimes we use it with a symbol-name (a string); this is when the symbol has an ownvalue and hence we need to avoid its evaluation. QUESTION: Why do we do that? Wouldn't it be better to use a holding attribute?

?RemoveSymbol

RemoveSymbol[symbol_]:=(Unprotect[symbol];Remove[symbol];);

Before removing a symbol we check that the symbol can be actually removed:

?CheckRemoveSymbol

CheckRemoveSymbol[symbol_Symbol]:=Which[
VisitorsOf[symbol]=!={},
Throw@Message[General::noundef,"Symbol",symbol,"it has visitors"],
ServantsOf[MasterOf[symbol]]=!={},
Throw@Message[General::noundef,"Symbol",symbol,"its master is still alive"],
True,
Null];

After checking that a symbol can be removed, we have to drop it from the lists of visitors of its hosts:

DropFromHosts[symbol_Symbol]:=Map[xUpDeleteCasesTo[VisitorsOf[#],symbol]&,HostsOf[symbol]];

2.4. Initialize type treatment

2.4.1. Basic functions and variables

These 14 names define the types of symbols and will be used for several purposes in the package. Users should not use them for their own purposes:

?$Types

$Types={AbstractIndex,Manifold,Mapping,VBundle,Tensor,Metric,CovD,InertHead,ScalarFunction,ConstantSymbol,Parameter,Product,Chart,Basis};

Protect/@$Types;

The word Constant is already used and protected by Mathematica. It will be never used in xTensor. Product is also already protected.

Lists of objects (apart from $Types, already defined). These global variables are all public:

(* Main 14 data bases *)
$Manifolds={};
$Mappings={};
$VBundles={};
$AbstractIndices:=Flatten[IndicesOfVBundle/@$VBundles];
$ConstantSymbols={};
$Tensors={};
$CovDs={};
$Metrics={};
$InertHeads={};
$ScalarFunctions={};
$Parameters={};
$Products={};
$Bases={};
$Charts={};
(* Additional 4 data bases, apart from the private $FirstMetrics *)
$ProductManifolds={};
$SumVBundles={};
$ProductMetrics={};
$Rules={};

Inquiring functions (predicates) for types  (ProductManifoldQ is considered to be included in ManifoldQ; ProductMetricQ is considered to be included in MetricQ; we write xTensorQ rather than TensorQ because Mathematica has a built-in TensorQ from version 5.):

??TensorQ

?xTensorQ

$QFunctions={AbstractIndexQ,ConstantSymbolQ,xTensorQ,CovDQ,MetricQ,ManifoldQ,MappingQ,VBundleQ,InertHeadQ,ScalarFunctionQ,BasisQ,ChartQ,ParameterQ,ProductQ};

All typeQ functions must be handled using upvalues. With unknown symbols they all give False, without errors (because these functions will be used on all kinds of input, including Mathematica expressions):

SetDelayed[#[_],False]&/@$QFunctions;

They only accept one argument.

SetNumberOfArguments[#,1]&/@$QFunctions;

Protect them because they will be used only in the assignments of upvalues for symbols.

Protect[Evaluate[$QFunctions]];

Example:

??AbstractIndexQ

2.4.2. FindAllOfType

We use Heads->True, so that we find the objects in heads (for example in the vector field of a Lie Derivative or in InChart). This function evaluates its argument. Right now it is used in MakeRule to look for tensors, and in ToValues in xCoba to detect which tensors we need values for.

?FindAllOfType

FindAllOfType[expr_,AbstractIndex]:=Cases[expr,_Symbol?AbstractIndexQ,{0,∞},Heads->True];
FindAllOfType[expr_,ConstantSymbol]:=Cases[expr,_Symbol?ConstantSymbolQ,{0,∞},Heads->True];
FindAllOfType[expr_,Parameter]:=Cases[expr,_Symbol?ParameterQ,{0,∞},Heads->True];
FindAllOfType[expr_,Manifold]:=Cases[expr,_?ManifoldQ,{0,∞},Heads->True];
FindAllOfType[expr_,Mapping]:=Cases[expr,_?MappingQ,{0,∞},Heads->True];
FindAllOfType[expr_,VBundle]:=Cases[expr,_?VBundleQ,{0,∞},Heads->True];
FindAllOfType[expr_,Tensor]:=Cases[expr,_?xTensorQ[___],{0,∞},Heads->True];
FindAllOfType[expr_,Metric]:=Cases[expr,_Symbol?MetricQ[_,_],{0,∞},Heads->True];
FindAllOfType[expr_,CovD]:=Cases[expr,_?CovDQ[__][_]|CovD[_,__],{0,∞},Heads->True];
FindAllOfType[expr_,InertHead]:=Cases[expr,_?InertHeadQ[__],{0,∞},Heads->True];
FindAllOfType[expr_,ScalarFunction]:=Cases[expr,_?ScalarFunctionQ[___],{0,∞},Heads->True];
FindAllOfType[expr_,Product]:=Cases[expr,_Symbol?ProductQ,{0,∞},Heads->True];
FindAllOfType[expr_,Chart]:=Cases[expr,_Symbol?ChartQ,{0,∞},Heads->True];
FindAllOfType[expr_,Basis]:=Cases[expr,Basis[_,_],{0,∞},Heads->True];
SetNumberOfArguments[FindAllOfType,2];
Protect[FindAllOfType];

Note that there is no Symbol head for ScalarFunction. This is to work with InChart in xCoba. From version 1.0 we have also relaxed the restriction in the tensor's heads, and in mappings, to include mapping composition.

Note that Basis is treated differently: we are not looking for all basis symbols, but for all Basis tensors, which is a very different thing. I don't remember why is that.

2.4.3. Undef

This function is a generic driver for undefinition:

?Undef

We give definitions for 12 types. The definition for metrics is not needed because we have the definition for tensors. I don't want to allow undefinition of indices through Undef and hence that generates an error. Note that here it does not make sense to remove the _Symbol specification in the patterns.

Undef[symbol_Symbol?ManifoldQ]:=UndefManifold[symbol];
Undef[symbol_Symbol?MappingQ]:=UndefMapping[symbol];
Undef[symbol_Symbol?VBundleQ]:=UndefVBundle[symbol];
Undef[symbol_Symbol?ParameterQ]:=UndefParameter[symbol];
Undef[symbol_Symbol?xTensorQ]:=UndefTensor[symbol];
Undef[symbol_Symbol?CovDQ]:=UndefCovD[symbol];
Undef[symbol_Symbol?ConstantSymbolQ]:=UndefConstantSymbol[symbol];
Undef[symbol_Symbol?ScalarFunctionQ]:=UndefScalarFunction[symbol];
Undef[symbol_Symbol?InertHeadQ]:=UndefInertHead[symbol];
Undef[symbol_Symbol?ProductQ]:=UndefProduct[symbol];
Undef[symbol_Symbol?ChartQ]:=xAct`xCoba`UndefChart[symbol];
Undef[symbol_Symbol?BasisQ]:=xAct`xCoba`UndefBasis[symbol];
Undef[symbol_Symbol?AbstractIndexQ]:=Throw@Message[Undef::nouse,"Undef","an abstract index"];
Undef[symbol_]:=Throw@Message[Undef::unknown,"symbol type of",symbol];
SetNumberOfArguments[Undef,1];
Protect[Undef];

TODO: It has been suggested that Undef[All], and perhaps even Undef[],  undefines everything in the current session. I think this may be useful to avoid quitting the kernel to restart afresh.

2.5. Validate new symbols in a session

We check that symbol is not a metric before checking that it is not a tensor. This function could be moved to xCore, but right now all types belong to xTensor, and so that does not make much sense.

ValidateSymbolInSession[symbol_]:=With[{name=ToString[symbol]},
Which[
AbstractIndexQ[symbol],
Throw@Message[ValidateSymbol::used,name,"as an abstract index"],
ConstantSymbolQ[symbol],
Throw@Message[ValidateSymbol::used,name,"as a constant-symbol"],
ParameterQ[symbol],
Throw@Message[ValidateSymbol::used,name,"as a parameter"],
ManifoldQ[symbol],
Throw@Message[ValidateSymbol::used,name,"as a manifold"],
MappingQ[symbol],
Throw@Message[ValidateSymbol::used,name,"as a mapping"],
VBundleQ[symbol],
Throw@Message[ValidateSymbol::used,name,"as a vector bundle"],
MetricQ[symbol],
Throw@Message[ValidateSymbol::used,name,"as a metric"],
xTensorQ[symbol],
Throw@Message[ValidateSymbol::used,name,"as a tensor"],
CovDQ[symbol],
Throw@Message[ValidateSymbol::used,name,"as a covariant derivative"],
ScalarFunctionQ[symbol],
Throw@Message[ValidateSymbol::used,name,"as a scalar function"],
InertHeadQ[symbol],
Throw@Message[ValidateSymbol::used,name,"as an inert head"],
ProductQ[symbol],
Throw@Message[ValidateSymbol::used,name,"as a product"],
ChartQ[symbol],
Throw@Message[ValidateSymbol::used,name,"as a chart"],
BasisQ[symbol],
Throw@Message[ValidateSymbol::used,name,"as a basis"]
]
];
SetNumberOfArguments[ValidateSymbolInSession,1];
Protect[ValidateSymbolInSession];

2.6. Formatting

All this could be done much better with newer capabilities of Mathematica...

2.6.1. Interpretation of boxes

We shall use InterpretationBox to allow cut-and-paste of box-formatted expressions. A problem is that InterpretationBox has attribute HoldAllComplete and hence we need to pass the box after full evaluation. We do it simply with the intermediate function interpretbox, which only holds its first argument (the expression). Note that the order interpretbox[ expr, box ] is reversed with respect to InterpretationBox[ box, expr ] because we want to hold expr, but not box. We also introduce AutoSpacing->False to give indices their proper sizes, and ShowAutoStyles->False to avoid the blue coloring of unknown symbols in Mathematica 6+. Thanks to Alessandro Stecchina for spotting the latter problem.

TODO: The fact that the second argument of interpretbox is evaluated is probably an evaluation leak. Can we avoid it?

SetAttributes[interpretbox,HoldFirst];
interpretbox[expr_,box_]:=InterpretationBox[
StyleBox[box,AutoSpacing->False,ShowAutoStyles->False],
expr,
Editable->False
];

Colored background (right now not being used, not even by Scalar, as originally planned. Nobody likes it!):

SetAttributes[interpretboxcolor,HoldFirst];
interpretboxcolor[expr_,box_,color_]:=interpretbox[expr,StyleBox[box,Background->color]];

Now that we have wrapped the boxes with InterpretationBox and StyleBox, we need a function to undo that:

boxof[InterpretationBox[box_,__]]:=boxof[box];
boxof[StyleBox[box_,__]]:=boxof[box];
boxof[box_]:=box;

Action on a list of arguments:

SetAttributes[MakeSequenceBox,HoldFirst];
MakeSequenceBox[list_List,char_,format_]:=RowBox@Riffle[Map[Function[Null,MakeBoxes[#,format],HoldFirst],Unevaluated[list]],char];

MakeSequenceBox[{"a","b","c"},",",StandardForm]

RawBoxes[%]

MakeSequenceBox[{"a"},",",StandardForm]

RawBoxes[%]

2.6.2. xTensorFormStart/Stop

These two functions start and stop formatting of different things. With an argument they only start/stop formatting for that class of objects. Products are not included among the classes because each product has its own MakeBoxes definition.

?xTensorFormStart

?xTensorFormStop

xTensorFormStart[]:=xTensorFormStart/@{InertHead,ConstantSymbol,Parameter,Tensor,CovD,LieD,ParamD};
xTensorFormStop[]:=xTensorFormStop/@{InertHead,ConstantSymbol,Parameter,Tensor,CovD,LieD,ParamD};
xTensorFormStart[x_]:=Throw@Message[xTensorFormStart::unknown,"class to format",ToString[x]];
xTensorFormStop[x_]:=Throw@Message[xTensorFormStop::unknown,"class to format",ToString[x]];
SetNumberOfArguments[xTensorFormStart,{0,1}];
SetNumberOfArguments[xTensorFormStop,{0,1}];

We do not protect them because they will be given particular definitions below.

TODO: There should be a xTensorForm command. I need to study the *Form commands.

2.6.3. PrintAs

These are functions to format symbols of objects. We need a discussion on why we use them instead of directly using Format. Currently the only reason is to have full control on the process. Format is one of those functions that does many things in an obscure way. Any defined symbol has its own PrintAs definition, including the abstract indices. In any other case PrintAs is simply ToString.

Addition in 1.1.4: We now accept box specifications in PrintAs. There is no System` function to detect what a box expression is, but there is System`Convert`TeXFormDump`BoxQ which contains all (or at least most) possibilities:

??System`Convert`TeXFormDump`BoxQ

(* A string is a string. Null means "do not set typesetting". Anything else is interpreted as a function *)
StripContext[string_String]:=Last@StringSplit[string,"`"];
PrintAsString[symbol_,Null]:=Null;
PrintAsString[symbol_,pa_String]:=pa;
PrintAsString[symbol_,pa_Hold]:=pa;
PrintAsString[symbol_,pa_?System`Convert`TeXFormDump`BoxQ]:=pa;
PrintAsString[symbol_,pa_]:=StripContext[
With[{res=pa[symbol]},
If[StringQ[res],res,ToString[res]]
]
];
(* Handling of conjugate symbols: add a dagger if not already present *)
AddDaggerCharacter[boxes_Hold,_]:=Print["Don't know how to conjugate ",boxes];
AddDaggerCharacter[string_String,Conjugate]:=If[HasDaggerCharacterQ[string],string,StringJoin[string,$DaggerCharacter]];
AddDaggerCharacter[boxes_,Conjugate]:=RowBox[{boxes,$DaggerCharacter}];
AddDaggerCharacter[boxes_,dag_]:=boxes;
(* Main. The previous two functions will be used in its second argument, if needed *)
SetPrintAs[symbol_,Null]:=Null;
SetPrintAs[symbol_,Hold[boxes_]]:=xUpSetDelayed[PrintAs[symbol],boxes];
SetPrintAs[symbol_,string_]:=xUpSet[PrintAs[symbol],string];

The PrintAs framework is very evaluation-leaky. This should be avoided, also generalizing the use of strings to general box expressions. TODO.

?PrintAs

SetAttributes[PrintAs,HoldFirst];
PrintAs[head_]:=ToString[Unevaluated[head]];
SetNumberOfArguments[PrintAs,1];
Protect[PrintAs];

Finally, a simple way to print with a very small font, currently only used with projectors.

(* STRINGPRINTAS *)
PrintAsSmaller[proj_]:="\*StyleBox[\""<>PrintAs[proj]<>"\",FontSize->Tiny]";

2.6.4. GiveSymbol, GiveOutputString, PrintAsCharacter

These functions give names to all tensors that are associated in real time to other previously defined **symbols**. GiveSymbol defines the internal (true) name of the tensors. GiveOutputString defines the PrintAs name for those tensors. Special definitions for special types of tensors will be defined below. Note that GiveSymbol returns a symbol but GiveOutputString returns a string.

?GiveSymbol

?GiveOutputString

?PrintAsCharacter

(* Default definition for the names of automatically-defined tensors. They must be symbols *)
GiveSymbol[symbol_Symbol,post___]:=SymbolJoin[symbol,post];
(* Do not put any restrictions here to make this definition be always the last downvalue. STRINGPRINTAS *)
GiveOutputString[symbol_Symbol,post___]:=StringJoin[PrintAsCharacter[symbol],PrintAs/@{post}];
SetAttributes[PrintAsCharacter,HoldFirst];
PrintAsCharacter[symbol_Symbol]:=First@Characters@ToString[Unevaluated[symbol]];
SetNumberOfArguments[GiveSymbol,{1,Infinity}];
SetNumberOfArguments[GiveOutputString,{1,Infinity}];
SetNumberOfArguments[PrintAsCharacter,1];

These functions cannot be protected because we will give particular definitions for them below.

2.6.5. TEX

We have a fully dedicated package now: TexAct.

2.6.6. Formatting pullbacks, pushforwards, etc

Utilities for formatting.

$StarCharacter="*";
$PrecomposeCharacter="∘";
$LinearPushCharacter="·";

PullBackString[string_String,phi_]:=StringJoin["(\!\(",PrintAs[phi],"\^",$StarCharacter,string,"\))"];
PrecomposeString[string_String,phi_]:=StringJoin["(",string,$PrecomposeCharacter,PrintAs[phi],")"];
PullBackBox[box_,phi_]:=RowBox[{SuperscriptBox[PrintAs[phi],$StarCharacter],box}];
PrecomposeBox[box_,phi_]:=RowBox[{box,$PrecomposeCharacter,PrintAs[phi]}];

PushForwardString[string_String,phi_]:=StringJoin["(\!\(",PrintAs[phi],"\_",$StarCharacter,string,"\))"];
LinearPushString[string_String,dphi_]:=StringJoin["(",PrintAs[dphi],$LinearPushCharacter,string,")"];
PushForwardBox[box_,phi_]:=RowBox[{SubscriptBox[PrintAs[phi],$StarCharacter],box}];

2.7. The Info messages: MakeDefInfo, MakeUndefInfo

These functions and variables control the info messages printed at definition and undefinition times. Those messages can be deactivated globally with $DefInfoQ=False and/or $UndefInfoQ=False, or locally with the option DefInfo->False. There is not yet an UndefInfo option.

Add a blank after any non-empty string:

makespace[""]:="";
makespace[other_]:=StringJoin[other," "];

The default value of DefInfo is controlled globally with the following global variable:

?$DefInfoQ

$DefInfoQ=True;

This function constructs all "defininig" messages (always three arguments, to avoid worrying about whether we have set up or not DefInfo already):

MakeDefInfo[_,_,False,vanishQ_:False]:=Null;
MakeDefInfo[command_Symbol,object_,{secondarytype_String,info_String,___},vanishQ_:False]:=If[$DefInfoQ,Print["** ",command,": Defining ",makespace@If[vanishQ,"vanishing "<>secondarytype,secondarytype], object,". ",info]];

Only objects registered through a DefType function have a value for DefInfo:

DefInfo[x_]:=Throw@Message[DefInfo::error1,"Object `1` has not been registered using a DefType function.",x];

Corresponding function for undefinition (False as third argument is currently not being used, because the UndefType functions do not have options):

?$UndefInfoQ

$UndefInfoQ=True;

MakeUndefInfo[command_Symbol,object_]:=MakeUndefInfo[command,object,DefInfo[object]];
MakeUndefInfo[command_Symbol,object_,False]:=Null;
MakeUndefInfo[command_Symbol,object_,{info_,_}]:=If[$UndefInfoQ,Print["** ",command,": Undefined ",info," ",object]];

Example:

BeginExamples[]

xATP`MakeDefInfo[DefTensor,T[a,-b],{"some tensor",""}]

Remove[a,b,T]

EndExamples[]

3. Four simple types

(*************************** 3. Four simple types ***************************)

{TimeUsed[],SessionTime[],TimeUsed[]/SessionTime[]}

3.0. Comments

If[$ReadingVerbose,Print["Reading section 3: Simple types."],Null,Null]

Just a comment: there is no need of efficiency in the Def-functions.

3.1. InertHeads. ERROR, Dagger and Keep

3.1.0. Comments

The concept of inert-head was designed initially in a very simple way, just as a slight modifier of a tensor expression, with the only property of representing a tensor expression whose indices and symmetries are exactly those of the wrapped expression. Now, mostly due to suggestions by Guillaume Faye, it has become clear that this concept must be expanded and clarified, making it far more powerful and useful.

The first issue is whether an inert-head must be linear or not necessarily. I think that the tensorial character of the expression is intimately connected with linearity. However, what happens if we want the inert-head to be antilinear? As pointed out by Guillaume, perhaps it could be even truly nonlinear. Another possibility is that of an inert-head that acts as a differential operator, and hence behaves differently on constants and scalar fields. Because it is very simple to do it, there is an option LinearQ->True/False at definition time to control that. The default will be False. Linearity is with respect to constants, and not with respect to scalar fields.

The second issue is whether the metric or the delta tensor can be contracted through the inert-head. In general this is not true, and another option ContractThrough controls that point. Think of the inert-head TracelessPart as an example.

A third point is what kind of additional arguments an inert-head can have. In principle we could have many more arguments, with the only restriction that the "wrapped expression" is in the first argument. Other arguments can contain indexed tensors, but these tensors will not be seen by xTensor. I cannot think of a single example where such a thing could be needed. Then we can have arguments containing indices, and there are clear examples of that. Those indices could be a subset of the indices of the tensor expression or could be additional indices (some kind of "extension" of the expression). Those indices are simply marked with the head IndexList. We assume that the indices of the whole expression are the unsorted union of the indices of the expression and the additional indices. All commands must ensure synchronicity of both sets of indices, in case such a thing is expected; that is, if indices are repeated  in the inert-head and we do some index replacement then those indices must be repeated at the end too.

3.1.1. Definition

A prototypical example of an inert-head is TracelessPart. We can have expressions like TracelessPart[ T[a,b] ] with obvious meaning. Considered as a tensor, TracelessPart[ T[a,b] ] inherits all symmetry properties from T[a,b] and has more.

Following Leo, xAct 1.1.0 accepts nonatomic inert heads, and actually DefInertHead does that too, which is something new in xAct. I mean, DefInertHead is the first command that defines something different from a symbol. Still, definitions are attached to the subhead (as computed by SubHead) of the defined object, which is always a symbol. This change requires deciding when to play with the whole inert head and when with its subhead, and I’m still not sure we got all decisions right yet...

?DefInertHead

We do not associate dependencies, hosts or visitors to the inert head; any holding attribute must be introduced by hand by the user. A general inert-head could have any number of arguments, but only the first one is assumed to be a tensor. QUESTION: Perhaps we should define anti-linear inert-heads. There is no predefined concept of complex conjugation here.

Options[DefInertHead]={
LinearQ->False,
ContractThrough->{},
Master->Null,
PrintAs->Identity,
ProtectNewSymbol:>$ProtectNewSymbols,
DefInfo->{"inert head",""}
};
DefInertHead[list_List,rest___]:=Scan[DefInertHead[#,rest]&,list];
DefInertHead[ih_,options:OptionsPattern[]]:=Catch@With[{head=SubHead[ih]},
Module[{lin,cthrough,master,pa,pns,info,x,y},
{lin,cthrough,master,pa,pns,info}=OptionValue[{LinearQ,ContractThrough,Master,PrintAs,ProtectNewSymbol,DefInfo}];
(* Validate *)
ValidateSymbol[head];
ValidateSymbolInSession[head];
(* Register *)
MakeDefInfo[DefInertHead,ih,info];
MakexTensions[DefInertHead,"Beginning",ih,options];
AppendToUnevaluated[$InertHeads,head];
head/:InertHeadQ[ih]=True;
head/:DefInfo[ih]=info;
SetPrintAs[ih,PrintAsString[ih,pa]];
SymbolRelations[head,master,{}];
(* Metric / projector / delta contraction *)
xTagSet[{head,ContractThroughQ[ih,#]},True]&/@Flatten[{cthrough}];
(* Linearity. Only with respect to constants, not general scalar fields *)
head/:LinearQ[ih]=lin;
If[lin,MakeLinear[ih,NoPattern[ih]]];
MakexTensions[DefInertHead,"End",ih,options];
(* Protect *)
If[pns,Protect[head]];
]
];
SetNumberOfArguments[DefInertHead,{1,Infinity}];
Protect[DefInertHead];

To avoid variable renaming on the LHS we need to send both ihL and ihR to MakeLinear.

MakeLinear[ihL_,ihR_]:=(
ihL[Verbatim[Times][l___,x_?ConstantQ,r___],z___]:=x ihR[Times[l,r],z];
ihL[sum_Plus,z___]:=ihR[#,z]&/@sum;
ihL[expr_SeriesData,z___]:=SeriesDataMap[ihR[#,z]&,expr];
ihL[0,z___]:=0;
);

Now that we accept nonatomic inert-heads containing tensorial objects, we need this function, as pointed out by Leo. It must be configured locally by the user; this is just the default:

DependenciesOfInertHead[ih_]:={};
SetNumberOfArguments[DependenciesOfInertHead,1];
Protect[DependenciesOfInertHead];

Note once more that linearity is only with respect to constants, and not with respect to scalars in general.

?LinearQ

LinearQ[x_]:=Throw@Message[LinearQ::unknown,"inert-head",x];
SetNumberOfArguments[LinearQ,1];
Protect[LinearQ];

This function states whether it is possible to contract a metric through the inert-head:

?ContractThrough

Protect[ContractThrough];

?ContractThroughQ

ContractThroughQ[ih_,metric_]:=False;
SetNumberOfArguments[ContractThroughQ,2];
Protect[ContractThroughQ];

Undefinition:

?UndefInertHead

UndefInertHead[list:{___?InertHeadQ}]:=Scan[UndefInertHead,list];
UndefInertHead[ih_]:=Catch@With[{head=SubHead[ih]},
With[{servants=ServantsOf[head]},
If[!InertHeadQ[ih],Throw@Message[UndefInertHead::unknown,"inert head",ih]];
CheckRemoveSymbol[head];
MakexTensions[UndefInertHead,"Beginning",ih];
xUpSet[ServantsOf[head],{}];
DropFromHosts[head];
Undef/@Reverse[servants];
$InertHeads=DeleteCases[$InertHeads,head];
MakexTensions[UndefInertHead,"End",ih];
MakeUndefInfo[UndefInertHead,ih];
RemoveSymbol[head];
]
];
SetNumberOfArguments[UndefInertHead,1];
Protect[UndefInertHead];

Examples:

BeginExamples[]

DefInertHead[TTPart,LinearQ->True]

?TTPart

$InertHeads

We have not defined yet ConstantQ, and so the integers are not taken out:

TTPart[2a-3b]

UndefInertHead[TTPart]

?TTPart

$InertHeads

Remove[a,b]

EndExamples[]

3.1.2. ERROR

We define the inert-head ERROR, that will be used in the validation routines. Note that we do not use DefInertHead to declare it:

SetAttributes[ERROR,HoldFirst]
InertHeadQ[ERROR]^=True;
LinearQ[ERROR]^=False;
DefInfo[ERROR]^={"inert head","Generic head to wrap expressions with errors."};
PrintAs[ERROR]^=ColorString["ERROR",Hue[0]];
AppendToUnevaluated[$InertHeads,ERROR];
Protect[ERROR];

??ERROR

3.1.3. Keep

Keep is just a wrapper to keep expressions protected from greedy actions, like derivatives that try to apply the Leibnitz rule or products that try to distribute over Plus.

InerthHeadQ[Keep]^=True;
LinearQ[Keep]^=True;
DefInfo[Keep]^={"inert head","Generic head to avoid expression expansion."};
AppendToUnevaluated[$InertHeads,Keep];
Protect[Keep];

It has its own formatting, with parentheses:

MakeBoxes[Keep[expr_,z___],StandardForm]:=RowBox[{"(",MakeBoxes[expr,StandardForm],")"}];

3.1.4. Formatting

Held version of InertHeadQ to avoid evaluation leaks during typesetting:

SetAttributes[HeldInertHeadQ,HoldAllComplete];
HeldInertHeadQ[expr_]:=InertHeadQ[Unevaluated[expr]];

Currently we forget about other but the first argument.

xTensorFormStart[InertHead]:=(
MakeBoxes[ih_?HeldInertHeadQ[expr_,z___],StandardForm]:=interpretbox[ih[expr,z],RowBox[{PrintAs[Unevaluated[ih]],"[",MakeBoxes[expr,StandardForm],"]"}]]);
xTensorFormStop[InertHead]:=(MakeBoxes[ih_?HeldInertHeadQ[expr_,z___],StandardForm]=.);
xTensorFormStart[InertHead]

BeginExamples[]

ERROR[hello]

Cut and paste:

ERROR[hello]

InputForm[%]

xTensorFormStop[InertHead]

ERROR[hello]

xTensorFormStart[InertHead]

%%

Remove[hello]

EndExamples[]

3.1.5. Dagger and DaggerQ

I don't want to overload the Conjugate command, so I introduce a new conjugation command, called Dagger. Formally, it is an (antilinear) inert-head:

?Dagger

InertHeadQ[Dagger]^=True;
LinearQ[Dagger]^=False;
PrintAs[Dagger]^="Dagger";
AppendToUnevaluated[$InertHeads,Dagger];

The definition on products means that we do not worry about angle-determinations:

(* Listability, linearity and product expansion *)
Dagger[expr_List]:=Dagger/@expr;
Dagger[expr_Equal]:=Dagger/@expr;
Dagger[expr_Plus]:=Dagger/@expr;
Dagger[HoldPattern[SeriesData[var_,orig_,coeffs_,rest__]]]:=SeriesData[Dagger[var],Dagger[orig],Dagger/@coeffs,rest];
Dagger[expr_Times]:=Dagger/@expr;
Dagger[HoldPattern@SeriesData[par_,origin_,coeffs_,args__]]:=SeriesData[Dagger[par],Dagger[origin],Dagger[coeffs],args];
(* Constant-symbols have an upvalue for Dagger *)
Dagger[x_?NumericQ]:=Conjugate[x];
(* All parameters assumed real *)
Dagger[param_Symbol?ParameterQ]:=param;
(* Integer powers *)
Dagger[Power[expr_,n_Integer]]:=Power[Dagger[expr],n];

(* Involutivity *)
Dagger[Dagger[expr_]]:=expr;

(* Action on composite types *)
Dagger[Scalar[expr_]]:=Scalar[Dagger[expr]];
Dagger[ParamD[ps__][expr_]]:=Map[Dagger,ParamD[ps]][Dagger[expr]];
Dagger[LieD[v_][expr_]]:=LieD[Dagger[v]][Dagger[expr]];
(* Covariant derivatives. So far we do not touch the covd head *)
Dagger[covd_?CovDQ[inds__][expr_]]:=DaggerCovD[covd[inds]][Dagger[expr]];
DaggerCovD[covd_[inds__]]:=Map[DaggerIndex,covd[inds]];
Dagger[CovD[expr_,covdinds__]]:=CovD[Dagger[expr],##]&@@Map[DaggerCovD,{covdinds}];
(* Action on tensors. Note that this includes Basis, Bracket and TensorDerivative *)
Dagger[tensor_?xTensorQ[inds___]]:=Apply[Dagger[tensor],DaggerIndex@IndexList[inds]];
(* QUESTION: Is there any "analyticity" assumption here? Why do we dagger sf itself? *)
Dagger[sf_?ScalarFunctionQ[args___]]:=Apply[Dagger[sf],Dagger/@{args}];
(* Scalar functions are assumed real by default *)
Dagger[sf_?ScalarFunctionQ]:=sf;
(* Mappings are taken as real because they are between real manifolds *)
Dagger[phi_?MappingQ]:=phi;

We have introduced the private function DaggerCovD to deal with the "Hermitian" spincovds with two indices.

We always want to get back something meaningful for symbols and indices. For indices we separate the command DaggerIndex, which will throw an error in case something is wrong. For symbols we add this special case:

(* Generic action on symbols *)
Dagger[x_Symbol]:=Throw@Message[Dagger::unknown,"conjugate of symbol",x];

There is no general definition for Dagger (except for symbols). Therefore Dagger may stay unevaluated during the evaluation process, being always treated as any other inert-head.

SetNumberOfArguments[Dagger,1];
Protect[Dagger];

The function DaggerQ says whether an expression is complex or not:

?DaggerQ

DaggerQ[expr_]:=UnsameQ[expr,Dagger[expr]];
SetNumberOfArguments[DaggerQ,1];
Protect[DaggerQ];

Private function to arrange the dagger pairs. It is almost symmetric. The only difference is that the function returns symbol2.

SetDaggerPair[symbol1_Symbol,symbol2_Symbol]:=(xUpSet[Dagger[symbol2],symbol1];xUpSet[Dagger[symbol1],symbol2]);
SetDaggerPair[x_,_Symbol]:=Throw@Message[Validate::nouse,"SetDaggerPair",x];
SetDaggerPair[_Symbol,x_]:=Throw@Message[Validate::nouse,"SetDaggerPair",x];

3.2. ScalarFunctions

3.2.0. Comments

A scalar-function is a general mapping from (ℝ^n) to ℝ, or perhaps from (ℂ^n) to ℂ. There is no concept yet of function from (ℝ^n) to (ℝ^m), and that's something which could be really useful. QUESTION: How can we do that? The obvious answer is using a list of scalar-functions, but it is not clear that we can assume that every list of objects can be treated as a mapping.

3.2.1. Definition

We do not allow mathematical functions with arguments which are not scalars. Only functions on scalars can be unambiguosly differentiated, for example. There is no need to declare how many arguments a scalar-function has.

?DefScalarFunction

We do not associate dependencies to the scalar-function. QUESTION: Why have we introduced the Validate option?

QUESTION: The whole issue of daggering a scalar-function is confusing. Why is it not enough to dagger its arguments? Why do we allow imaginary scalar functions for instance?

Options[DefScalarFunction]={Dagger->Real,Master->Null,PrintAs->Identity,ProtectNewSymbol:>$ProtectNewSymbols,DefInfo->{"scalar function",""},Validate->True};
DefScalarFunction[list_List,rest___]:=Scan[DefScalarFunction[#,rest]&,list];
DefScalarFunction[sf_,options:OptionsPattern[]]:=Catch@Module[{dag,master,pa,pns,info,val},
{dag,master,pa,pns,info,val}=OptionValue[{Dagger,Master,PrintAs,ProtectNewSymbol,DefInfo,Validate}];

(* Checks *)
If[val,
ValidateSymbol[sf];
ValidateSymbolInSession[sf]];

(* Register *)
MakeDefInfo[DefScalarFunction,sf,info];
MakexTensions[DefScalarFunction,"Beginning",sf,options];
Switch[dag,
Complex,SetDaggerPair[sf,MakeDaggerSymbol[sf]];DefScalarFunction[Dagger[sf],Dagger->Conjugate,Master->sf,options],
Conjugate,Null,
Imaginary,Dagger[sf]^=MultiplyHead[-1,sf],
Real,Dagger[sf]^=sf,
_,Throw@Message[DefScalarFunction::unknown,"Dagger value",dag]
];
AppendToUnevaluated[$ScalarFunctions,sf];
ScalarFunctionQ[sf]^=True;
DefInfo[sf]^=info;
SetPrintAs[sf,AddDaggerCharacter[PrintAsString[sf,pa],dag]];
SymbolRelations[sf,master,{}];
MakexTensions[DefScalarFunction,"End",sf,options];
If[pns,Protect[sf]];
];
SetNumberOfArguments[DefScalarFunction,{1,Infinity}];
Protect[DefScalarFunction];

All functions with attribute NumericFunction are scalar-functions by default, except for Times and Plus, which are always treated through special linear rules, because they admit tensors with free indices :

Unprotect[ScalarFunctionQ];
ScalarFunctionQ[Times|Plus]=False;
ScalarFunctionQ[Derivative[__Integer][f_]]:=ScalarFunctionQ[f];
ScalarFunctionQ[head_Symbol]:=MemberQ[Attributes[head],NumericFunction];
ScalarFunctionQ[_]:=False;
Protect[ScalarFunctionQ];

?UndefScalarFunction

UndefScalarFunction[list:{___?ScalarFunctionQ}]:=Scan[UndefScalarFunction,list];
UndefScalarFunction[sf_]:=Catch@With[{servants=ServantsOf[sf]},
If[!ScalarFunctionQ[sf],Throw[Message[UndefScalarFunction::unknown,"scalar function",sf]]];
CheckRemoveSymbol[sf];
MakexTensions[UndefScalarFunction,"Beginning",sf];
xUpSet[ServantsOf[sf],{}];
DropFromHosts[sf];
Undef/@Reverse[servants];
$ScalarFunctions=DeleteCases[$ScalarFunctions,sf];
MakexTensions[UndefScalarFunction,"End",sf];
MakeUndefInfo[UndefScalarFunction,sf];
RemoveSymbol[sf];
];
SetNumberOfArguments[UndefScalarFunction,1];
Protect[UndefScalarFunction];

It is not necessary to give head Scalar to the argument of a scalar function, but it does not hurt either.

We need an additional definition to detect derivatives of scalar functions:

?ScalarFunctionQ

3.2.2. Formatting

Held version of ScalarFunctionQ to avoid evaluation leaks during typesetting:

SetAttributes[HeldScalarFunctionQ,HoldAllComplete];
HeldScalarFunctionQ[expr_]:=ScalarFunctionQ[Unevaluated[expr]];

StandardForm. We only format the symbol itself, and not its arguments. QUESTION: Why do we need RowBox with one argument?

xTensorFormStart[ScalarFunction]:=(
MakeBoxes[sf_Symbol?HeldScalarFunctionQ,StandardForm]:=interpretbox[sf,RowBox[{PrintAs[Unevaluated[sf]]}]]);
xTensorFormStop[ScalarFunction]:=(MakeBoxes[sf_Symbol?HeldScalarFunctionQ,StandardForm]=.);
xTensorFormStart[ScalarFunction];

3.2.3. Examples

BeginExamples[]

DefScalarFunction[ff]

?ff

ScalarFunctionQ[ff]

ScalarFunctionQ[ff']

UndefScalarFunction[ff]

?ff

DefScalarFunction[ff,PrintAs->"F"]

?ff

ScalarFunctionQ[Derivative[0,0,1][ff]]

ff[a,b,c]

UndefScalarFunction[ff]

Remove[a,b,c]

EndExamples[]

3.3. ConstantSymbols

3.3.1. Definition

The attribute Constant pinpoints constant symbols with respect to Derivative. We need something similar for the xTensor derivatives. We introduce the type ConstantSymbol. Note that constants are real by default, but can also be complex or imaginary.

Options[DefConstantSymbol]={Dagger->Real,Master->Null,PrintAs->Identity,ProtectNewSymbol:>$ProtectNewSymbols,DefInfo->{"constant symbol",""},Validate->True};
DefConstantSymbol[list_List,rest___]:=Scan[DefConstantSymbol[#,rest]&,list];
DefConstantSymbol[symbol_,options:OptionsPattern[]]:=Catch@Module[{dag,master,pa,pns,info,val},
{dag,master,pa,pns,info,val}=OptionValue[{Dagger,Master,PrintAs,ProtectNewSymbol,DefInfo,Validate}];

(* Checks *)
If[val,
ValidateSymbol[symbol];
ValidateSymbolInSession[symbol]];

(* Register *)
MakeDefInfo[DefConstantSymbol,symbol,info];
MakexTensions[DefConstantSymbol,"Beginning",symbol,options];
Switch[dag,
Complex,SetDaggerPair[symbol,MakeDaggerSymbol[symbol]];DefConstantSymbol[Dagger[symbol],Dagger->Conjugate,Master->symbol,options],
Conjugate,Null,
Imaginary,Dagger[symbol]^=-symbol,
Real,Dagger[symbol]^=symbol,
_,Throw@Message[DefConstantSymbol::unknown,"Dagger value",dag]
];
AppendToUnevaluated[$ConstantSymbols,symbol];
ConstantSymbolQ[symbol]^=True;
SetAttributes[symbol,Constant];
DefInfo[symbol]^=info;
SetPrintAs[symbol,AddDaggerCharacter[PrintAsString[symbol,pa],dag]];
SymbolRelations[symbol,master,{}];
MakexTensions[DefConstantSymbol,"End",symbol,options];
If[pns,Protect[symbol]];
]
SetNumberOfArguments[DefConstantSymbol,{1,Infinity}];
Protect[DefConstantSymbol];

Undefinition:

UndefConstantSymbol[list:{___?ConstantSymbolQ}]:=Scan[UndefConstantSymbol,list];
UndefConstantSymbol[symbol_]:=Catch@With[{servants=ServantsOf[symbol]},
If[!ConstantSymbolQ[symbol],Throw@Message[UndefConstantSymbol::unknown,"constant-symbol",symbol]];
CheckRemoveSymbol[symbol];
MakexTensions[UndefConstantSymbol,"Beginning",symbol];
xUpSet[ServantsOf[symbol],{}];
DropFromHosts[symbol];
Undef/@Reverse[servants];
$ConstantSymbols=DeleteCases[$ConstantSymbols,symbol];
MakexTensions[UndefConstantSymbol,"End",symbol];
MakeUndefInfo[UndefConstantSymbol,symbol];
RemoveSymbol[symbol];
]
SetNumberOfArguments[UndefConstantSymbol,1];
Protect[UndefConstantSymbol];

Symbols with Constant attribute are constant-symbols.

Unprotect[ConstantSymbolQ];
ConstantSymbolQ[x_Symbol]:=MemberQ[Attributes[x],Constant];
Protect[ConstantSymbolQ];

3.3.2. Formatting

Held version of ConstantSymbolQ to avoid evaluation leaks during typesetting:

SetAttributes[HeldConstantSymbolQ,HoldAllComplete];
HeldConstantSymbolQ[expr_]:=ConstantSymbolQ[Unevaluated[expr]];

StandardForm:

xTensorFormStart[ConstantSymbol]:=(
MakeBoxes[x_Symbol?HeldConstantSymbolQ,StandardForm]:=interpretbox[x,RowBox[{PrintAs[Unevaluated[x]]}]]);
xTensorFormStop[ConstantSymbol]:=(MakeBoxes[x_Symbol?HeldConstantSymbolQ,StandardForm]=.);
xTensorFormStart[ConstantSymbol];

3.3.3. Examples

BeginExamples[]

DefConstantSymbol[Mass,PrintAs->"M"]

?Mass

Mass

ToBoxes[%]

InputForm[%%]

Cut and paste:

M

InputForm[%]

xTensorFormStop[ConstantSymbol]

Mass

xTensorFormStart[ConstantSymbol]

Mass

UndefConstantSymbol[Mass]

??Mass

A complex constant:

DefConstantSymbol[Omega,Dagger->Complex,PrintAs->"Ω"]

Note that Omega and Omega† are related through a master-servant relation:

?Omega

?Omega†

Omega has a servant but not master:

ServantsOf[Omega]

MasterOf[Omega]

ServantsOf[Omega†]

MasterOf[Omega†]

We cannot undefine Omega† alone:

Catch@UndefConstantSymbol[Omega†]

Undefining Omega also undefines Omega† :

UndefConstantSymbol[Omega]

An imaginary constant (note that Omega† is never defined):

DefConstantSymbol[Omega,Dagger->Imaginary,PrintAs->"Ω"]

?Omega

Dagger[Omega]

UndefConstantSymbol[Omega]

EndExamples[]

3.4. Parameters

3.4.1. Definition

Typical examples of parameters are time after a 3+1 decomposition, or proper time of a particle. Parameters are always real, though this could be easily generalized:

?DefParameter

Note that we initialize VisitorsOf because once we have defined a parameter, it is expected that other objects will be defined that depend on the parameter (See ParametersOfTensor.) We do not expect a parameter to have servants.

Options[DefParameter]={Master->Null,PrintAs->Identity,ProtectNewSymbol:>$ProtectNewSymbols,DefInfo->{"parameter",""}};
DefParameter[list_List,rest___]:=Scan[DefParameter[#,rest]&,list];
DefParameter[param_,options:OptionsPattern[]]:=Catch@Module[{master,pa,pns,info},
{master,pa,pns,info}=OptionValue[{Master,PrintAs,ProtectNewSymbol,DefInfo}];
ValidateSymbol[param];
ValidateSymbolInSession[param];
MakeDefInfo[DefParameter,param,info];
MakexTensions[DefParameter,"Beginning",param,options];
AppendToUnevaluated[$Parameters,param];
ParameterQ[param]^=True;
DefInfo[param]^=info;
SetPrintAs[param,PrintAsString[param,pa]];
SymbolRelations[param,master,{}];
MakexTensions[DefParameter,"End",param,options];
If[pns,Protect[param]];
];
SetNumberOfArguments[DefParameter,{1,Infinity}];
Protect[DefParameter];

Undefinition:

?UndefParameter

UndefParameter[list:{___?ParameterQ}]:=Scan[UndefParameter,list];
UndefParameter[param_]:=Catch@With[{servants=ServantsOf[param]},
If[!ParameterQ[param],Throw[Message[UndefParameter::unknown,"parameter",param]]];
CheckRemoveSymbol[param];
MakexTensions[UndefParameter,"Beginning",param];
xUpSet[ServantsOf[param],{}];
DropFromHosts[param];
Undef/@Reverse[servants];
$Parameters=DeleteCases[$Parameters,param];
MakexTensions[UndefParameter,"End",param];
MakeUndefInfo[UndefParameter,param];
RemoveSymbol[param];
];
SetNumberOfArguments[UndefParameter,1];
Protect[UndefParameter];

3.4.2. Formatting

Held version of ConstantSymbolQ to avoid evaluation leaks during typesetting:

SetAttributes[HeldParameterQ,HoldAllComplete];
HeldParameterQ[expr_]:=ParameterQ[Unevaluated[expr]];

StandardForm:

xTensorFormStart[Parameter]:=(MakeBoxes[param_Symbol?HeldParameterQ,StandardForm]:=interpretbox[param,RowBox[{PrintAs[Unevaluated[param]]}]]);
xTensorFormStop[Parameter]:=(MakeBoxes[param_Symbol?HeldParameterQ,StandardForm]=.);
xTensorFormStart[Parameter]

3.4.3. Examples

BeginExamples[]

DefParameter[time,PrintAs->"t"]

?time

$Parameters

time

Cut and paste:

t

InputForm[%]

Dagger[time]

UndefParameter[time]

Note that even at the end we got t instead of time.

?time

$Parameters

EndExamples[]

4. The mathematical input

(**********************************************************************)
(********************* 4. The mathematical input **********************)
(**********************************************************************)

{TimeUsed[],SessionTime[],TimeUsed[]/SessionTime[]}

4.0. Comments

If[$ReadingVerbose,Print["Reading section 4: Mathematical input."],Null,Null]

Structure of input and output:

The"mathematical" input (called mathinput) will be an expression of arbitrary depth containing objects as elements (including the particular case of the input being an object itself). This structure is validated with Validate. Currently an object can be a/an
	- expression with Mathematica head Plus. Its elements (mathinput) are called terms (see ListOfTerms)
	- expression with Mathematica head Times. Its elements (mathinput) are called factors (see ListOfFactors). Times is always conmutative!
	- expression with a head which has been defined as an inert-head, containing mathinput as first element, and possibly additional arguments
	- expression with a head which has been defined as a scalar-function, containing mathinput as (possibly several) scalar elements. In particular, Power. All Mathematica builtins with attribute NumericFunction are considered scalar-functions (except Plus and Times).
	- tensor of the form Thead[indices]. Use ValidateTensor
	- covariant derivative of the form Chead[index][ mathinput ]. Use ValidateCovD. Several indices are also accepted in some situations instead of one index. Now we have introduced (though only partially) the notations CovD[ mathinput, cd1[i1], cd2[i2], ...]. Note also the alternative notation based on TensorDerivative.
	- Lie derivative of the form LieD[ mathinput ][ mathinput ]. Use ValidateLieD
	- expression with head Scalar and a single element of scalar mathinput
	- symbol which has been defined as constant-symbol or parameter
	- numeric quantity

With mathinput we denote an arbitrary expression with the structure above. Thead and Chead are symbols identifying the tensor or covariant derivative, respectively. 

Comments:
	- During execution new heads, not mentioned here, could be generated, but those would always be removed before returning the output.
	- indices and mathinput never appear together in a list of elements. Mathinput and defined symbols can appear together as in LieD[ mathinput, Chead ][ mathinput ] or as in mathinput + const
	- There is also a more general type of mathinput: lists, equations, rules and delayed rules. They must be taken into account in the input/output routines because they contain objects.

More recent comments. Several ideas are under development to generalize the xAct language:
	- Index-free language, at least for differential forms.
	- Non-declarative handling of tensors.
	- Alternative notations for derivatives.

4.1. Sums and products. Type Product

4.1.0. Comments

We shall use the Mathematica builtins Plus and Times, to be able to use Simplify, Expand, etc on our tensor expressions.

4.1.1. MathInputExpand

Note that Expand is threaded over lists:

Expand[List[a(a1+a2),b]]

and now also over rules and equations

Expand[Rule[a(a1+a2),b]]

Expand[Equal[a(a1+a2),b]]

The function MathInputExpand evaluates its argument and then expands it, checking that no new expansion is needed again, because new definitions could have been used. It is a private function. It is used in ListOfTerms, ContractMetric, SymmetryOf and ToCanonical.

?MathInputExpand

MathInputExpand[Equal[lhs_,rhs_]]:=Equal[MathInputExpand[lhs],MathInputExpand[rhs]];
MathInputExpand[Rule[lhs_,rhs_]]:=Rule[MathInputExpand[lhs],MathInputExpand[rhs]];
MathInputExpand[expr_]:=FixedPoint[Expand,expr];

I think we don't need parallel functions for Factor and similar. For very large expressions Expand is slow, and hence MathInputExpand is even slower. It is possible to change MathInputExpand by any other function using Block[{MathInputExpand=...}, ...].

4.1.2. ListOfTerms

This function gives terms (summands). Note that mathinput is always evaluated and expanded before checking the head:

?ListOfTerms

Detailed structure of a SeriesData expression (now not evaluatable):

ListOfTerms[HoldPattern@SeriesData[var_,origin_,coeffs_,iord_,ford_,root_]]:=Append[coeffs Power[var,(iord+Range[origin,Length[coeffs]-1])/root],SeriesData[var,origin,0 coeffs,iord,ford,root]];

With SeriesData expressions, we compute the terms of its normal form and append the "series information", so that apply Plus later will reconstruct the complete series.

ListOfTerms[HoldPattern[expr:SeriesData[var_,origin_,coeffs_,args__]]]:=Append[ListOfTerms[Normal[expr]],SeriesData[var,origin,0 coeffs,args]];
ListOfTerms[expr_]:=If[Head[#]===Plus,List@@#,List@#]&@MathInputExpand[expr];

Examples:

BeginExamples[]

xATP`ListOfTerms[T[a,b]]

xATP`ListOfTerms[6+T[a,b]]

xATP`ListOfTerms[T[a,b]T[-a,-b]]

xATP`ListOfTerms[T[a,b]T[-a,-b]+r[]]

Evaluation of the next line generates a large number of System`SeriesDump` symbols:

xATP`ListOfTerms[Series[f[x],{x,0,3}]]

Plus@@%

InputForm[%]

Remove[T,a,b,r,f,x]
EndExamples[]

4.1.3. ListOfFactors

This function is currently used only in InducedDecomposition and MonomialsOfTerm.

An intermediate function to give factors. Note that expr is always evaluated and factorized before checking the head:

?ListOfFactors

We do not factor terms in a series, because it is not clear how to handle the O terms.

ListOfFactors[expr_]:=If[Head[#]===Times,List@@#,List@#]&@Factor[expr];

Examples:

BeginExamples[]

xATP`ListOfFactors[T[a,b]]

xATP`ListOfFactors[6T[a,b]]

xATP`ListOfFactors[T[a,b]T[-a,-b]+T[a,b]F[-a,-b]]

xATP`ListOfFactors[6+T[a,b]T[-a,-b]]

xATP`ListOfFactors[x^2-1]

Factor does not work on series:

Series[(x-1)(x+2),{x,0,2}]

Factor[%]

Normal[%]

Factor[%]

Remove[T,a,b,x,F]
EndExamples[]

4.1.4. Type Product

Very many thanks to Alfonso García-Parrado for suggesting the main ideas of this and the next sections, and for testing the first versions of the code.

A product in xTensor is essentially a way to define an ALGEBRA over a ring of scalar expressions. We can have associative (vararg) and nonassociative (binary) algebras. Products with other number of arguments are currently not possible.

An algebra U over a ring R is a module over R with a binary product that distributes over the sum of elements of U and is linear over elements of R.

Elements of the ring R (of the algebra of the product prod) are called “the scalars of the algebra”, and we ask the user to provide a function to identify them, in case ambiguities appear (like the double role of Times as product scalar-by-scalar and scalar-by-vector). We don’t need to have a function identifying the elements of the algebra: whatever appears in one of the arguments of the product must be an element of the algebra, and we don’t need to check it. If those elements appear somewhere else, we don’t care. However, we need to set up definitions that extract scalars from the product, so having an identifier of scalars is essential.

There are three products involved in an algebra, and we need to be extremely careful with this:
	- the product of elements of the algebra. This is the main product, identifying the algebra itself. We require no particular property of this product.
	- the product of scalars. Currently we require it to be associative, commutative and with an identity element (the “one”). In most cases this product will be simply Times.
	- the product of a scalar by an element of the algebra (pbs). This is like a “group action” and in general it will be a sided product, because it needs to distinguish the scalars and the elements of the algebra. In some cases it can be made to coincide with the product of scalars, and in particular with Times, which makes this product unnaturally commutative and associative. Then we will have to encode it with checks for the scalars. In other cases, like graded algebras, it is natural to promote the scalars to elements of the algebra, and then some algebra products become naturally pbs products.

Currently products can be given a  symmetry, basically commutativity (or symmetry +1) or anticommutativity (symmetry -1), the latter requiring the use of grades in the associative case. For a graded product we need to extend this to supercommutativity and superanticommutativity, such that the sign is given by the product of grades. Exterior algebra is supercommutative. Actually, currently symmetry -1 in the graded case means supercommutativity.

We provide an option to specify whether there is an identity element or not. Associativity is implemented using the Flat and OneIdentity attributes of Mathematica, which effectively turn prod[] into an identity element. Hence we need to have an identity element for the associative products. The behavior of the product on the identity element depends on whether the identity element (which must obviously be an element of the algebra) is also a scalar of the product. If, for the associative case, we declare ScalarsOfProduct -> scQ and IdentityElementOfProduct -> id, then scQ[id] will be evaluated and it must return the appropriate answer. This may require defining scQ in advance of evaluating DefProduct.

Note that the function scQ must be compatible with pos. That is, if a, b are scalars then pos[a, b] must also be a scalar.

For a product prod and tensors T1 and T2 the indices of the expression prod[ T1[a, b], T2[-b, -c] ] are {a, b, -b, -c}. For example we may want to implement a Lie algebra using lie[ v[], w[] ] for two elements v, w of the algebra. This is very different from the Bracket[ v[a], w[a] ][a] notation. Note again that there is no need to specify what belongs or not to the algebra, but we need to specify what are the scalars, to pull them out by linearity.

?DefProduct

$MathematicaProductSymbols={Square,CircleTimes,CircleMinus,CircleDot,Diamond,CenterDot,Star,VerticalTilde,Backslash,Wedge,Vee,Cap,Cup};

TODO: We need a simpler way to change formatting, for example to given “bracket form”, or perhaps “bra-ket form”.

Options[DefProduct]={
AssociativeProductQ->False,
IdentityElementOfProduct->None,
CommutativityOfProduct->None,
GradedProductQ->False,
GradeOfProduct->0,
ScalarsOfProduct->NumericQ,
DefineCommutator->False,
xSortOrder->Automatic,
Master->Null,
PrintAs->"⋄",
ProtectNewSymbol:>$ProtectNewSymbols,
DefInfo->{"product",""}
};
DefProduct[list_List,rest___]:=Scan[DefProduct[#,rest]&,list];
DefProduct[prod_,options___?OptionQ]:=DefProduct[prod,Times,Times,options];
DefProduct[prod_,epbs_,options___?OptionQ]:=DefProduct[prod,epbs,Times,options];
DefProduct[prod_,epbs_,pos_,options:OptionsPattern[]]:=Catch@Module[{asQ,ie,com,gp,gop,scQ,dc,xso,master,pa,pns,info,systemQ,pbs,pbsside,isQ},

{asQ,ie,com,gp,gop,scQ,dc,xso,master,pa,pns,info}=OptionValue[{AssociativeProductQ,IdentityElementOfProduct,CommutativityOfProduct,GradedProductQ,GradeOfProduct,ScalarsOfProduct,DefineCommutator,xSortOrder,Master,PrintAs,ProtectNewSymbol,DefInfo}];

(* Validate symbol prod *)
systemQ=MemberQ[$MathematicaProductSymbols,prod];
If[!systemQ,ValidateSymbol[prod]];
ValidateSymbolInSession[prod];

(* The product of scalars must be already a product, and it must be associative, unital and commutative, i.e. a commutative monoid *)
If[!ProductQ[pos],Throw@Message[DefProduct::unknown,pos,"product"]];
If[!AssociativeProductQ[pos],Throw@Message[DefProduct::error1,pos,"is not associative"]];
If[CommutativityOfProduct[pos]=!="Commutative",Throw@Message[DefProduct::error1,pos,"is not commutative"]];
If[IdentityElementOfProduct[pos]===None,Throw@Message[DefProduct::error1,pos,"dos not have an identity element"]];

(* Check structure of the product-by-scalar argument *)
If[ListQ[epbs]&&Length[epbs]===2,
pbsside=First[epbs];
pbs=Last[epbs],
pbsside=All;
pbs=epbs
];
If[pbsside=!=Left&&pbsside=!=Right&&pbsside=!=All,
Throw[Message[DefProduct::invalid,pbsside,"sideness of the product by scalars"]]
];
If[pbsside===All&&MemberQ[Attributes@@{pbs},Flat],pbsside=Left];

(* Register *)
MakeDefInfo[DefProduct,prod,info];
MakexTensions[DefProduct,"Beginning",prod,options];
AppendToUnevaluated[$Products,prod];
SymbolRelations[prod,master,{}];
DefInfo[prod]^=info;
ProductQ[prod]^=True;
GradedProductQ[prod]^=gp;
If[gp,GradeOfProduct[prod,prod]^=gop];
ScalarsOfProduct[prod]^=scQ;
ProductByScalar[prod]^=epbs;
ProductOfScalars[prod]^=pos;

(* Formatting *)
If[systemQ,
SetPrintAs[prod,ToExpression["\"\\["<>ToString[prod]<>"]\""]],
SetPrintAs[prod,PrintAsString[prod,pa]];
(* TODO: add parentheses for nested nonassociative cases *)
MakeBoxes[prod[factors__],StandardForm]:=interpretbox[prod[factors],MakeSequenceBox[{factors},pa,StandardForm]];
];

(* Symmetry. Currently we define no automatic simplification. ToCanonical will do that *)
CommutativityOfProduct[prod]^=com;
If[!GradedProductQ[prod]&&(com==="SuperCommutative"||"SuperAnticommutative"),
Throw@Message[DefProduct::error,"Only graded products can be supercommutative or superanticommutative."]];
If[xso=!=Automatic,
With[{order=xso},
ObjectOrder[prod,freesQ_]=Function[xso[UxSort[First[#1]],UxSort[First[#2]]]]
]
];

(* Distributivity of prod (ADL/R) *)
MakeDistributiveProduct[prod,asQ,0];

(* Linearity of prod with respect to pbs (LINL/R) *)
MakeLinearProduct[prod,asQ,scQ,pbs,pbsside];

(* If pbs is not yet a product, add its properties *)
If[!ProductQ[pbs],
ProductQ[pbs]^=True;
With[{one=IdentityElementOfProduct[pos],zero=0},
If[pbsside===Left||pbsside===All,
pbs[one,x_]:=x;
pbs[zero,x_]:=zero;
(* MP Left *)
pbs[n_,pbs[m_,x_]]:=pbs[pos[n,m],x];
];
If[pbsside===Right||pbsside===All,
pbs[x_,one_]:=x;
pbs[x_,zero]:=zero;
(* MP Right *)
pbs[pbs[x_,n_],m_]:=pbs[x,pos[n,m]];
];
(* Distributivity of pbs (MDL/R). Slight abuse of notation, not using pbsside and the same zero *)
MakeDistributiveProduct[pbs,False,zero];
]
];

(* Associated commutator product *)
If[dc,
(* TODO: This check should be either removed or extended to all commutators *)
If[com==="Commutative",
Print["** DefProduct: Commutator of a commutative product vanishes identically."];
Commutator[prod][__]:=0
];
MakeLinearProduct[Commutator[prod],False,scQ,pbs,pbsside];
MakeLinearProduct[Anticommutator[prod],False,scQ,pbs,pbsside];
MakeLinearProduct[Supercommutator[prod],False,scQ,pbs,pbsside];
];

(* Associativity *)
AssociativeProductQ[prod]^=asQ;
If[asQ,
SetAttributes[prod,{Flat,OneIdentity}];
Verbatim[prod][expr_]:=expr;,
prod[]:=Throw@Message[prod::error,"Found expression "<>ToString[prod]<>"[]."];
];

(* Identity element *)
IdentityElementOfProduct[prod]^=ie;
If[ie===None,
If[asQ,Throw@Message[DefProduct::error,"An associative product must be defined with an identity element."]],
If[gp&&Grade[ie,prod]=!=0,Throw@Message[DefProduct::error1,"The identity element of a graded algebra must have grade 0, instead of",Grade[ie,prod]]
];
(* Is the identity also a scalar? If scQ[ie] stays unevaluated, we assume it is not *)
isQ=TrueQ[scQ[ie]];
If[asQ,
Verbatim[prod][]:=ie;
If[isQ,
Verbatim[prod][left___,x_?scQ,right___]:=pbs[x,prod[left,right]],
Verbatim[prod][left___,ie,right___]:=prod[left,right]
],
If[isQ,
Verbatim[prod][expr_,x_?scQ]:=pbs[x,expr];
Verbatim[prod][x_?scQ,expr_]:=pbs[x,expr],
Verbatim[prod][expr_,ie]:=expr;
Verbatim[prod][ie,expr_]:=expr;
]
];
If[dc,
Commutator[prod][x_,ie]:=0;
Commutator[prod][ie,x_]:=0;
];
];

(* Products are declared to be listable by default, mainly to allow automatic threading through Equal *)
SetAttributes[prod,Listable];

(* Finalize *)
MakexTensions[DefProduct,"End",prod,options];
If[pns,Protect[prod]];
];
SetNumberOfArguments[DefProduct,{1,Infinity}];
Protect[DefProduct];

These are the distributivity and linearity rules for the algebra product, both for associative and nonassociative products, and both for left- and right-products by scalars. This assumes that the properties of the product by scalars and of the product of scalars have been already properly given.

(* Distributivity (automatic expansion) *)
MakeDistributiveProduct[prod_,True,zero_]:=(
prod[left___,zero,right___]:=zero;
prod[left___,sum_Plus,right___]:=prod[left,#,right]&/@sum;
(* This is incorrect. It needs a generalization of SeriesDataMap *)
prod[left___,sum_SeriesData,right___]:=SeriesDataMap[prod[left,#,right]&,sum];
);
MakeDistributiveProduct[prod_,False,zero_]:=(
prod[zero,x_]:=zero;
prod[x_,zero]:=zero;
prod[sum_Plus,x_]:=prod[#,x]&/@sum;
prod[x_,sum_Plus]:=prod[x,#]&/@sum;
(* These are incorrect. They need a generalization of SeriesDataMap *)
prod[sum_SeriesData,x_]:=SeriesDataMap[prod[#,x]&,sum];
prod[x_,sum_SeriesData]:=SeriesDataMap[prod[x,#]&,sum];
);
(* Linearity *)
MakeLinearProduct[prod_,True,scQ_,pbs_,Left]:=(
prod[left___,pbs[number_?scQ,x_],right___]:=pbs[number,prod[left,x,right]];
);
MakeLinearProduct[prod_,True,scQ_,pbs_,Right]:=(
prod[left___,pbs[x_,number_?scQ],right___]:=pbs[prod[left,x,right],number];
);
MakeLinearProduct[prod_,False,scQ_,pbs_,Left]:=(
prod[pbs[number_?scQ,x_],y_]:=pbs[number,prod[x,y]];
prod[x_,pbs[number_?scQ,y_]]:=pbs[number,prod[x,y]];
);
MakeLinearProduct[prod_,False,scQ_,pbs_,Right]:=(
prod[pbs[x_,number_?scQ],y_]:=pbs[prod[x,y],number];
prod[x_,pbs[y_,number_?scQ]]:=pbs[prod[x,y],number];
);
MakeLinearProduct[prod_,asQ_,scQ_,pbs_,All]:=(
MakeLinearProduct[prod,asQ,scQ,pbs,Left];
MakeLinearProduct[prod,asQ,scQ,pbs,Right];
);

Undefinition:

?UndefProduct

UndefProduct[list:{___?ProductQ}]:=Scan[UndefProduct,list];
UndefProduct[prod_Symbol]:=Catch@With[{servants=ServantsOf[prod]},
If[!ProductQ[prod],Throw@Message[UndefInertHead::unknown,"product",prod]];
CheckRemoveSymbol[prod];
MakexTensions[UndefProduct,"Beginning",prod];
xUpSet[ServantsOf[prod],{}];
DropFromHosts[prod];
Undef/@Reverse[servants];
$Products=DeleteCases[$Products,prod];
MakexTensions[UndefProduct,"End",prod];
MakeUndefInfo[UndefProduct,prod];
If[MemberQ[$MathematicaProductSymbols,prod],
Clear[prod],
RemoveSymbol[prod]
]
];
SetNumberOfArguments[UndefProduct,1];
Protect[UndefProduct];

Identification of scalars of the product (elements of the ring of scalars of the algebra associated to the product):

ScalarsOfProduct[prod_]:=Throw@Message[ScalarsOfProduct::unknown,"product",prod];
SetNumberOfArguments[ScalarsOfProduct,1];
Protect[ScalarsOfProduct];

This allows a product by scalars other than Times. This is an experimental feature. Note that here we are referring only to the product of an element of the algebra by a scalar, and not to the product of two scalars. The fact that Times is used for both purposes is a standard overloading of Times.

ProductByScalar[prod_]:=Throw@Message[ProductByScalar::unknown,"product",prod];
SetNumberOfArguments[ProductByScalar,1];
Protect[ProductByScalar];

GradedProductQ[prod_]:=Throw@Message[GradedProductQ::unknown,"product",prod];
SetNumberOfArguments[GradedProductQ,1];
Protect[GradedProductQ];

We consider only the case in which there are both left and right neutral elements. Then the theory says that they must be unique and equal (consider the element prod[leftne, rightne]; it is obviously equal to both leftne and rightne).

IdentityElementOfProduct[prod_]:=Throw@Message[IdentityElementOfProduct::unknown,"product",prod];
SetNumberOfArguments[IdentityElementOfProduct,1];
Protect[IdentityElementOfProduct];

Commutativity properties:

CommutativityOfProduct[prod_]:=Throw@Message[CommutativityOfProduct::unknown,"product",prod];
SetNumberOfArguments[CommutativityOfProduct,1];
Protect[CommutativityOfProduct];

“SuperCommutative” is defined as follows:

	prod[a, b] == (-1)^(Grade[a,prod] Grade[b,prod]) prod[b, a]

“SuperAnticommutative”:

	bracket[a, b] == -(-1)^(Grade[a,prod] Grade[b,prod]) bracket[b, a]

{“Super(Anti)Commutative”, p} for the generalized case:

	prod[a, b] == s (-1)^((Grade[a,prod]-p) (Grade[b,prod]-p)) prod[b, a]

(* Compute flipping signs for the various possibilities *)
CommutativitySign[prod_,sym:(_String|_List)][x_,y_]:=CommutativitySignGrade[prod,sym][Grade[x,prod],Grade[y,prod]];
CommutativitySign[prod_,f_][x_,y_]:=f[x,y];
(* Formulas based on grades only *)
CommutativitySignGrade[prod_,"Commutative"][gx_,gy_]:=1;
CommutativitySignGrade[prod_,"Anticommutative"][gx_,gy_]:=-1;
CommutativitySignGrade[prod_,"SuperCommutative"][gx_,gy_]:=(-1)^(gx gy);
CommutativitySignGrade[prod_,"SuperAnticommutative"][gx_,gy_]:=-(-1)^(gx gy);
CommutativitySignGrade[prod_,{"SuperCommutative",p_Integer}][gx_,gy_]:=(-1)^((gx-p)(gy-p));
CommutativitySignGrade[prod_,{"SuperAnticommutative",p_Integer}][gx_,gy_]:=-(-1)^((gx-p)(gy-p));
CommutativitySignGrade[prod_,com_][gx_,gy_]:=Throw@Message[prod::error1,"xTensor not yet ready to handle symmetry ",com];

We always write specific rules for Times, but we include Times in the framework of products. We consider it associated to a nongraded algebra:

Unprotect[Times];
ProductQ[Times]^=True;
AssociativeProductQ[Times]^=True;
CommutativityOfProduct[Times]^="Commutative";
IdentityElementOfProduct[Times]^=1;
GradedProductQ[Times]^=False;
ProductByScalar[Times]^=Times;
Protect[Times];

4.1.5. Commutators and anticommutators. Associator

For every product prod it is possible to define a Commutator[prod][a_, b_] := prod[a,b]-prod[b,a]. Then we have:

Com[Com[a,b],c] + Com[Com[b,c],a] + Com[Com[c,a],b] = Com[a,b]**c - c**Com[a,b] + Com[b,c]**a -a**Com[b,c] + Com[c,a]**b - b**Com[c,a] =
	= (a**b - b**a)**c - c**(a**b - b**a) + (b**c - c**b)**a - a**(b**c - c**b) + (c**a - a**c)**b - b**(c**a - a**c) =
	= (a**b)**c - a**(b**c) - (b**a)**c + b**(a**c) + (b**c)**a - b**(c**a) - (c**b)**a + c**(b**a) - (a**c)**b + a**(c**b) + (c**a)**b - c**(a**b)
	
which is zero for an associative product. Hence the commutator of an associative product obeys the Jacobi identity. Commutator[prod] is another product.

TODO: What is the relation between these commutators and Bracket?

Jose. We should merge this MakeDistributiveProduct with the previous one.

(* This is a modified version *)
MakeDistributiveProduct[prodL_,prodR_,True,zero_]:=(
prodL[left___,zero,right___]:=zero;
prodL[left___,sum_Plus,right___]:=prodR[left,#,right]&/@sum;
(* This is incorrect. It needs a generalization of SeriesDataMap *)
prodL[left___,sum_SeriesData,right___]:=SeriesDataMap[prodR[left,#,right]&,sum];
);

DeclareCommutator[commutator_,commutativity_]:=(
ProductQ[commutator[prod_]]^:=ProductQ[prod];
ScalarsOfProduct[commutator[prod_]]^:=ScalarsOfProduct[prod];
ProductByScalar[commutator[prod_]]^:=ProductByScalar[prod];
CommutativityOfProduct[commutator[prod_]]^:=commutativity;
AssociativeProductQ[commutator[prod_]]^:=False;
IdentityElementOfProduct[commutator[prod_]]^:=None;
(* Commutator inherits gradation from prod *)
GradedProductQ[commutator[prod_]]^:=GradedProductQ[prod];
MakeDistributiveProduct[commutator[prod_],commutator[prod],True,0];
);
DeclareCommutator[Commutator,"Anticommutative"];
DeclareCommutator[Anticommutator,"Commutative"];
DeclareCommutator[Supercommutator,"SuperAnticommutative"];

TODO: Make the Poisson identity automatic.

[Leo: Question: Should we set by default
  Grade[expr_,Commutator[prod_]]:= Grade[expr,prod]
and similarly for Anticommutator, Supercommutator? ]

Commutator cannot be protected, because most definitions will be loaded on it, due to prod being too deep.

Formatting:

MakeBoxes[Commutator[prod_][a_,b_],StandardForm]:=interpretbox[Commutator[prod][a,b],SubscriptBox[RowBox[{"[",MakeBoxes[a,StandardForm],",",MakeBoxes[b,StandardForm],"]"}],PrintAs[prod]]];
MakeBoxes[Anticommutator[prod_][a_,b_],StandardForm]:=interpretbox[Anticommutator[prod][a,b],SubscriptBox[RowBox[{"{",MakeBoxes[a,StandardForm],",",MakeBoxes[b,StandardForm],"}"}],PrintAs[prod]]];
MakeBoxes[Supercommutator[prod_][a_,b_],StandardForm]:=interpretbox[Supercommutator[prod][a,b],SubscriptBox[RowBox[{"[[",MakeBoxes[a,StandardForm],",",MakeBoxes[b,StandardForm],"]]"}],PrintAs[prod]]];

Expanding a (anti,super)commutator

ExpandCommutatorRule={Commutator[prod_][a_,b_]:>prod[a,b]-prod[b,a]};
ExpandAnticommutatorRule={Anticommutator[prod_][a_,b_]:>prod[a,b]+prod[b,a]};
ExpandSupercommutatorRule={Supercommutator[prod_][a_,b_]:>
prod[a,b]-(-1)^(Grade[a,prod]Grade[b,prod])prod[b,a]};

ExpandCommutator[expr_]:=expr//.Join[ExpandCommutatorRule,ExpandAnticommutatorRule,ExpandSupercommutatorRule];

[Leo: Currently there is no automatic Poisson identity for any of the above over an associative algebra, i.e. we should expect
  [a,bc] = [a,b]c + b[a,c]
and related identities for the others. This might be nice.]

TODO: Associator.

4.1.6. Grades

Products can be graded or not (even in the nonassociative case [article]). Grades are computed using a function Grade[expr, prod] that returns an integer grade for the expression in the algebra associated to prod. We might want to extend this to filtered algebras. We want to prepare the arena to deal with general algebras, as AVF does.

In principle we assume that grades are integer (possibly negative) numbers, though nowhere we make use of that.

By default Grade assigns 0 grade to everything not a sum.

Grades behave very much like density weights. We could perhaps use the same idea of “an integer linear combination of product”. It seems less natural here, because there are no “changes of product”. That’s why use use Grade[expr, prod1] = 2, Grade[expr, prod2] = 3, instead of Grade[expr] =2 prod1 + 3 prod2.

1) Computation of the grade of a sum must be uniquely defined. This does not mean that we do not accept sums of objects of different grades. It means that the code must have known what to do with that sum before computing the sum grade.

checkLengthOneGrade[{x_}]:=True;
checkLengthOneGrade[x:{_,__}]:=Throw@Message[Validate::inhom,"grades",ToString[x]];

Grade[sum_Plus,prod_Symbol?ProductQ]:= With[{glist=Union[Grade[#,prod]&/@List@@sum]},
If[checkLengthOneGrade[glist],First[glist]]
];

2) The grade of a product in a different product must be manually specified by the user. Recall that GradeOfProduct[prod, prod] is set to an integer by DefProduct for a graded product, with default 0.

Grade[prod1_?ProductQ[factors___],prod2_Symbol?ProductQ]:=With[{ppgrade=GradeOfProduct[prod1,prod2]},
Apply[Plus,Grade[#,prod2]&/@{factors}]+ppgrade/;IntegerQ[ppgrade]
];
SetNumberOfArguments[GradeOfProduct,2];
Protect[GradeOfProduct];

3) Elementary expressions:

(* Definitions for Grade. Check that the product is graded *)
Grade[c_?ConstantQ,prod_?GradedProductQ]:=0;
Grade[p_?ParameterQ,prod_?GradedProductQ]:=0;
Grade[Scalar[expr_],prod_?GradedProductQ]:=Grade[expr,prod];
Grade[tensor_?xTensorQ[inds___],prod_?GradedProductQ]:=GradeOfTensor[tensor,prod]+Plus@@(GradeOfIndex[#,prod]&/@{inds});
Grade[der_?FirstDerQ[expr_],prod_?GradedProductQ]:=Grade[expr,prod]+GradeOfDer[der,prod];
Grade::sfg0="Arguments `1` of scalar function `2` must all have grade 0, but have `3` instead.";
Grade[sf:_?ScalarFunctionQ[args___],prod_?GradedProductQ]:=With[{glist=Grade[#,prod]&/@{args}},
If[Union[glist]==={0},
0,
Throw@Message[Grade::sfg0,{args},sf,glist]
]
];
(* Grades of inert-head expressions must be provided by the user *)
Grade[ih:_?InertHeadQ[__],prod_?GradedProductQ]:=Throw@Message[Grade::unknown,"grade of inert-head expression",ih];
(* Default: grades for non-graded products are defined as 0 *)
Grade[expr_,prod_?ProductQ]:=0;
Grade[expr_,prod_]:=Throw@Message[Grade::unknown,"product",prod];

(* Secondary definitions. We have already checked that the product is graded *)
GradeOfTensor[TensorDerivative[tensor_,ders__],prod_]:=GradeOfTensor[tensor,prod]+Plus@@(GradeOfDer[#,prod]&/@{ders});
GradeOfTensor[Bracket[v1_,v2_],prod_]:=Grade[v1,prod]+Grade[v2,prod];
GradeOfDer[covd_?CovDQ[inds__],prod_]:=GradeOfCovD[covd,prod]+Plus@@(GradeOfIndex[#,prod]&/@{inds});
GradeOfDer[LieD[v_],prod_]:=Grade[v,prod];
GradeOfIndex[Dir[v_],prod_]:=Grade[v,prod];
GradeOfIndex[{i_,basis_},prod_]:=GradeOfBIndex[{i,basis},prod];
(* Zero defaults for the secondary definitions *)
GradeOfTensor[tensor_,prod_]:=0;
GradeOfDer[der_,prod_]:=0;
GradeOfCovD[covd_,prod_]:=0;
GradeOfIndex[i_,prod_]:=0;
GradeOfBIndex[bi_,prod_]:=0;

SetNumberOfArguments[Grade,2];
Protect[Grade];

BeginExamples[]

A Gerstenhaber algebra has two products: pr and br

The pr product is associative and multilinear, with neutral element 1 and zero element 0. It has a ℤ-grade in which the product has grade 0. It is supercommutative, which I interpret as antisymmetric (using Grade[#, pr]):

DefProduct[pr,CommutativityOfProduct->"SuperCommutative"]

The br product is a bracket (not associative, but still bilinear) with no neutral element and zero element 0. It has pr-grade -1:

DefProduct[br,AssociativeProductQ->False,IdentityElementOfProduct->None,CommutativityOfProduct->"Anticommutative",GradeOfProduct->-1];
Unprotect[br];
br/:GradeOfProduct[br,pr]=-1;
Protect[br];

Poisson identity in the Gerstenhaber algebra:

	br[ a, pr[b, c] ] == pr[ br[a, b], c ] + (-1)^( (Grade[a, pr]-1) Grade[b, pr] ) pr[ b, br[a, c] ]

In a Poisson superalgebra it would be instead:

	br[ a, pr[b, c] ] == pr[ br[a, b], c ] + (-1)^( Grade[a, pr] Grade[b, pr] ) pr[ b, br[a, c] ]

Unrelated to that, there is a concept of “supercommutator”:

	br[ a, b ] := pr[ a, b ] - (-1)^( Grade[a, pr] Grade[b, pr] ) pr[ b, a ]

and the previous concept of “supercommutation” comes from the vanishing of this. In the context of superalgebras sometimes it is understood that the grade can only be 0 or 1.

UndefProduct[br];
UndefProduct[pr];

EndExamples[]

TODISCUSS

1) Is is better to ask for a function detecting scalars or detecting algebra elements? Is there any simple relation between those two?

4.1.7. An antisymmetric product. OLD and INCOMPLETE. Not in the package

1) Use the attributes of a product:

Attributes[Times]

SetAttributes[Wedge,{Flat,Listable,OneIdentity}]

Very annoyingly, the OneIdentity attribute does not include this:

Wedge[x]

So we add it. Note that we need to use Verbatim to avoid infinite iteration. Really bad:

Verbatim[Wedge][x_]:=x

Wedge[x]

We could declare this to be 1, but in principle we should not need it:

Wedge[]

We also add automatic distributivity, like an automatic Expand:

Wedge[x1___,x_Plus,x2___]:=Distribute[Unevaluated@Wedge[x1,x,x2]];
Wedge[x1___,x_SeriesData,x2___]:=SeriesDataMap[Wedge[x1,#,x2]&,x];

Wedge[A+B,C,D+F]

2) Relation between Times and Wedge. We need a function detecting the Grasmann variables:

GrassmannQ[A]^=True;
GrassmannQ[B]^=True;
GrassmannQ[F]^=True;
GrassmannQ[G]^=True;

GrassmannQ[expr_Wedge]:=Apply[And,GrassmannQ/@List@@expr];
GrassmannQ[expr_Times]:=Apply[Or,GrassmannQ/@List@@expr];
GrassmannQ[expr_Plus]:=Apply[And,GrassmannQ/@List@@expr];
GrassmannQ[HoldPattern[SeriesData[var_,orig_,coeffs_,rest__]]]:=Apply[And,GrassmannQ/@coeffs]&&Not[GrassmannQ[var]]&&Not[GrassmannQ[orig]];
GrassmannQ[expr_]:=False;
NotGrassmannQ[expr_]:=Not@GrassmannQ[expr];

Wedge[x1___,coeff_?NotGrassmannQ expr_,x2___]:=coeff Wedge[x1,expr,x2];

Wedge[2B,x A]

3) We could automate sorting with

Wedge[exprs___]:=With[{sort=Sort[{exprs}]},Signature[{exprs}]Wedge@@sort/;sort=!={exprs}]

but then we see that the resulting expression tries to sort itself again:

Wedge[B,A,C]//Trace

I think it is better to define a sorting function, to be used when required:

ASort[expr_]:=expr/.wedge_Wedge:>Signature[wedge]Sort[wedge];

3Wedge[2B,y(x A+F)]//ASort

%//Expand

Repeated Grassmann objects give zero:

Wedge[A,B,A]//ASort

We need a Rank function, following Alfonso’s ideas, instead of the GrassmannQ function. We also need some way to return zero for ranks beyond the dimension.

4.2. Conventions

4.2.1. Six signs

We follow the sign and index-position conventions of Wald's book. Note that in this notebook we unset those signs to check their position.

DefSign[sign_,printas_,default_]:=(
DefConstantSymbol[sign,PrintAs->printas,Validate->False,ProtectNewSymbol->False,DefInfo->False];
sign/:Power[sign,n_Integer]:=If[EvenQ[n],1,sign];
sign=default
);

1) $epsilonSign. Default value for epsilonOrientation.

DefSign[$epsilonSign,"(Subscript[s, ϵ])",1]

?epsilonSign

$epsilonSign=.

TODO: This seems wrongly documented now...

2) Riemann[-a, -b, -c, d] = $RiemannSign ( PD[ -b ][ Gamma[d, -a, -c] ] + ... ).

DefSign[$RiemannSign,"(Subscript[s, R])",1]

?$RiemannSign

$RiemannSign=.

3) Ricci[-a, -b] = $RicciSign Riemann[c, -a, -c, -b]

DefSign[$RicciSign,"(Subscript[s, r])",1]

?$RicciSign

$RicciSign=1;

$RicciSign=.

No conventions required here:

RicciScalar[] = Invg[a, b] Ricci[-a, -b]

Einstein[-a, -b] = Ricci[-a, -b] - g[-a,-b] RicciScalar[] / 2

Weyl[-a, -b, -c, -d] = RiemannDown[-a, -b, -c, -d] +...

4) $TorsionSign

DefSign[$TorsionSign,"(Subscript[s, T])",1]

?$TorsionSign

$TorsionSign=.

Later we shall define two more signs:

?$ExtrinsicKSign

?$AccelerationSign

4.2.2. Constants...

Many of these are already define in the package Miscellaneous`PhysicalConstants, but there only as definitions for their values in a particular unit system.

Maxwellk1, Maxwellk3. See Jackson's book.
Eps0, Mu0. Permitivity and permeability of vacuum in MKS units.
Lightc, hbar, NewtonG.

These constants would be required if we hardwired important equations in Physics (like Maxwell's equations or Newton's law), but we are not doing that, and so we don't really need these constants.

4.2.3. ...or unit system

See the package Miscellaneous`Units for the Convert command. Again, here we would just need a consistent way of writing famous equations of Physics.

emuUnits. Electromagnetic system
esuUnits. Electrostatic system
GaussianUnits.
HeavisideLorentzUnits.
RationalizedMKSUnits.
SIUnits.
GravitationalUnits. Lightc=NewtonG=1.
NaturalUnits. Lightc=hbar=1.

4.3. Constants: ConstantQ

We introduce a function that identifies constants, both constant-symbols and numbers or numeric symbols. Do not confuse it with ConstantSymbolQ. It also checks whether the arguments of scalar functions are all constants.

?ConstantQ

ConstantQ[_Integer|_Rational|_Real|_Complex]:=True;
ConstantQ[expr_Plus]:=AllTrue[expr,ConstantQ];
ConstantQ[expr_Times]:=AllTrue[expr,ConstantQ];
ConstantQ[_?ScalarFunctionQ[___?ConstantQ]]:=True;
ConstantQ[x_]:=NumericQ[x]||ConstantSymbolQ[x];
SetNumberOfArguments[ConstantQ,1];
Protect[ConstantQ];

4.4. Scalars: ScalarQ and Scalar

4.4.1. ScalarQ

First we define a function which detects scalars. There is an important problem here: consider the expression v[{a, basis}]v[{-a, -basis}]; are these two objects scalars? Would it be reasonable to separate Scalar[v[{a, basis}]w[{-a, -basis}, b, -b]] into v[{a, basis}] Scalar[w[{-a, -basis},b,-b]] ? I don't think so. In the past the generic definition had Select[FFI[expr], AIndexQ] instead of the current FFI[expr].

?NonIndexedScalarQ

?ScalarQ

We separate part of the action of ScalarQ into the private NonIndexedScalarQ to make use only of the latter below, when detecting scalars which can be extracted from the Scalar head. That is, we do not want to waste time using FindFreeIndices when checking if some part of the Scalar expression can be extracted. Note the difference between these two functions: ScalarQ gives True if the expression is a scalar (no free indices), while NonIndexedScalarQ gives True if the expression does not have indices at all.

(* Shortcuts *)
NonIndexedScalarQ[expr_Plus]:=AllTrue[expr,NonIndexedScalarQ];
NonIndexedScalarQ[expr_Times]:=AllTrue[expr,NonIndexedScalarQ];
NonIndexedScalarQ[Scalar[_]]:=True;
NonIndexedScalarQ[_?xTensorQ[]]:=True;
NonIndexedScalarQ[_?ScalarFunctionQ[__]]:=True;
NonIndexedScalarQ[_Symbol?ParameterQ]:=True;
NonIndexedScalarQ[_?ConstantQ]:=True;
NonIndexedScalarQ[prod_?ProductQ[factors___]]:=AllTrue[{factors},NonIndexedScalarQ];
NonIndexedScalarQ[HoldPattern@SeriesData[var_,origin_,coeffs_,__]]:=AllTrue[coeffs,NonIndexedScalarQ]&&NonIndexedScalarQ[var]&&NonIndexedScalarQ[origin];
NonIndexedScalarQ[expr_]:=False;
(* Pattern or Slot expressions are not scalars! *)
ScalarQ[_Blank|_Pattern|_PatternTest|_Condition|_Slot]:=False;
(* Identify objects are not scalars *)
ScalarQ[_Object]:=False;
ScalarQ[VerbatimProduct[_][___]]:=False;
ScalarQ[CommutingObjects[_][___]]:=False;
(* Generic definition *)
ScalarQ[expr_]:=NonIndexedScalarQ[expr]||FindFreeIndices[expr]===IndexList[] ;
SetNumberOfArguments[ScalarQ,1];
Protect[ScalarQ];

Dim1: With 1-dim vector spaces we can have repeated indices and so it is not obvious how to define "dummy" and "free" indices. However we shall do it in such a way that this function does not require changes.

4.4.2. Scalar

The head Scalar has several properties. In particular, Scalar evaluates its argument.

?Scalar

Scalar[x_Plus]:=Scalar/@x;
Scalar[x_SeriesData]:=SeriesDataMap[Scalar,x];
Scalar[x_?ConstantQ y_.]:=x Scalar[y];
Scalar[x_?NonIndexedScalarQ]:=x/;$SeparateScalarsFromScalar;
Scalar[x_?NonIndexedScalarQ y_]:=Scalar[x] Scalar[y];
Scalar[1]:=1;
SetNumberOfArguments[Scalar,1];
Protect[Scalar];

Scalar is logically a special case of an inert-head. However I do not see the point in defining it as such because we still need to give very special definitions for it.

Deactivate this variable to avoid Scalar[x] being converted into x for a non-indexed scalar x:

$SeparateScalarsFromScalar=True;

4.4.3. Formatting

I have tried to color the background of Scalar expressions, but nobody likes that, and so I deactivate it:

$ScalarColor=RGBColor[0.9,1.,0.5];

xTensorFormStart[Scalar]:=(
MakeBoxes[Scalar[expr_],StandardForm]:=interpretboxcolor[Scalar[expr],RowBox[{"(",MakeBoxes[expr,StandardForm],")"}],$ScalarColor]);
xTensorFormStop[Scalar]:=(MakeBoxes[Scalar[expr_],StandardForm]=.);
xTensorFormStart[Scalar];

Following Guillaume, now we color the parentheses, by default in red :

?$ScalarColor

$ScalarColor=RGBColor[1,0,0];
xTensorFormStart[Scalar]:=(
MakeBoxes[Scalar[expr_],StandardForm]:=interpretbox[Scalar[expr],RowBox[{StyleBox["(",FontColor->$ScalarColor],MakeBoxes[expr,StandardForm],StyleBox[")",FontColor->$ScalarColor]}]]);
xTensorFormStop[Scalar]:=(MakeBoxes[Scalar[expr_],StandardForm]=.);
xTensorFormStart[Scalar];

4.4.4. Examples

BeginExamples[]

ScalarQ[aa_]

ScalarQ[Pi]

Scalar[2Pi E^(-3)]

Scalar[aa[]^bb[]]

Scalar[2Pi ff[]E^(-3)]

%//InputForm

((2 π Scalar[ff[]])/(E^3))//InputForm

Remove[aa,bb,ff]

EndExamples[]

4.5. Derivatives: FirstDerQ

It is interesting to identify all kinds of derivatives with a single Q-function. Note that FirstDerQ gives True on single derivatives, but not on multiple derivatives (for instance ParamD[t1,t2]) because it will be frequently used to detect when the Leibnitz rule must be used, and that rule only works for single derivatives.

?FirstDerQ

FirstDerQ[_?CovDQ[_]]:=True;
FirstDerQ[LieD[_]]:=True;
FirstDerQ[ParamD[_]]:=True;
FirstDerQ[OverDot]:=True;
FirstDerQ[_]:=False;
SetNumberOfArguments[FirstDerQ,1];
Protect[FirstDerQ];

Note that a covariant derivative with multiple indices is not interpreted here as a first derivative. If this is required it must be added as a special rule. This is because somebody could want to use the multiple indices case as a high-order derivative. Perhaps that should be added by default in Spinors, as suggested by Thomas. Note also that the notations CovD[expr, derind] or TensorDerivative[T, der][ inds ] cannot be included here.

4.6. Cartesian products

This is a generic representation for Cartesian products. The global type of the object is the same of the type of its arguments (which must be all of the same type). There is no natural unity here, so CartesianProduct[] will stay unevaluated.

SetAttributes[CartesianProduct,{Flat,OneIdentity}];

The standard missing definition:

Verbatim[CartesianProduct][x_]:=x;

General properties:

Dagger[x_CartesianProduct]^:=Dagger/@x;

Generic operations:

CartesianProduct::len="Incompatible lengths `1` of Cartesian products.";
ThreadCartesianProduct[prod_,{cprods__}]:=With[{lengths=Length/@{cprods}},
CartesianProduct@@MapThread[prod,List@@@{cprods},1]/;SameQ@@lengths||Throw@Message[CartesianProduct::len,lengths]
];

Formatting:

PrintAs[x_CartesianProduct]^:=StringJoin@@Riffle[PrintAs/@List@@x,"×"];
MakeBoxes[CartesianProduct[x__],StandardForm]:=MakeSequenceBox[{x},"×",StandardForm];

Note that we assume that:

c_CartesianProduct[y_]

means that c is a mapping (could be a chart in particular). Then

phi_?MappingQ[c_CartesianProduct]

means that c is a point (a 0-dim manifold).

5. Indices

(**********************************************************************)
(***************************** 5. Indices *****************************)
(**********************************************************************)

{TimeUsed[],SessionTime[],TimeUsed[]/SessionTime[]}

5.0. Comments

If[$ReadingVerbose,Print["Reading section 5: Indices."],Null,Null];

xTensor is mainly an index manipulator, and hence it is essential to discuss which types of indices are allowed. The basic index type is the abstract index, a carrier of information on the slot of a tensor. Then there are basis/component indices, directional indices (vectorial arguments) and labels (a general, non-tensorial, concept of index). In version 1.0 xTensor introduces a general concept of index-modifier M, such that if x is interpreted as an index then M[x] is also an index. Index-modifiers return True under IModQ. Perhaps index-modifiers should be a type in the future, but currently they are not.

Reading all this, years after the first design of xTensor, I think xTensor is too strict on what indices are, for example requiring that abstract indices are symbols. That might be an advantage sometimes for pattern matching but makes generalizations quite difficult. The choice a, -a is also rather asymmetric and does not go well with basis indices.

0) This section contains the index notations, but not the routines to handle index simplifications. In principle this section should be applicable to (the indices of) all data-types.

1) Many of these functions should not be directly used by the user. Perhaps they should be even grouped in a special subcontext xTensor`Index` .

2) The main decision here is how to represent indices. Essentially we find again the same two opposite choices that we found when choosing the representation for a tensor: simplicity suggests using indices like a, -b, but pattern matching suggests using indices like Index[a, Up] or Index[b, Down]. Given that the fraction of patterns to be introduced is small in comparison to the total number of indices to use, we decide to use the former. That's also simpler for the user, though it complicates my life as a programmer...

3) There is then the problem of basis indices. They need to be "marked" indices, that is, having a basis-name argument. I have changed my mind several times in this regard, and currently the system allows two possibilities:
	- My original choice (with the slight variation since 0.9.2 of moving the sign of the basis instead of that of the index) is {a, basis} or {2, -basis}.
	- Now (since 0.9.4) it is also possible to use basis[a] and -basis[2]. This has been consistently implemented in xTensor, but not yet in xCoba.
	- Another  alternative could be using U[0, basis] and L[0, basis], which has the problem of needing two different heads but is much more symmetric.
	- My impression is that we should use something more flexible, like arbitrary nested expressions basis[metric[projector[a]]], though flexible always means slower...

4) In 0.9.4 I have decided to relax the strict requirements on the indices that can be manipulated and allow anything at index-slots. Anytime the indices are manipulated a few functions like UpIndex, EIndexQ, etc. must know what to do with any type of index they find. Many functions still expect abstract indices to be symbols, and that hasn't been generalized at all yet.

5) Currently, in a tensor we can find these five types of "generalized indices" (GIndex):
	- abstract indices (AIndex) like a, -a, a$12, ...
	- basis indices (BIndex): lists {i, basis} or {-i, -basis} (BASIS1 notation), or expressions basis[i] or -basis[i] (BASIS2 notation), where i is an abstract index.
	- component indices (CIndex): lists {i, basis} or {i, -basis} (BASIS1 notation), or expressions basis[i] or -basis[i] (BASIS2 notation), where i is a "cnumber" (component or coordinate number) integer. The integer can be positive, negative or zero.
	- directional indices (DIndex): 1-tensor expressions with head Dir.
	- label indices (LIndex): any expression with head LI, perhaps multiplied by -1.
Additionally we can have:
	- pattern indices (PIndex): blanks, patterns and patterntests. Conditions are not allowed.
	- numerical indices (NIndex): integers, with the sign representing the character. Not yet developed.
	- "modified indices". This generalizes the BASIS2 construction, in such a way that we have "index-modifiers", responding to IModQ. In particular bases are possible index-modifiers.
All functions in this section should know what to do in all those cases. Or at least we should say why we do not need to specify what to do in some of them. In the past we were very strict on the types of indices, throwing errors if the index type was not recognized. Now I have changed my mind and prefer to allow any type of structure in index-slots, as long as the user has worried about consistency.

It is also convenient to define combined types. The first five types of indices (A, B, C, D, L) are generically called generalized indices (GIndex). Abstract and basis indices are the only types of indices which can be contracted right now: type ABIndex.  Basis and component indices are those associated to basis and charts: type BCIndex. Component indices and directions are those which represent directions: type CDIndex.

6) Another important decision is how to represent "index contraction" and the Einstein convention. Those indices obeying the Einstein convention are said to be contractible, traceable or of Einstein type (EIndex). Currently only indices of types A and B are contractible and hence, unless other indices are added to the system types AB and E are equivalent. (QUESTION: can basis indices be actually repeated three or more times? Can they be non-contracted, in the sense of being repeated but not representing a range, as it is often said in many books? Currently that is not possible in xTensor. That would require indices of type B not being of type E.). Indices which are not of type E are called "blocked indices".

7) Starting version 0.9.8 we allow abstract indices in 1-dim vector spaces to be repeated. We must be careful with the definition of free and dummy indices: T[o,o,-o,-o] is a scalar, but T[o,o,-o] is a vector.

8) An index can have a state: free, contracted (or dummy) and blocked. Indices of types C, D, L are always blocked. It is difficult to define the state of a pattern index because the pattern may stand for different things. This is an unsolved (and probably unsolvable) problem; we simply try to not find this case.

9) Finally there is a third classification of indices, by their character, which can be contravariant (UpIndices) or covariant (DownIndices). Again it is not simple to associate a character to a pattern index. An index like i_ could match anything, including another pattern. Perhaps this is want we really want, but in general it will not be the case. Once the pattern has a head (Blank[head]) there is no problem with characters, but an index without a head could generate problems. Therefore the recommendation is using heads when possible. Other solution is using Q-functions (PatternTest).

10) We assume indices can be evaluated at any stage of the calculation. We advise against the use of indices that change their character during the evaluation process. For instance, do not define a={1, polar} if a is an abstract index.

11) The indices of a Lie derivative    LieD[ v ][ expr ]    are those of expr and not the index of the vector field v. The same thing happens with Lie brackets: the index of Bracket[v1, v2][a] is just a, and not the indices of v1, v2. Directional indices of the form Dir[v] do not add the indices of v to the expression they are in.

12) We have introduced a symbol type called AbstractIndex for the indices. This means that we cannot have a tensor sharing a name with an index. This is an important restriction and sometimes it is a pity not being able to define a tensor A[a] because A is already an index on some other vector bundle. The reason is mainly safety: it would be dangerous to have situations like these:

BeginExamples[]

B[C]/.B[A_]->A[A]

B[C]/.B[D_]->Module[{A},A[D,A]B[-A]]

Remove[A,B,"A$*"]

EndExamples[]

In order to avoid them we should check all rules for conflicts, and that would be difficult and slow. On the other hand there is the possibility of having any output name for a given tensor (because that name is a string, not a symbol), and one reason more in favour of our decision is the recommendation of using meaningful names for tensors, like Riemann or MaxwellF, etc, and leave one-letter symbols as indices.

12) There is the issue of declaring different index types for a single vbundle, like MathTensor does with its four kinds of indices: ui, aui, bui, cui, with different outputs as i, i', i'', i'''. I'm not sure what this would be useful for. Perhaps we could use a second type of indices to denote projection, along the lines of the AB notation in my bssn papers, even though the right way to do it would be to decompose the M3 manifold into a local product of a 2-manifold and a 1-manifold. This is a project for the future.

13) There is an important point of possible conflict: lists of indices and indices which are lists (basis indices; BASIS1). We introduce the head IndexList to identify lists of indices. There are some exceptions: those cases where the user interacts with or sees lists of indices: the output of IndicesOfVBundle and the lists in Module constructions. Using lists to denote indices was a bad idea...

Formatting for IndexList. Following the formatting of Scalar, we print braces of the list in blue.

?IndexList

?$IndexListColor

$IndexListColor=RGBColor[0,0,1];

MakeBoxes[IndexList[inds___],StandardForm]:=interpretbox[IndexList[inds],RowBox[Flatten[{StyleBox["{",FontColor->$IndexListColor],MakeSequenceBox[{inds},", ",StandardForm],StyleBox["}",FontColor->$IndexListColor]}]]]

BeginExamples[]

List[a,b,c]

FullForm[%]

IndexList[a,b,c]

FullForm[%]

Remove[a,b,c]

EndExamples[]

IndexList is used by:
	- TakeEPairs and TakeOrderedEPairs: both as input and output.
	- TakeFrees: both as input and output.
	- IndexPosition: only as input.
	- IndexOrderedQ: only as input. User-function: it also allows List.
	- IndexSort: only as input. User-function: it also allows List.
	- CheckRepeated: both as input and output.
	- CheckHomogeneity: both as input and output.
	- CheckIndexType: both as input and output.
	- FindIndices: only as output.
	- FindDummyIndices: only as output.
	- FindFreeIndices: only as output.
	- ReplaceIndexList: both as input and output.
	- ReplaceDummies: only as input.
	- SameVBundleRules: only as input.
	- screenrules: only as input.
	- PermuteIndices: only as input.
	- symperms: only as input.
	- SymmetryEquivalentsOfTensor: only as input.
	- ToSlotRules: only as input.
Functions that expect (or give) a List of indices, and not IndexList:
	- SSSBinds: only as input.
	- GetIndicesOfVBundle: both as input and output.
	- ImposeSymmetry: only as input.

14) A note on the plural of "Index":

Taken from somewhere in the internet:

	The plural of "index" for books, journals and newspapers is "indexes"; the plural of "index" for graphs and benchmarks for economics for example, is "indices"; but the plural of "appendix" is always "appendices".
	
I think the "index" of a tensor must follow the rule for the second group, and hence its plural will be "indices". In Spanish we only have "índice" in singular and "índices" in plural, and so "indices" is also nicer for me.

5.1. DefAbstractIndex

5.1.0. Comments

This function just checks that the symbol is not already in use and registers it. We do not append the symbol to $AbstractIndices because this list is constructed from IndicesOfVBundle. At this level there is no association of an index to any vector bundle. This will be done when the vector bundle is defined, below.

5.1.1. ValidateIndex

DefAbstractIndex gives a warning if the symbol is one of the capitals used by Mathematica: (C,D,K,N,O). Recall that E, I have numeric value and therefore can never be used as indices.

ValidateSymbol::capital="System name `1` is overloaded as an abstract index.";

?ValidateIndex

The function ValidateIndex is assumed to be used only at definition time. That is, it cannot be used during the computations to check that a given index is correct. Use GIndexQ for that.

ValidateIndex[symbol_,capitalmessage_:True]:=(
ValidateSymbol[symbol];
ValidateSymbolInSession[symbol];
If[capitalmessage&&xAct`xCore`Private`SystemCapitalQ[symbol],Message[ValidateSymbol::capital,ToString[symbol]]];
);

5.1.2. Definition

The function DefAbstractIndex could be private, but it is left public for the sake of coherence with the rest of types of symbols. Note that even though DefAbstractIndex has an option PrintAs, it actually cannot be used from DefVBundle. Unless we invent some new notational device, the user must declare separately the PrintAs form of the indices. Given that any Mathematica symbol can be an abstract index, this is not typically required, though indices associate to pullback vbundles could be quite large.

??DefAbstractIndex

We use xUpSet because symbol could be already protected. There is nothing here related to the complex character of the indices. That is exceptionally handled through the specific function DaggerIndex. Same thing happens with pullbacks and PullBackIndex. There is no MakeDefInfo message.

Options[DefAbstractIndex]={PrintAs->Identity,ProtectNewSymbol:>$ProtectNewSymbols};
DefAbstractIndex[list_List,rest___]:=Scan[DefAbstractIndex[#,rest]&,list];
DefAbstractIndex[symbol_Symbol,options:OptionsPattern[]]:=Module[{pa,pns},
{pa,pns}=OptionValue[{PrintAs,ProtectNewSymbol}];
(* Validate index *)
ValidateIndex[symbol];
(* Value for NoDollar. Store $ModuleNumber to remove associated dollar-indices *)
If[xAct`xCore`Private`SystemCapitalQ[symbol],NoDollar[symbol]=symbol,NoDollar[symbol]^=symbol];
ModuleNumberOfIndex[symbol]=$ModuleNumber;
(* Register index *)
xUpSet[AbstractIndexQ[symbol],True];
SetPrintAs[symbol,PrintAsString[symbol,pa]];
If[pns,Protect[symbol]];
]
SetNumberOfArguments[DefAbstractIndex,{1,Infinity}];
Protect[DefAbstractIndex];

5.1.3. Undefinition

Corresponding Undef function. We remove on the fly all associated dollar-indices:

UpValues/@{System`C,System`D,System`K,System`N,System`O}

Note that there are no visitors or servants here (the dollar indices could be considered as servants, but they are dealt with in a different way). There is no undefinition message either.

UndefAbstractIndex[list:{___?AbstractIndexQ}]:=Scan[UndefAbstractIndex,list];
UndefAbstractIndex[symbol_]:=Module[{},
If[!AbstractIndexQ[symbol],Throw@Message[UndefAbstractIndex::unknown,"index",symbol]];
If[xAct`xCore`Private`SystemCapitalQ[symbol],xUpSet[UpValues[symbol],{}];Return[]];
CheckRemoveSymbol[symbol];
RemoveDollarIndices[ModuleNumberOfIndex[symbol],symbol];
RemoveSymbol[symbol];
];
SetNumberOfArguments[UndefAbstractIndex,1];
Protect[UndefAbstractIndex];

5.1.4. Removing dollar indices

Dollar indices are removed starting from a give ModuleNumber:

RemoveDollarIndices[number_Integer]:=Map[RemoveDollarIndices[number,#]&,$AbstractIndices];
RemoveDollarIndices[number_Integer,index_Symbol]:=Remove/@Cases[numberpair/@Names[StringJoin[ToString[index],"$*"]],{x_,n_}:>x/;n≥number];
numberpair[string_String]:={string,ToExpression@StringJoin[Characters[string]//.{{___,"$"}->{"0"},{___,"$",n__}->{n}}]};

BeginExamples[]

DefAbstractIndex[a]

?a

Module[{a},a]

xATP`NoDollar[%]^=a;

UndefAbstractIndex[a]

The index a is not there:

?a

nor the dollar-index which was associated to the index through NoDollar:

?a$*

EndExamples[]

5.1.5. Used symbols. Deactivated

We will see that indices can be removed, not only the dollar-indices. This can be a problem if some expressions stored in memory still contain that symbol. Mathematica does not provide us with a function checking whether a symbol is still in use, apart from the use of the attribute Temporary (for Module only) in an indirect way (a symbol with Temporary attribute is still in use if it still exists). A typical problem is that lots of symbols are used in the stored values for In or Out. I have tried to define a set of functions taking care of this point, but the result were rather bad. Example:

Values[name_]:=Join@@Through[{Attributes,DefaultValues,DownValues,FormatValues,Messages,NValues,Options,OwnValues,UpValues,SubValues}[ToExpression[name]]]

UsedSymbolQ[symbol_Symbol,context_:$Context]:=Module[{TF=False},
If[Position[#[[2]],symbol]=!={},TF=True;
Message[UndefAbstractIndex::noundef,"Symbol",symbol,"it is used in a value of "<>ToString[#[[1]]]]]&/@({#,Values[#]}&/@$AllObjects);
If[Position[#,symbol]=!={},TF=True;Message[UndefAbstractIndex::noundef,"Symbol",symbol,"it is used in In["<>ToString[#[[1,1,1]]]<>"]"]]&/@Drop[DownValues[In],-1];
If[Position[#,symbol]=!={},TF=True;Message[UndefAbstractIndex::noundef,"Symbol",symbol,"it is used in In["<>ToString[#[[1,1,1]]]<>"]"]]&/@DownValues[Out];
TF]

BeginExamples[]

xATP`UsedSymbolQ[A]

xATP`UsedSymbolQ[xATP`TF]

Remove[A]

EndExamples[]

5.2. Notations

5.2.0. Comments

Note the difference between an AbstractIndex (symbol a, for example) and an AIndex (either a or -a, or a$10). AIndex is
	a) any symbol in $AbstractIndices modulo UpIndex/DownIndex and dollar
	b) which is at one of the expected positions for a g-index (in particular, never a head)

Comments:
	- The functions defined in this subsection 5.2. act directly on the indices, and not on the objects having indices.
	- None of the functions in this section holds its arguments; that is, all arguments are evaluated before the function is applied.
	- There is no ERROR[...] output. ERROR only wraps whole mathinput expressions.
	
Given a vector space V with abstract indices a, b, c, ... then we have its dual V* with indices -a, -b, -c, ..., its complex conjugate V† with indices a†, b†, c†, ..., and the dual of the latter V†* with indices -a†, -b†, -c†, ... We need to be able to manipulate those four cases simultaneously. Note that even though there is a close relation between indices a, -a or between a†, -a†, there is no relation whatsoever between indices a, a†. Frequently Hermitain pairs of indices are represented using  something like a, a†, but this is not necessary, and we will not assume that a pair like that is always a Hermitian pair. To change from V to V* use ChangeIndex, and to change from V to V† use DaggerIndex.

The functions in the following four subsections have been defined to minimize interferences among them. They have also been designed to be as little restrictive as possible:
	- UpIndex/DownIndex/ChangeIndex essentially play with the minus sign
	- EIndexQ/BlockedQ define which indices can be contracted and then use ChangeIndex to find pairs.
	- NoDollar removes a $ sign from an index, independently of its up/down character of its contractibility.
	- DaggerIndex adds a † sign to an abstract index, with the convention that † always comes before $.

In version 1.0 we add index-modifiers. It would be nice if those modifiers didn't change the type of index, but because the type is hardwired in the expression pattern, this is not possible. Hence, we consider a new type of indices, called "modified indices", say of type MIndex (not defined yet), of the form mod[aindex]. Index-modifiers give True under IModQ. Right now we have only bases.

IModQ[_Symbol?BasisQ]:=True;
IModQ[_]:=False;
SetNumberOfArguments[IModQ,1];
Protect[IModQ];

A very important issue is that of indices in a 1D vector space. The key point is that we only need one index, say O. Then a tensor we will have scalars T[] or T[O,-O], T[O, -O, -O, O], etc, vectors T[O], T[O, O, -O], etc. In order to know the free indices and the component indices we need to know how many there are.

5.2.1. Up/Down: UpIndex, DownIndex, ChangeIndex, UpIndexQ, DownIndexQ. Also private upQ, downQ

0) There are many ways of representing upstairs/downstairs indices. They all boil down to the introduction of three concepts:
	indices: a, b, c,...
	upindices: up[a], up[b], up[c],...
	downindices: down[a], down[b], down[c],...
where up, down represent some notational actions obeying 7 properties:
	up[up[a]] = up[a]
	up[down[a]] = up[a]
	down[up[a]] = down[a]
	down[down[a]] = down[a]
	noupdown[up[a]] = a
	noupdown[down[a]] = a
	noupdown[a] = a
It would be very nice to implement some easy way to change from one notation to another, but I think that it would slow down the computations.

Here I choose the simplest representation of the up/down, which identifies indices and upindices. (There is a clear asymmetry here.) It is also used as a check on g-indices. Note that the sign on integers must be dealt with separately because the -_ pattern does not match a negative integer:

BeginExamples[]

List[a,-a,1,-1,-{1}]/.-x_->xATP`down

Remove[a,x]
EndExamples[]

1) UpIndex / DownIndex / ChangeIndex on g-indices and patterns.

?UpIndex

?DownIndex

?ChangeIndex

Indices of types B, C, D require special handling:

(* Exception: D-indices *)
UpIndex[Dir[v_]]:=With[{u=UltraindexOf[v]},Dir[ReplaceIndex[v,u->DownIndex[u]]]];
DownIndex[Dir[v_]]:=With[{u=UltraindexOf[v]},Dir[ReplaceIndex[v,u->UpIndex[u]]]];
ChangeIndex[Dir[v_]]:=With[{u=UltraindexOf[v]},Dir[ReplaceIndex[v,u->ChangeIndex[u]]]];

(* Exception: C-indices. BASIS1 *)
UpIndex[{a_Integer,basis_}]:={a,UpIndex[basis]};
DownIndex[{a_Integer,basis_}]:={a,DownIndex[basis]};
ChangeIndex[{a_Integer,basis_}]:={a,-basis};

(* Exception: B-Indices. BASIS1 *)
UpIndex[{a_,basis_}]:={UpIndex[a],UpIndex[basis]};

(* New exception: integers *)
UpIndex[a_Integer?Negative]:=-a;

(* Main definitions, handling all other cases *)
UpIndex[-a_]:=a;
UpIndex[a_]:=a;
DownIndex[a_]:=-UpIndex[a];
ChangeIndex[a_]:=-a;

SetNumberOfArguments[#,1]&/@{UpIndex,DownIndex,ChangeIndex};
Protect[UpIndex,DownIndex,ChangeIndex];

Note that by definition, nearly everything without a minus in front, including Blank[] or some other patterns for downindices, is an upper index. The way to avoid problems is giving heads (that is, the argument of Blank) to the patterns. Non-head patterns with a minus in front are not problematic.

It is not interesting to set the attribute HoldAll to UpIndex because that could prevent many expected evaluations. For example the evaluation of temporary indices in Module. We have already said that we assume that g-indices can be evaluated at any stage.

Examples:

BeginExamples[]

UpIndex[_]

UpIndex[-_]

UpIndex/@List[a,-b,ab,a1,{2,-Polar},{-k_,-Polar},1,-1]

UpIndex/@List[a,-a,{-1,-Polar},_,-_,a_,-a_,a_?Q,-a_?Q]

DownIndex/@List[a,-a,{1,Polar},_,-_,a_,-a_,a_?Q,-a_?Q,1,-1]

UpIndex/@{Polar[a],Polar[1],-Polar[a],-Polar[1],Polar[-1],-Polar[-1]}

DownIndex/@{Polar[a],Polar[1],-Polar[a],-Polar[1],Polar[-1],-Polar[-1]}

%+%%

Trace[UpIndex[-b]]

Examples with ChangeIndex:

ChangeIndex/@List[a,-a,{-1,-Polar},a_,-a_,a_?Q,-a_?Q,Polar[a],-Polar[a],1,-1]

Remove[a,a1,ab,b,k,Polar,Q]

EndExamples[]

2) We implement two types of UpQ functions. The first one is purely based on UpIndex and it is as general as UpIndex and perfectly consistent with it. Everything which is not recognized returns True under upQ and False under downQ. There are no errors, perhaps except those coming from D-indices. This is a function to be used only in programming, in those places in which we could be working with patterns:

?upQ

?downQ

upQ[a_]:=a===UpIndex[a]
downQ[a_]:=a===DownIndex[a]

Secondly, these are the user functions, which give always False on patterns. That is the only difference with upQ and downQ.  Note that there is no AbstractIndexQ check nor BasisQ, but we include an IModQ check. This is more a plausibility check than a real check. That is, we are checking the notations for up-indices and down-indices, not the fact that the indices are proper g-indices. Note also that they are constructed independently of UpIndex and DownIndex.

(* Accepted notations for up-indices *)
UpIndexQ[a_Symbol]:=True;
UpIndexQ[a_LI]:=True;
UpIndexQ[a_Dir]:=DownIndexQ[UltraindexOf[a]];
UpIndexQ[a_Integer]:=Positive[a];
UpIndexQ[{a_,b_Symbol}]:=True; (* BASIS1 *);
UpIndexQ[(b_?IModQ)[a_]]:=True; (* BASIS2 & IMOD *);
UpIndexQ[a_]:=False;
SetNumberOfArguments[UpIndexQ,1];
Protect[UpIndexQ];

(* Accepted notations for down-indices *)
DownIndexQ[-a_Symbol]:=True;
DownIndexQ[-a_LI]:=True;
DownIndexQ[a_Dir]:=UpIndexQ[UltraindexOf[a]];
DownIndexQ[a_Integer]:=Negative[a];
DownIndexQ[{a_,-b_Symbol}]:=True; (* BASIS1 *);
DownIndexQ[-(b_?IModQ)[a_]]:=True; (* BASIS2 & IMOD *);
DownIndexQ[a_]:=False;
SetNumberOfArguments[DownIndexQ,1];
Protect[DownIndexQ];

Those two functions are stricter than upQ and downQ. Therefore, if a new type of index is introduced, even if it follows the plus/minus rules, new definitions will be needed here.

UpIndexQ is used in all cases except the following five, in which we use upQ:
	- TakeUp: for generality. We get the up-patterns as well.
	- IndexSort: to sort patterns
	- DummyAs
	- addChristoffel
	- xTensorFormStart: to format patterns
Then downQ is used only in
	- IndexSort: to sort patterns
	- MakeBoxesCovD

BeginExamples[]

list=List[a,-a,{1,-Polar},{1,Polar},_,a_,-a_,a_?Q,-a_?Q,1,-1];

upQlist=xATP`upQ/@list

downQlist=xATP`downQ/@list

UpIndexQlist=UpIndexQ/@list

DownIndexQlist=DownIndexQ/@list

Note that upQ and downQ are always different, while UpIndexQ and DownIndexQ always coincide on non-recognized indices and patterns, giving False. I don't know why Mathematica generates so many OutputFormDump` variables here:

TableForm[Transpose[{ToString/@list,upQlist,downQlist,UpIndexQlist,DownIndexQlist}],TableHeadings->{Automatic,{"Index","upQ","downQ","UpIndexQ","DownIndexQ"}}]

Remove[a,Polar,Q,list,upQlist,downQlist,UpIndexQlist,DownIndexQlist]

EndExamples[]

Again, it would be nice to define everything in terms of UpIndex, DownIndex and ChangeIndex, without using signs anymore. That would allow us to easily change notation of up/down indices. However it would be rather slow.

5.2.2. Contraction

0) First of all we need to specify which indices can be considered as representing a contraction and which cannot. Abstract indices are always contractible:

?EIndexQ

?BlockedQ

(* Signs are irrelevant for contractibility *)
EIndexQ[-a_]:=EIndexQ[a];
BlockedQ[-a_]:=BlockedQ[a];
(* Abstract indices are always contractible *)
EIndexQ[_Symbol]:=True;
Blocked[_Symbol]:=False;

We can define these two functions specifying which types (A, B) are contractible and defining everything else to be blocked, including patterns (now deactivated):

(* Priority to EIndexQ *)
EIndexQ[{a_,_}]:=EIndexQ[a]; (* BASIS1 *);
EIndexQ[_?IModQ[a_]]:=EIndexQ[a]; (* BASIS2 & IMOD *);
EIndexQ[_]:=False;
BlockedQ[a_]:=Not@EIndexQ[a];

We proceed in the reverse way, removing blocked indices of types C, D, L. This is to allow contraction in the general case, for example with patterns or modified indices (note that imod[integer] is considered here a e-index, unless the imod is a basis) :

(* Priority to BlockedQ *)
BlockedQ[{_Integer,_}]:=True; (* BASIS1 *);
BlockedQ[_Symbol?BasisQ[_Integer]]:=True; (* BASIS2 *);
BlockedQ[_LI]:=True;
BlockedQ[_Dir]:=True;
BlockedQ[_]:=False;
EIndexQ[a_]:=Not@BlockedQ[a];
SetNumberOfArguments[#,1]&/@{EIndexQ,BlockedQ};
Protect[EIndexQ,BlockedQ];

1) Contractible indices can be in two different states: contracted (or dummy) or non-contracted (or free). Now we need functions to select free and dummy indices from a list of g-indices and patterns. Note that they are defined in terms of EIndexQ and ChangeIndex, and do not use UpIndex or DownIndex. Note also that there is no assumption on the head of the lists of indices: the final list will have the same head of the input.

(* Separate E-indices from blocked indices *)
TakeEIndices[list_]:=Select[list,EIndexQ];
TakeBlocked[list_]:=Select[list,BlockedQ];

(* Take or drop pairs *)
TakePairs[list1_,list2_]:=Intersection[list1,ChangeIndex/@list2];
DropPairs[list1_,list2_]:=Complement[list1,ChangeIndex/@list2];
TakePairs[list_]:=TakePairs[list,list];
DropPairs[list_]:=DropPairs[list,list];

(* Take or drop E-pairs *)
TakeEPairs[list_]:=TakePairs[list,TakeEIndices[list]];
DropEPairs[list_]:=DropPairs[list,TakeEIndices[list]];

TakeFrees[list_]:=DropPairs[TakeEIndices[list]];
TakeOrderedEPairs[list_]:=DeleteCases[list,Alternatives@@Verbatim/@DropEPairs[list]];

Summarizing: given a list of indices, we can separate:
	- blocked indices: TakeBlocked
	- free indices: TakeFrees
	- dummy pairs: TakePairs or TakeOrderedEPairs

Examples:

BeginExamples[]

xATP`TakeEPairs[IndexList[a,b,-c,-a,c,-c,a,-a]]

This motivates the complicated structure of the function TakeOrderedEPairs:

xATP`TakeOrderedEPairs[IndexList[a,b,-c,-a,c,-c,a,-a]]

Study these cases:

xATP`TakeEPairs[IndexList[a,b,-a,Dir[v[a]],Dir[v[a]]]]

BasisQ[Polar]^=True;

xATP`TakePairs[IndexList[a,b,-c,-a,c,{-a,Polar},{b,Polar},{-b,-Polar},Polar[1],-Polar[1],Pr[a],-Pr[a]]]

xATP`TakeEPairs[IndexList[a,b,-c,-a,c,{-a,Polar},{b,Polar},{-b,-Polar},Polar[1],-Polar[1],Pr[a],-Pr[a]]]

xATP`TakeEPairs[IndexList[a,b,-c,-a,c,-Polar[a],Polar[b],-Polar[b],Pr[a],-Pr[a]]]

Note that non-head patterns are not a problem here because in order to be paired we need to have a minus in front of one of the patterns. Here the problem are the non-named patterns, because there is no reason to assume that _ is paired with -_.

xATP`TakeEPairs[IndexList[a,b,-a_,Dir[v[a]],a_,b_?Q,-b_?Q,b_?Q1,_,-_]]

xATP`TakeOrderedEPairs[IndexList[a,b,-a_,Dir[v[a]],a_,b_?Q,-b_?Q,b_?Q1,_,-_]]

xATP`TakeEPairs[IndexList[a,-a_,a_?Q]]

xATP`TakeEPairs[IndexList[-a,-a_,a_?Q]]

xATP`TakeEPairs[IndexList[{1,Polar},{1,-Polar},{2,Polar},_]]

Remove[a,b,c,Polar,Pr,Q,Q1,v]
EndExamples[]

2) Imitate MathTensor's function PairQ. We could perhaps avoid it by removing the BASIS1 notation altogether.

?PairQ

(* Contracted B-indices *)
PairQ[{a_Symbol,basis_Symbol},{-a_Symbol,-basis_Symbol}]:=True; (* BASIS1 *);
PairQ[{-a_Symbol,-basis_Symbol},{a_Symbol,basis_Symbol}]:=True; (* BASIS1 *);
(* Contracted AB-indices, including BASIS2 & IMOD *)
PairQ[a_,-a_?EIndexQ]:=True;
PairQ[-a_,a_?EIndexQ]:=True;
(* Other cases *)
PairQ[_,_]:=False;
SetNumberOfArguments[PairQ,2];
Protect[PairQ];

Examples:

BeginExamples[]

rule:=f[a_,b_]:>g[a]/;PairQ[b,a]

f[-a,a]/.rule

BasisQ[Polar]^=True;

f[{-a,-Polar},{a,Polar}]/.rule

f[{-a,-Polar},a]/.rule

f[-Polar[a],Polar[a]]/.rule

Remove[a,b,f,g,Polar,rule]

EndExamples[]

3) This simple function returns an IndexList of the repeated indices in a given IndexList. Only one index per repeated set is returned. This function has nothing to do with Take(Ordered)EPairs. It looks for actually repeated g-indices (labels, directions and components). It is only used in ToCanonicalOne to look for the repes indices.

TakeRepeated[list_IndexList]:=First/@DeleteCases[Split@Sort[list],IndexList[_]]

This function is used to extract the up-indices of the (order-kept) lists of pairs of dummies:

TakeUp[list_]:=DeleteDuplicates[UpIndex/@list];

That has been deactivated. Right now we use instead:

TakeUp[list_]:=Select[list,upQ];

5.2.3. Dummies: NoDollar, DollarQ

Dummy indices are those that are contracted in an expression. It is useful to use unique names for dummies, to avoid index collisions. Here I follow Mathematica convention of unique variables denoted with a dollar. Note that 
	a) because I don't think this point will be changed, I introduce 'dollar' in the name of the function,
	b) dollars ARE eliminated from patterns (in the past this was not true),
	c) the definition on blanks must be in the first place to avoid confusion with the definition on a_
	d) the NoDollar index is generated by ToExpression rather than Symbol because it could contain a minus sign,
	e) there are no problems with unheaded patterns.
It is important to see that the unique variables $nnn trick is only safe within a session. If you save a result and then read it in a different session, there could be collisions. In that case, don't forget to use ReplaceDummies first on the read expression.

?NoDollar

(* Patterns. PINDEX *)
NoDollar[a_Blank]:=a;
NoDollar[a:(_Pattern|_PatternTest)]:=ReplacePart[a,NoDollar[First[a]],1];
(* Symbols. Use remembered values as upvalues of the index. Remove from the first dollar *)
NoDollar[a_Symbol]:=NoDollar[a]^=ToExpression[StringJoin[Characters[ToString[a]]/.{i___,"$",___}:>{i}]];
(* Signs: anything but integers *)
NoDollar[-a_]:=-NoDollar[a];
(* Integers *)
NoDollar[a_Integer]:=a;
(* Directions *)
NoDollar[v_Dir]:=v;
NoDollar[a:-_Dir]:=Throw@Message[Validate::nouse,"NoDollar",ToString[a]];
(* Labels *)
NoDollar[a_LI]:=a;
(* Component and basis indices *)
NoDollar[{a_,basis_}]:={NoDollar[a],basis}; (* BASIS1 *);
NoDollar[imod_?IModQ[a_]]:=imod[NoDollar[a]]; (* BASIS2 & IMOD *);
(* Other *)
NoDollar[]:=Throw@Message[Validate::nouse,"NoDollar","0 arguments"];
NoDollar[_,__]:=Throw@Message[Validate::nouse,"NoDollar","more than 1 arguments"];
NoDollar[a_]:=(Message[General::warning,"NoDollar has been used on "<>ToString[a],$WarningFrom];a);

It takes some time to convert a dollar-index to an index. That's why we define the function with "remembered values" on symbols. The special capital symbols cannot store those values because they are protected. We give them explicitly. Note that NoDollar is defined completely from scratch, without use of any other xTensor function. It is very safe. The remembered values generate a "memory leak" with the variables produced by Unique (see the comments below for the function DummyIn).

An important point to worry about is the context in which the symbol is created.

BeginExamples[]

xATP`NoDollar/@List[a$b$1,-a$$,{1,Polar},{1,-Polar},-Polar[a$]]

xATP`NoDollar/@List[x$,x$_,_,x$_?Q]

Trace[xATP`NoDollar[b$]]

Trace[xATP`NoDollar[b$]]

Catch@xATP`NoDollar[]

xATP`NoDollar[a[b]]

xATP`NoDollar[a+b]

Catch@xATP`NoDollar[a,b]

NoDollar is not a very efficient function, but I do not see how it could be improved:

Trace[xATP`NoDollar[-c$]]

Trace[xATP`NoDollar[-c$]]

xATP`NoDollar[{c$,Polar}]

xATP`NoDollar[Polar[c$]]

An alternative (not better) way could be:

xATP`NoDollar2[xATP`a_]:=ToExpression[StringDrop[#,-StringLength[#]+StringPosition[#,"$"][[1,1]]-1]&@ToString[xATP`a]]

Trace[xATP`NoDollar2[-c$]]

Remove[a,a$,a$b$1,a$$,b,b$,c,c$,Polar,Q,x,x$,xATP`NoDollar2]
EndExamples[]

Now we define the function DollarQ, independently of NoDollar, and again totally from scratch:

?DollarQ

(* Detect dollar indices *)
DollarQ[_LI|_Dir|_Blank|_Integer]:=False;
DollarQ[-a_]:=DollarQ[a];
DollarQ[symbol_Symbol]:=StringMatchQ[SymbolName[symbol],"*$*"];
DollarQ[x:(_Pattern|_PatternTest)]:=DollarQ[First[x]]; (* PINDEX *); 
DollarQ[{a_,_}]:=DollarQ[a]; (* BASIS1 *);
DollarQ[imod_?IModQ[a_]]:=DollarQ[a]; (* BASIS2 & IMOD *);

BeginExamples[]

Trace[xATP`DollarQ[-d$]]

xATP`DollarQ[{-d$,Polar}]

Remove[d$,Polar]
EndExamples[]

Compare to the old definition, given in terms of NoDollar:

DollarQ2[a_]:=a=!=NoDollar[a]

BeginExamples[]

xATP`DollarQ2/@List[a$,-a$,a,-a,{1,-Polar},{1,Polar}]

Trace[xATP`DollarQ[d$]]

Trace[xATP`DollarQ2[d$]]

Functions NoDollar and UpIndex commute on their common domain:

xATP`NoDollar[UpIndex[-a$]]===UpIndex[xATP`NoDollar[-a$]]

With our new definitions for UpIndex, they commute even in wrong cases:

Catch[xATP`NoDollar[UpIndex[a+b]]===UpIndex[xATP`NoDollar[a+b]]]

Remove[a,a$,b,d,d$,Polar]
EndExamples[]

Remove[DollarQ2]

There is no conflict at all between NoDollar and patterns or blocked indices. The only point is whether it is really necessary to drop dollars from pattern indices. Mathematica often introduces those dollar patterns to avoid conflicts and we could be interfereing with that. I think the removing of dollars in patterns only happens at formatting time.

5.2.4. DaggerIndex

We need to avoid interferences with the dollar indices. The convention (to avoid changing the dollar functions) is to have always the dollars after the dagger-character. Note that we only create the association pair (with remembered definitions); currently we do not give any other information for the newly created index. A new index is created only when we act on a dollar-index; otherwise the remembered pair of definitions already exists. For those indices we do not need to register additional information because they inherit it from the corresponding no-dollar-index.

?DaggerIndex

(* Thread over IndexList *)
DaggerIndex[list_IndexList]:=DaggerIndex/@list;
(* Abstract indices *)
DaggerIndex[-x_]:=-DaggerIndex[x];
DaggerIndex[x_Symbol]:=If[DaggerQ@VBundleOfIndex[x],
With[{dgx=MakeDaggerSymbol[x]},xUpSet[DaggerIndex[dgx],x];xUpSet[DaggerIndex[x],dgx]],
xUpSet[DaggerIndex[x],x]
];
(* Formal sequence of abstract indices *)
DaggerIndex[AnyIndices[vbundle_?VBundleQ]]:=AnyIndices[Dagger[vbundle]];
(* By default labels are considered real *)
DaggerIndex[x_LI]:=x;
(* Directional indices *)
DaggerIndex[Dir[v_]]:=Dir[Dagger[v]];
(* Component indices *)
DaggerIndex[ind:{a_Integer,basis_}]:=xAct`xCoba`DaggerCIndex[basis,ind]; (* BASIS1 *);
DaggerIndex[ind:basis_Symbol?BasisQ[a_Integer]]:=xAct`xCoba`DaggerCIndex[basis,ind]; (* BASIS2 *);
(* Basis indices *)
DaggerIndex[ind:{a_,basis_}]:=xAct`xCoba`Private`DaggerBIndex[basis,ind]; (* BASIS1 *);
DaggerIndex[ind:basis_Symbol?BasisQ[a_]]:=xAct`xCoba`Private`DaggerBIndex[basis,ind]; (* BASIS2 *);
(* Index modifiers *)
DaggerIndex[ind:imod_?IModQ[a_]]:=DaggerIMod[imod,ind]; (* IMOD *)
(* Integers *)
DaggerIndex[ind_Integer]:=(Message[DaggerIndex::error,"DaggerIndex on an integer. Assuming everything is real."];ind);
(* Default *)
DaggerIndex[x_]:=Throw@Message[DaggerIndex::unknown,"index",x];
SetNumberOfArguments[DaggerIndex,1];
Protect[DaggerIndex];

The private function DaggerIndexQ relates to DaggerIndex in the same way that DaggerQ relates to Dagger:

DaggerIndexQ[-x_]:=DaggerIndexQ[x];
DaggerIndexQ[x_Symbol]:=HasDaggerCharacterQ[x];
DaggerIndexQ[v_Dir]:=DaggerIndexQ[UltraindexOf[v]];
DaggerIndexQ[x_LI]:=False;
DaggerIndexQ[x_Integer]:=False;
DaggerIndexQ[{x_,basis_}]:=HasDaggerCharacterQ[basis]; (* BASIS1 *);
DaggerIndexQ[basis_Symbol?BasisQ[x_]]:=HasDaggerCharacterQ[basis]; (* BASIS2 *);
DaggerIndexQ[imod_?IModQ[x_]]:=HasDaggerCharacterQ[x]; (* IMOD *)
DaggerIndexQ[list_IndexList]:=UnsameQ[DaggerIndex[list],list];
(* The default is False. True? *)
DaggerIndexQ[x_]:=False;

5.2.5. PullBackIndex

Convert indices of a vbundle into indices of the pullback bundle. The convention here is to prepend the map, to avoid messing up with daggers, dollars and numbers. This function does not register the index. We assume that the (non-dollar) pullback indices have been already registered, including their typesetting.

PullBackIndex[x_,_IdentityMapping]:=x;
PullBackIndex[-x_,phi_]:=-PullBackIndex[x,phi];
PullBackIndex[x_Symbol,phi_]:=xTagSet[{x,PullBackIndex[x,phi]},RegisterPullBackIndex[MakePullBackIndex[x,phi],PullBackVBundle[VBundleOfIndex[x],phi]]];
PullBackIndex[AnyIndices[vbundle_?VBundleQ],phi_]:=AnyIndices[PullBackVBundle[vbundle,phi]];
PullBackIndex[x_LI,phi_]:=x;
(* We don't give freeindex rules. We let the system choose the indices *)
PullBackIndex[Dir[v_],phi_]:=Dir[PullBack[v,phi]];
(* We assume that a basis and its pullback have the same cnumbers, and in the same order *)
PullBackIndex[a_Integer,phi_]:=a;
PullBackIndex[{a_,basis_},phi_]:={PullBackIndex[a,phi],PullBackBasis[basis,phi]}; (* BASIS1 *)
PullBackIndex[basis_Symbol?BasisQ[a_],phi_]:=PullBackBasis[basis,phi][PullBackIndex[a,phi]]; (* BASIS2 *)
PullBackIndex[imod_?IModQ[a_],phi_]:=PullBackIMod[imod,phi][PullBackIndex[a,phi]]; (* IMOD *)
PullBackIndex[x_,phi_]:=Throw@Message[PullBack::unknown,"index",x];
SetNumberOfArguments[PullBackIndex,2];
Protect[PullBackIndex];

PullBackCharacter[phi_Symbol]:=$StarCharacter;
PullBackCharacter[SmallCircle[phis__]]:=ConstantArray[$StarCharacter,Length[{phis}]];

This function does the actual construction of the index name (JoinCharacters) and sets the PrintAs form, by appending a star to the PrintAs form of the original index (which may already have other stars):

MakePullBackIndex[x_Symbol,phi_]:=With[{pbx=JoinCharacters[phi,x]},
SetPrintAs[pbx,"\!\("<>PrintAs[x]<>"\^"<>PullBackCharacter[phi]<>"\)"];
pbx
];

If we have a composition of maps phi2∘phi1 then the index will be phi1phi2index

SetAttributes[CharacterList,HoldFirst];
CharacterList[phi_Symbol]:=Characters[ToString[phi]];
CharacterList[SmallCircle[phis__Symbol]]:=Flatten[CharacterList/@Reverse[{phis}]];
CharacterList[phi_]:=Throw@Message[PullBack::error1,"Cannot handle pullback of index under map",phi];
JoinCharacters[phi_,index_]:=ToExpression[StringJoin[Join[CharacterList[phi],CharacterList[index]]]];

Now we register the index in the corresponding vbundle. QUESTION: Do we need to register some relation involving the inverse mapping?

RegisterPullBackIndex[index_,vbundle_PullBackVBundle]:=With[{inds=IndicesOfVBundle[vbundle]},
If[!MemberQ[Flatten@inds,index],
xUpSet[AbstractIndexQ[index],True];
If[!DollarQ[index],AddIndexInSecondList[vbundle,index]]
];
index
];

5.3. Identification

5.3.0. Comments

The functions defined in this section are very basic and are defined mostly in terms of elementary Mathematica functions. In particular they do not depend on UpIndex/DownIndex/ChangeIndex. Functions used internally:
	- AIndexQ: NoDollar, AbstractIndexQ, VBundleOfIndex
	- BIndexQ: AIndexQ, VBundleOfIndex
	- CIndexQ: xAct`xCoba`CNumbersOf
	- DIndexQ: ValidateDir, UltraindexOf
	- LIndexQ:
	- MIndexQ:
	- PIndexQ: AIndexQ

There could be many different checks to make on a given index:
    	- type: A, B, C, D, L, AB, BC, CD, G, E
	- character: up, down
	- vector bundle: ...
The recommended way of testing them all is by constructing a user-defined checking function. We shall not try to write a generic testing function. This is because the pattern a_?f[x] is understood as (a_f?)[x] and not as a_?(f[x]), so it is better to define y=f[x] and use a_?y.

In this section we construct the type-checking functions. The character is checked with UpIndexQ and DownIndexQ.

Then there are "fast patterns" (low-level Mathematica) for certain combinations of type and character (the vector bundle is always checked through Q-functions):

					abstract indices	basis indices				component indices			directions		labels
		up-indices		a_Symbol	{a_Symbol, basis_Symbol}	{a_Integer, basis_Symbol}					_LI
		down-indices		-a_Symbol	{-a_Symbol, -basis_Symbol}	{a_Integer, -basis_Symbol}					-_LI
		both characters				{a_Integer, basis_}									_Dir

Note that there are no fast-patterns for both abstract and basis (or component) indices. That is a drawback of our notation, and could be why MathTensor uses la_ as a pattern, because it still accepts anything, while our pattern -i_ only accepts lower abstract indices. The pattern la_ is bad for other reasons, like the fact that it seems a pattern for lower indices but it actually accepts any pattern.

Patterns which would work nicely would be something like Index[a, Up, Abstract] and Index[a, Up, Basis[polar]], but those are only possible using a parser. An intermediate situation would be U[a], L[a] for abstract indices, U[a, polar], L[a, polar] for basis indices, and U[1, polar], L[a, polar] for component indices. Patterns would be:

						abstract indices	basis indices			component indices			directions	labels
		up-indices		U[a_Symbol]		U[a_Symbol, basis_]	U[a_Integer, basis_]		?			?
		down-indices		L[a_Symbol]		L[a_Symbol, basis_]	L[a_Integer, basis_]			?			?
		both characters	(U|L)[a_Symbol]	(U|L)[a_Symbol, basis_]	(U|L)[a_Integer, basis_]		?			?

Nice features of this notation would be that it would be possible to change indices in a simple way. For example:
	a->b			would change U[a], L[a], U[a, basis] and L[a, basis] at the same time
	a->{1, basis}	would change U[a] to U[{1, basis}], which would be automatically replaced by U[1, basis]
	a->1			would change U[a, basis] to U[1, basis] and L[a, basis] to L[1, basis] simultaneously

We could define U[1] to be automatically converted into U[1, basis] for some preferred basis.

In order to keep backward compatibility with the index notation a, -a we would need a parser changing all indices. This would match smoothly with additional parsers for other systems, like MathTensor. The problem with the parser is whether it would be simple or not to change the patterns in the old notation to the new patterns.

I'm not sure what could be good choices for directions and labels. It is not simple to deduce the character of a direction in general, but directions are not so often used, so probably the best option would be to keep the Dir symbol and compute the character on real time. Concerning labels, I think there should be a predefined "character" for their output, but U@ and L@ could still be used to modify it. In this way we mostly avoid the problems with signs.

Another idea, which is closer in spirit to what we have right now, in particular still keeping the asymmetry, is the following: given a basis polar, use polar[a], -polar[a], polar[1], -polar[1] as bc-indices. An  advantage is that it follows the pattern -x_. The main problem is that we would need to include many basis_?BasisQ[ind_] patterns instead of {ind_,basis_}. We must study whether this is worth or not. We could declare the following types of indices:
	* Abstract indices: symbol, -symbol
	* Marked indices: symbol[ expr ], -symbol[ expr ]:
		* Basis indices: basis[ symbol ]
		* Component indices: basis[ integer ]
		* Labels: LI[ exprs ]
		* Directions: Dir[ expr ]
The question is whether we can avoid the question ?BasisQ. We can if we declare that basis is any symbol which is not LI or Dir.

Fast patterns:
						abstract indices	basis indices				component indices			directions		labels
		up-indices		a_Symbol		basis_Symbol[a_Symbol]	basis_Symbol[a_Integer]					_LI
		down-indices		-a_Symbol		-basis_Symbol[a_Symbol]	-basis_Symbol[a_Integer]					-_LI
		both characters																	_Dir

with definitions for LI and Dir before those for bc-indices.

5.3.1. IndexOnQ. The vbundle`Q and vbundle`pmQ functions

This is the function that tests all indices (not only abstract indices) for membership of a given vector bundle:

?IndexOnQ

IndexOnQ[index_,vbundle_]:=SubvbundleQ[vbundle,VBundleOfIndex[index]];

I have tried to use SameQ instead of SubvbundleQ but we need the latter in xCoba. This is a tricky issue.

The functions vbundle`Q and vbundle`pmQ check only for abstract indices, and so they are not equivalent to IndexOnQ. They are also defined with remembered values, and hence are faster.

VBundleIndexQ[vbundle_]:=SymbolJoin@@Append[VBundleNameList[vbundle],"`Q"];
VBundleIndexPMQ[vbundle_]:=SymbolJoin@@Append[VBundleNameList[vbundle],"`pmQ"];
VBundleNameList[vbundle_Symbol]:={vbundle};
VBundleNameList[xAct`xCoba`TangentReals[dim_]]:={"TR",ToString[dim]};
MappingNameList[phi_Symbol]:={phi};
MappingNameList[SmallCircle[phis__Symbol]]:=Reverse[{phis}];
VBundleNameList[PullBackVBundle[vbundle_,phi_]]:=Join[MappingNameList[phi],VBundleNameList[vbundle]];
VBundleNameList[vbundle_]:=Throw@Message[VBundleIndexQ::error1,"TODO: Don't know yet how to construct the `Q and `pmQ functions of vbundle ",vbundle];

5.3.2. Abstract Indices: AIndexQ

Identification of abstract indices:

?AIndexQ

AIndexQ[-i_Symbol]:=AIndexQ[i];
AIndexQ[i_Symbol]:=AbstractIndexQ[NoDollar[i]];
AIndexQ[_]:=False;
AIndexQ[i_,vbundle_]:=AIndexQ[i]&&IndexOnQ[i,vbundle];
(* Special definition for a formal sequence of abstract indices *)
AIndexQ[AnyIndices[vbundle_]]:=VBundleQ[vbundle];
SetNumberOfArguments[AIndexQ,{1,2}];
Protect[AIndexQ];

Note that we need to use NoDollar because AbstractIndexQ does not recognize those dollar indices which have been not registered. There was a previous different coding using first DollarQ and then NoDollar only in those DollarQ=True cases. I'm not sure how much faster that was. The new coding is simply simpler.

This function gives False on a pattern for an abstract index:

AIndexQ/@{i_Symbol,-i_Symbol,i_}

We introduce a formal basis for the abstract indices, called AIndex.

?AIndex

(* A funny trick: AIndex is a basis *)
BasisQ[AIndex]^=True;
xAct`xCoba`BasisColor[AIndex]^=RGBColor[0,0,0];
xAct`xCoba`PDOfBasis[AIndex]^=PD;
xAct`xCoba`DependenciesOfBasis[AIndex]^={};
Dagger[AIndex]^=AIndex;

Note the funny rule converting -AIndex into AIndex inmediately. This is to allow conversion of {-a, -AIndex} into {-a, AIndex} and then into -a. This is dangerous (now deactivated):

(* This is dangerous *)
AIndex/:-AIndex:=AIndex; (* BASIS1 *)
AIndex/:{a_Integer,AIndex}:=Throw@Message[AIndex::invalid,a,"abstract index"]; (* BASIS1 *);
AIndex/:{a_?AIndexQ,AIndex}:=a; (* BASIS1 *);
AIndex[a_Integer]:=Throw@Message[AIndex::invalid,a,"abstract index"]; (* BASIS2 *);
AIndex[a_?AIndexQ]:=a;(* BASIS2 *);

Note that, even though -AIndex is converted into AIndex, we have that -AIndex[a] is not converted into AIndex[a].

5.3.3. Basis Indices: BIndexQ

Identification of basis indices:

?BIndexQ

(* One argument: check consistency of abstract index and basis *)
BIndexQ[-i_]:=BIndexQ[i];
BIndexQ[{i_?AIndexQ,basis_?BasisQ}]:=True; (* BASIS1 *);
BIndexQ[{i_?AIndexQ,-basis_?BasisQ}]:=True; (* BASIS1 *);
BIndexQ[basis_?BasisQ[i_?AIndexQ]]:=True; (* BASIS2 *);
BIndexQ[i_]:=False;
(* Two arguments: index and basis/vbundle *)
BIndexQ[-i_,x_]:=BIndexQ[i,x];
BIndexQ[i:{_,basis_},basis_]:=BIndexQ[i]; (* BASIS1 *);
BIndexQ[i:{_,-basis_},basis_]:=BIndexQ[i]; (* BASIS1 *);
BIndexQ[i:basis_[_],basis_]:=BIndexQ[i]; (* BASIS2 *);
BIndexQ[i_,vbundle_?VBundleQ]:=BIndexQ[i]&&IndexOnQ[i,vbundle];
BIndexQ[i_,_]:=False;
SetNumberOfArguments[BIndexQ,{1,2}];
Protect[BIndexQ];

This function gives False on a pattern for a basis index:

BIndexQ/@{i_List,{i_,basis},{i_}}

5.3.4. Component Indices: CIndexQ

Identification of component indices:

?CIndexQ

(* One argument: check consistency of integer and basis *)
CIndexQ[-i_]:=CIndexQ[i];
CIndexQ[{i_Integer,basis_}]:=MemberQ[xAct`xCoba`CNumbersOf[basis],i]; (* BASIS1 *);
CIndexQ[basis_[i_Integer]]:= MemberQ[xAct`xCoba`CNumbersOf[basis],i]; (* BASIS2 *);
CIndexQ[i_]:=False;
(* Two arguments: index and basis/vbundle *)
CIndexQ[-i_,x_]:=CIndexQ[i,x];
CIndexQ[i:{_Integer,basis_},basis_]:=CIndexQ[i]; (* BASIS1 *);
CIndexQ[i:{_Integer,-basis_},basis_]:=CIndexQ[i]; (* BASIS1 *);
CIndexQ[i:basis_[_Integer],basis_]:=CIndexQ[i]; (* BASIS2 *);
CIndexQ[i_,vbundle_?VBundleQ]:=CIndexQ[i]&&IndexOnQ[i,vbundle];
CIndexQ[i_,_]:=False;
SetNumberOfArguments[CIndexQ,{1,2}];
Protect[CIndexQ];

It might seem surprising that we do not use BasisQ here but effectively it is hidden in CNumbersOf.

This function gives False on a pattern for a component index:

CIndexQ/@{{i_Integer,basis},{i_,basis}}

Currently CIndexQ is only used in the conversion from delta to Basis, apart from the definitions of BCIndexQ, CDIndexQ and GIndexQ.

5.3.5. Labels: LIndexQ

Identification of label indices:

?LIndexQ

It cannot be simpler

LIndexQ[-_LI]:=True;
LIndexQ[_LI]:=True;
LIndexQ[_]:=False;
SetNumberOfArguments[LIndexQ,1];
Protect[LIndexQ];

This function gives False on a pattern for a label index:

LIndexQ/@{_LI,-_LI}

5.3.6. Directions: DIndexQ

Identification of directional indices:

In the definition with two arguments we are calling UltraindexOf[dir] twice because DIndexQ[dir] calls it again through ValidateDir. There is probably much redundancy among DIndexQ, ValidateDir and UltraindexOf, though they are clearly different.

?DIndexQ

DIndexQ[dir_Dir]:=dir===ValidateDir[dir];
DIndexQ[x_]:=False;
DIndexQ[dir_,vbundle_]:=DIndexQ[dir]&&IndexOnQ[UltraindexOf[dir],vbundle]
SetNumberOfArguments[DIndexQ,{1,2}];
Protect[DIndexQ];

This function gives False on a pattern for a directional index.

5.3.7. Modified indices: MIndexQ

MIndexQ[_?IModQ[i_]]:=GIndexQ[i];
MIndexQ[_]:=False;
SetNumberOfArguments[MIndexQ,1];
Protect[MIndexQ];

5.3.8. Contractible indices: ABIndexQ

This function identifies those indices which currently could be contracted: abstract-indices and basis-indices.

?ABIndexQ

ABIndexQ[i_]:=AIndexQ[i]||BIndexQ[i];
ABIndexQ[i_,master_]:=AIndexQ[i,master]||BIndexQ[i,master];
SetNumberOfArguments[ABIndexQ,{1,2}];
Protect[ABIndexQ];

This function is more careful than EIndexQ, but also slower.

5.3.9. Basis and component indices: BCIndexQ

This function identifies those indices which are associated to bases or charts:

?BCIndexQ

BCIndexQ[i_]:=BIndexQ[i]||CIndexQ[i];
BCIndexQ[i_,master_]:=BIndexQ[i,master]||CIndexQ[i,master];
SetNumberOfArguments[BCIndexQ,{1,2}];
Protect[BCIndexQ];

5.3.10. Component and directional indices: CDIndexQ

This function identifies those indices which are associated to components or directions:

?CDIndexQ

CDIndexQ[i_]:=CIndexQ[i]||DIndexQ[i];
CDIndexQ[i_,master_]:=CIndexQ[i,master]||DIndexQ[i,master];
SetNumberOfArguments[CDIndexQ,{1,2}];
Protect[CDIndexQ];

Currently this function is only used (in xTensor) in the code of ZeroDerOnMetricQ.

5.3.11. Generalized Indices: GIndexQ

Identification of generalized indices:

?GIndexQ

This function accepted patterns in version 0.7, but now it doesn't. This is a public function, and that could confuse the user, mainly because the functions UpIndexQ and DownIndexQ do not accept patterns.

(* Signs *)
GIndexQ[-_Dir]:=False;
GIndexQ[-x_]:=GIndexQ[x];
(* Patterns. Dropped in version 0.8 *)
(* GIndexQ[x:(_Blank|_Pattern|_PatternTest)]:=PIndexQ[x] *)
(* Known heads *)
GIndexQ[i_Symbol]:=AIndexQ[i];
GIndexQ[x_List]:=BCIndexQ[x]; (* BASIS1 *);
GIndexQ[x:_Symbol?BasisQ[_]]:=BCIndexQ[x]; (* BASIS2 *);
GIndexQ[x_Dir]:=DIndexQ[x];
GIndexQ[x_LI]:=True;
GIndexQ[_?IModQ[i_]]:=GIndexQ[i];
(* VBundle check *)
GIndexQ[i_,vbundle_]:=GIndexQ[i]&&IndexOnQ[i,vbundle];
(* Other *)
GIndexQ[_]:=False;
SetNumberOfArguments[GIndexQ,{1,2}];
Protect[GIndexQ];

Note that the definition GIndexQ[i_Symbol] must be given in terms of AIndexQ and not of AbstractIndexQ because the former admits the dollar-indices, but the latter doesn't.

These two functions check a list of indices, with any head, and return a list with head IndexList:

?ValidateGIndex

ValidateGIndex[i_]:=If[GIndexQ[i],i,Throw@Message[GIndexQ::unknown,"GIndex",i]];

?ValidateIndexList

ValidateIndexList[head_[inds___]]:=ValidateGIndex/@IndexList[inds];

The function ValidateGIndex (fully based on GIndexQ) is only used by ValidateIndexList. The latter is only used by IndexOrderedQ, which is currently not used. Essentially, it is a way to change a List of indices to an IndexList of indices. Perhaps we should remove those three functions altogether.

5.3.12. Patterns: PIndexQ, PatternToIndex

General comments on Mathematica patterns:

The heads that we must consider are: Blank, BlankSequence, BlankNullSequence, Alternatives, Pattern, PatternTest, Condition, Optional, Repeated, RepeatedNull, Verbatim, HoldPattern (See section Built-in Functions / Programming / Pattern Matching).

As an example, this is the most complicated pattern I can think of (with a single Blank and a single Repeated):

BeginExamples[]

FullForm[(a:(x___h?Q):v/;P)...]

This pattern could be also wrapped with HoldPattern or Verbatim and/or could be combined with other patterns using Alternatives. Therefore it is clear that the treatment of the general case of pattern is something rather involved.

Note that there are two ways of naming a pattern. They are identical only if there are no patterntests:

FullForm/@{x_h,x:_h}

FullForm/@{x_h?Q,x:_h?Q}

In any case, note that the name of a pattern or a patterntest is always in their first element. That is used several times in xTensor. In particular, the function PatternToIndex gives x in both cases.

Remove[a,h,P,Q,v,x]
EndExamples[]

We consider pattern indices involving these heads: Blank, Pattern and PatternTest. Comments on the other heads:
	- We do not accept BlankSequence, BlankNullSequence, Repeated or RepeatedNull because it is not possible to count indices.
	- We do not accept Alternatives or Optional, but they could be easily added if there is a good reason to do it.
	- The Condition construct is too difficult because the condition could be arbitrarily complicated.
	- Verbatim is too harsh and could interfere with internal Verbatim expressions.
	- HoldPattern is not accepted because the control of evaluation cannot be left to the user.
Do not use the pattern a:x_, with FullForm Pattern[a, Pattern[x, Blank[]]. xTensor expects to have the name of the pattern as first argument of Pattern. That means that the name x would be simply left untouched.
	
It is important to see that a generic expression can contain generic patterns. The previous restrictions are only on *pattern indices*.

We introduce these two functions to detect patterns indices, but they must be seldom used. Note that we do not need to use dollar indices for patterns because Mathematica already introduces unique symbols for them. These are also very basic functions that do not depend on any other xTensor function.

?PIndexQ

We check the head h in Blank[h]. Allowed heads are Dir, List, LI, Symbol, Pattern, PatternTest, Blank, and no one else.

(* Pattern recognition. BASIS1. PINDEX *)
PIndexQ[-x_]:=PIndexQ[x];
PIndexQ[{x_,basis_}]:=PIndexQ[x];
PIndexQ[Verbatim[Blank[]]]:=(Message[General::warning,"PIndexQ used on an empty Blank.",$WarningFrom];True);
PIndexQ[Verbatim[Blank[Symbol]]]:=True;
PIndexQ[Verbatim[Blank[List]]]:=True;
PIndexQ[Verbatim[Blank[Dir]]]:=True;
PIndexQ[Verbatim[Blank[LI]]]:=True;
PIndexQ[Verbatim[Blank[Blank]]]:=True;
PIndexQ[Verbatim[Blank[Pattern]]]:=True;
PIndexQ[Verbatim[Blank[PatternTest]]]:=True;
PIndexQ[x_Blank]:=(Message[Validate::nouse,"PIndexQ",ToString[x]];False);
PIndexQ[x_Pattern]:=PIndexQ[x[[2]]]&&AIndexQ[First[x]];
PIndexQ[x_PatternTest]:=PIndexQ[First[x]];
PIndexQ[_Condition|_Optional|_Alternatives|_BlankSequence|_BlankNullSequence|_Repeated|_RepeatedNull]:=Throw[Message[General::nouse,"PIndexQ","a forbidden pattern"]];
PIndexQ[_]:=False;
SetNumberOfArguments[PIndexQ,1];
Protect[PIndexQ];

Then we need a function to translate patterns to indices (note that it is private). We throw an error when we try to translate a Blank. What else could we do?

?PatternToIndex

(* Translate pattern to index. Note that Blank patterns ARE accepted, but not converted. PINDEX *)
PatternToIndex[-x_]:=-PatternToIndex[x];
PatternToIndex[x_Blank]:=Throw[Message[Validate::nouse,"PatternToIndex","a Blank pattern "<>ToString[x]]];
PatternToIndex[x_Pattern]:=PatternToIndex[First[x]];
PatternToIndex[x_PatternTest]:=PatternToIndex[First[x]];
PatternToIndex[{x_,basis_}]:={PatternToIndex[x],basis}; (* BASIS1 *);
PatternToIndex[imod_?IModQ[x_]]:=imod[PatternToIndex[x]]; (* BASIS2 & IMOD *);
PatternToIndex[x_Integer]:=x;
PatternToIndex[_Condition|_Optional|_Alternatives|_BlankSequence|_BlankNullSequence|_Repeated|_RepeatedNull]:=Throw[Message[Validate::nouse,"PatternToIndex","a forbidden pattern"]];
PatternToIndex[x_]:=x;

Note that PIndexQ does not make any attempt to analyze the structure of a Dir index. Only something like a_Dir is recognized as a pattern, if a is a valid abstract index.

BeginExamples[]

AbstractIndexQ[a]^=True;

PIndexQ/@List[{1,-Polar},{1,Polar},a,-a_,a_Symbol,a_h,a_?Q,Dir[v[a_]],{a_,Polar}]

Catch[xATP`PatternToIndex/@{a,a_,_a}]

xATP`PatternToIndex/@List[{1,-Polar},{1,Polar},a,-a_,a_Symbol,a_h,a_?Q,Dir[v[a_]],{a_,Polar}]

PIndexQ[_]

Catch@xATP`PatternToIndex[_]

Remove[a,Q,v,h,Polar]
EndExamples[]

Note that pattern indices in a Dir structure are dealt with during the analysis of indices of the vector of the Dir structure, and not during the analysis of the indices of the tensor having the Dir structure as an index.

PatternToIndex is only used by IndexSort: patterns are sorted according to their names.
PIndexQ is only used by MakeRule: we need to know which indices are patterns.

PIndexQ is considered as the equivalent of the functions like AIndexQ, BIndexQ, DIndexQ and LIndexQ. That is why it is public, even though it could be perfectly private.

5.3.13. Construction of patterns: PatternIndex

Currently we give definitions for abstract, directional and label indices, only. PINDEX

Off[RuleDelayed::rhs];
(* Abstract indices *)
PatternIndex[name_Symbol,AIndex,_:Null]:=PatternTest[Pattern[name,Blank[]],AIndexQ];
PatternIndex[name_Symbol,AIndex,xAct`xTensor`Up]:=PatternTest[Pattern[name,Blank[Symbol]],AIndexQ];
PatternIndex[name_Symbol,AIndex,xAct`xTensor`Down]:=-PatternTest[Pattern[name,Blank[Symbol]],AIndexQ];
PatternIndex[name_Symbol,AIndex,Null,vbundle_]:=With[{pmQ=VBundleIndexPMQ[vbundle]},PatternTest[Pattern[name,Blank[]],pmQ]];
PatternIndex[name_Symbol,AIndex,xAct`xTensor`Up,vbundle_]:=With[{mQ=VBundleIndexQ[vbundle]},PatternTest[Pattern[name,Blank[Symbol]],mQ]];
PatternIndex[name_Symbol,AIndex,xAct`xTensor`Down,vbundle_]:=With[{mQ=VBundleIndexQ[vbundle]},-PatternTest[Pattern[name,Blank[Symbol]],mQ]];
(* Directional indices *)
PatternIndex[name_Symbol,DIndex,_:Null]:=Pattern[name,Blank[Dir]];
PatternIndex[name_Symbol,DIndex,xAct`xTensor`Up]:=PatternTest[Pattern[name,Blank[Dir]],UpIndexQ];
PatternIndex[name_Symbol,DIndex,xAct`xTensor`Down]:=PatternTest[Pattern[name,Blank[Dir]],DownIndexQ];
PatternIndex[name_Symbol,DIndex,Null,vbundle_]:=PatternTest[Pattern[name,Blank[Dir]],(DIndexQ[#,vbundle])&];
PatternIndex[name_Symbol,DIndex,xAct`xTensor`Up,vbundle_]:=PatternTest[Pattern[name,Blank[Dir]],(UpIndexQ[#]&&DIndexQ[#,vbundle])&];
PatternIndex[name_Symbol,DIndex,xAct`xTensor`Down,vbundle_]:=PatternTest[Pattern[name,Blank[Dir]],(DownIndexQ[#]&&DIndexQ[#,vbundle])&];
(* Label indices *)
PatternIndex[name_Symbol,LIndex,_:Null]:=PatternTest[Pattern[name,Blank[]],LIndexQ];
PatternIndex[name_Symbol,LIndex,xAct`xTensor`Up]:=Pattern[name,Blank[LI]];
PatternIndex[name_Symbol,LIndex,xAct`xTensor`Down]:=-Pattern[name,Blank[LI]];
On[RuleDelayed::rhs];

SetNumberOfArguments[PatternIndex,{2,4}];
Protect[PatternIndex];

5.4. IndexSort

5.4.1. IndexOrdereQ and DisorderedPairQ

The main function IndexSort cannot be defined in terms of an IndexOrderedQ function because the sorting process depends on all indices, and not just on their pairs. This is due to the use of dummies. Actually we proceed in the opposite way: we define IndexOrderedQ in terms of IndexSort:

?IndexOrderedQ

This function is currently not being used in xTensor, but we still include it in the package.

IndexOrderedQ[list_List]:=IndexOrderedQ[ValidateIndexList[list]];
IndexOrderedQ[list_IndexList]:=list===IndexSort[list];
SetNumberOfArguments[IndexOrderedQ,1];
Protect[IndexOrderedQ];

This is a special version, with two indices, specially useful when ordering derivatives. It can only use the information supplied by the pair of indices. QUESTION: Should we generalize it to accept the rest of the information needed to fully sort the indices? I don't think so.

?DisorderedPairQ

DisorderedPairQ[a_,b_]:=IndexSort[IndexList[a,b]]===IndexList[b,a];
SetNumberOfArguments[DisorderedPairQ,2];
Protect[DisorderedPairQ];

5.4.2. Discussion of priorities for index sorting

First, we need to define a sorting order among different types of g-indices. The default lexicographic order of Mathematica already acts as an order for types, but it is not very convenient:

BeginExamples[]

Sort[{Dir[v[z]],Dir[v[-z]],a,-a,b,-b,{0,Polar},{0,-Polar},{1,Polar},{1,-Polar},{2,Polar},{2,-Polar},{a,Polar},{-a,-Polar},{b,Polar},{-b,-Polar},LI[1],LI[-1],LI[2],LI[-2],_,-_,b_,-b_,a_h,-a_h,a_?Q,-a_?Q,a_h?Q,-a_h?Q,Polar[a],-Polar[a],Polar[1],-Polar[1],Polar[2],-Polar[2]}]

Remove[a,b,h,v,z,Q,Polar]
EndExamples[]

We modify it using the function Sort0. This is fixed and cannot be changed by the user. Note that we always want to sort abstract indices before basis or component indices because Basis has Orderless attribute and we want to mimic that behaviour:

Sort0[-x_]:=Sort0[x];
(* Labels *)
Sort0[_LI]:=1;
(* Abstract indices *)
Sort0[_Symbol]:=2;
(* Basis indices *)
Sort0[{_Symbol|-_Symbol,_}]:=3; (* BASIS1 *);
Sort0[_?BasisQ[_Symbol]]:=3.1; (* BASIS2 *);
(* Modified indices. We need this definition after that for bases, though it is marked with a lower number *)
Sort0[_?IModQ[_]]:=2.5;
(* Component indices *)
Sort0[{_Integer,_}]:=4; (* BASIS1 *);
Sort0[_?BasisQ[_Integer]]:=4.1; (* BASIS2 *);
Sort0[_Integer]:=4.2;
(* Directions *)
Sort0[_Dir]:=5;
(* Patterns. PINDEX *)
Sort0[_Blank]:=6;
Sort0[_Pattern]:=7;
Sort0[_PatternTest]:=8;
(* Other? *)
Sort0[_]:=9;

The rest of priorities wil be selected by the user. They are defined using strings. There are three groups: 
	"up" / "down", 
	" free" / "dummy", 
	"positional" / "antipositional" / lexicographic" / "antilexicographic".
The user must choose one per group and set an order for those three chosen. In the past the last group (that with 4 options) could only be a third priority, but now I don't really see why. It is clear that if we choose one of them as a first priority then only up/down is relevant, but not free/dummy. This could make sorting of dummies difficult because it would all depend on their dollar numbers, but that doesn´t seem terrible. However, if we want to imitate Renato's ordering rule (of the kind {a, -a, b, -b, ...}, which is {"lexicographic", "up"}) then we need to allow the third group as first or second priority.

Set[validpriority[#],Null]&/@{"up","down","free","dummy","positional","antipositional","lexicographic","antilexicographic"};
validpriority[p_]:=Throw[Message[SetIndexSortPriorities::invalid,p,"priority for index sorting"]]

5.4.3. IndexSort and IndexSortPriorities

The public function IndexSort is the main index sorting function. It is defined by a different public function: SetIndexSortPriorities:

?SetIndexSortPriorities

?IndexSort

The three priorities are implemented using the functions

?Sort1

?Sort2

?Sort3

The main point we use for sorting is the fact that False is sorted before True.

These 8 functions implement the different priorities for index sorting. Comments:
	- IndexSort handles patterns and therefore we need to use
		- upQ instead of UpIndexQ and downQ instead of DownIndexQ.
		- Verbatim when searching DummySorted, which must be constructed keeping the patterns.
		- PatternToIndex when searching LexicSorted or $AbstractIndices.

(* Two variables which are blocked in IndexSort and hence can be used here *)
DummySorted;
LexicSorted;
(* Recall that False is sorted before True *)
SortPriority["up"]=Hold[downQ[#]&];
SortPriority["down"]=Hold[upQ[#]&];
SortPriority["free"]=Hold[MemberQ[DummySorted,Verbatim[#]]&];
SortPriority["dummy"]=Hold[FreeQ[DummySorted,Verbatim[#]]&];
SortPriority["lexicographic"]=Hold[Position[LexicSorted,UpIndex@PatternToIndex[#],{1}]&];
SortPriority["antilexicographic"]=Hold[Position[Reverse@LexicSorted,UpIndex@PatternToIndex[#],{1}]&];
SortPriority["positional"]=Hold[Position[$AbstractIndices,NoDollar@UpIndex@PatternToIndex@#,{1}]&];
SortPriority["antipositional"]=Hold[Position[Reverse@$AbstractIndices,NoDollar@UpIndex@PatternToIndex@#,{1}]&];

Specification of priorities:

SetIndexSortPriorities[p1_String,p2_String,p3_String]:=Module[{f},
validpriority/@{p1,p2,p3};
Sort1=SortPriority[p1];
Sort2=SortPriority[p2];
Sort3=SortPriority[p3];
IndexSort::usage=StringTake[IndexSort::usage,144]<>"first: "<>p1<>"; second: "<>p2<>"; third: "<>p3<>".";
]
SetIndexSortPriorities[x_/;Head[x]=!=String,_,_]:=Message[SetIndexSortPriorities::invalid,x,"string"]
SetIndexSortPriorities[_,x_/;Head[x]=!=String,_]:=Message[SetIndexSortPriorities::invalid,x,"string"]
SetIndexSortPriorities[_,_,x_/;Head[x]=!=String]:=Message[SetIndexSortPriorities::invalid,x,"string"]
SetNumberOfArguments[SetIndexSortPriorities,3];
Protect[SetIndexSortPriorities];

Main function:

??IndexSort

IndexSort[IndexList[]]:=IndexList[];
IndexSort[IndexList[ind_]]:=IndexList[ind];
IndexSort[list_List]:=IndexSort[Apply[IndexList,list]];
IndexSort[list_IndexList]:=Block[{DummySorted=TakeEIndices@TakeEPairs[list],LexicSorted=Union[UpIndex/@PatternToIndex/@list]},
Last/@Sort@ReleaseHold[({Sort0[#],Sort1[#],Sort2[#],Sort3[#],#}&)/@list]
];
SetNumberOfArguments[IndexSort,1];
Protect[IndexSort];

Comments:
	- IndexSort does not need Catch because there is no error detection.
	- IndexSort is rather complicated. Perhaps it is possible to define a simpler function which we take as default.
	- When $AbstractIndices is very long, index-sorting could be very slow
	- Is it possible to sort the numbers of dollar-indices in a proper way? Do we need it?

There is a problem indeed with the sorting of numbers in the dollar-indices when using the "positional" priority. We give examples below. It seems the use of "lexicographic" instead is safer.

5.4.5. Default sorting priorities

This is the default ordering for indices, which seems to be more efficient than others, and coincide with Renato's choice in having the pair "free/dummy" before "up/down":

SetIndexSortPriorities["free","lexicographic","up"];

5.5. IndexPosition

The problem with the function Position is that it finds -A when we are looking for just A. In the following we use an arbitrary head, which could be for example either List or IndexList.

BeginExamples[]

Position[head[A,B,C,-A,A,-A],A]

but using the function at level 1:

Position[head[A,B,C,-A,A,-A],A,{1}]

Vice versa, there is no problem:

Position[head[A,B,C,-A,A,-A],-A]

Position[head[A,B,C,-A,A,-A],-A,{1}]

Position[head[A,B,C,-A,A,-A],E]

Position[head[A,B,C,-A,A,-A],E,{1}]

Remove[A,B,head]
EndExamples[]

New function. It is only used by symperms and ToCanonicalOne. We add the Verbatim construct to manipulate patterns:

?IndexPosition

IndexPosition[list_,index_]:=Position[list,Verbatim[index],{1}]

Up / Down:

BeginExamples[]

xATP`IndexPosition[IndexList[A,-A],A]

xATP`IndexPosition[IndexList[A,-A],-A]

Other:

xATP`IndexPosition[IndexList[A,B,C,-A,A,-A_E,-A_?E,Dir[v[E]]],E]

xATP`IndexPosition[IndexList[A,-B,C,C_,-C_],C_]

xATP`IndexPosition[IndexList[A,-B,C,C_,-C_],-C_]

xATP`IndexPosition[IndexList[A,-B,C,Dir[v[A]],Dir[v[A]]],Dir[v[A]]]

xATP`IndexPosition[IndexList[A,-B,C,C_,-C_,_,-_,_],_]

Basis indices:

xATP`IndexPosition[IndexList[A,{A,Polar},{-A,-Polar},-A],A]

xATP`IndexPosition[IndexList[A,{A,Polar},{-A,-Polar},-A],{A,Polar}]

xATP`IndexPosition[IndexList[A,{A,Polar},{-A,-Polar},-A],{-A,-Polar}]

xATP`IndexPosition[IndexList[A,{A,Polar},{-A,-Polar},-A],-A]

Remove[A,B,Polar,v]
EndExamples[]

5.6. FindIndices

5.6.0. Comments

FindIndices finds all g-indices of a given expression, with two exceptions: 
	1) It does not find the g-indices of its subexpressions with free ultradummies because those are not needed in the main computations (directional indices and the vector arguments of Lie derivatives and Lie brackets).
	2) It does not find the g-indices of Scalar subexpressions or scalar functions.
FindIndices must be able to get those g-indices without evaluating the expression. For example, in a Module expression it must get the indices of the expression before allowing the indices to be replaced by unique variables.

This is one of the most important functions in xTensor, and it has already been coded up in different ways. Essentially we have these problems:
	- FindIndices checks that indices are not repeated in "Times" expressions, and
	- checks that free indices are homogeneous in "Plus" expressions, and
	- should check that there are not abstract indices, basis indices or pattern indices having the same name, though this is not finished.
 This takes some time, but it seems very important to me. The functions CheckRepeated and CheckHomogeneity could probably be more efficient.

5.6.1. CheckRepeated, CheckHomogeneity and CheckIndexType

1) CheckRepeated

First we define a function that checks whether there are repeated indices in a sequence of lists of indices, and then returns a single list with all indices. We need to define the concept of repeated indices: they are indices with the same name, what turns the problem into the definition of the name of an index. The answer is given by the function IndexName, which is very similar in structure to PatternToIndex. The main difference is that it gives name 0 to blocked indices and blanks, and gives name i to the basis index {i, basis}. This means that blocked indices can be repeated because CheckRepeated below checks for repeated names which are symbols, or -symbols. If blanks or patterns are present it really doesn't make sense to check much, given that they may stand for many different things. Definition for BlankSequence and BlankNullSequence added as suggested by Leo.

?IndexName

(* Names of indices. Sign is kept. Single-index of a Dim1 spaces should also be declared with name 0 *)
IndexName[-i_]:=-IndexName[i];
IndexName[i_Symbol]:=i;
(* Blocked indices and blanks get name 0 *)
IndexName[i:(_Dir|_LI|_Blank|_BlankSequence|_BlankNullSequence|_Integer)]:=0;
(* These cases should never happen. This is a safety feature *)
IndexName[i:(_String|_Rational|_Real|_Complex)]:=(Print["Found index ",i];0);
(* Basis indices and headed patterns. BASIS1 and BASIS2 & IMOD *)
IndexName[i_]:=IndexName[First[i]];

IndexName uses a lucky fact. In all cases: {i, basis}, imod[i], Pattern[i,*], PatternTest[i,*] what we need is simply computing the IndexName of the first element.

With that function we define CheckRepeated. Strategy:
0) The initial input is a sequence of lists of indices with head IndexList. With IndexList[AnyIndices] stop check
1) We join the lists and construct a list of pairs Index[index, IndexName[index]]
2) Check that no name is repeated. If there are repeated names throw an error
4) Give the list of indices, with the original order.

?CheckRepeated

Validate::repeated="Found indices with the same name `1`.";
(* Driver *)
CheckRepeated[]:=IndexList[];
CheckRepeated[IndexList[]..]:=IndexList[];
CheckRepeated[___,IndexList[AnyIndices],___]:=IndexList[AnyIndices];
CheckRepeated[lists__IndexList]:=CheckRepeated1[Index[#,IndexName[#]]&/@Join[lists]];
(* Give error or return original list *)
CheckRepeated1[list:IndexList[___Index,Index[_,i:(_Symbol|-_Symbol)],___Index,Index[_,i_],___Index]]:=Throw@Message[Validate::repeated,ToString[i]];
CheckRepeated1[list:IndexList[__Index]]:=First/@list;

A possible alternative form dealing with Dim1 spaces. Now deactivated.

(* Remove indices in Dim1 spaces. Give error or return original list. $Dim1Indices is of the form Alternatives[o,-o,O,-O]
If[$VersionNumber<6.0,Tally[list_List]:={First[#],Length[#]}&/@Split[Sort[list]]];
CheckRepeated1[list_IndexList]:=With[{check=DeleteCases[Tally[DeleteCases[Last/@List@@list,0|$Dim1Indices]],{_,1}]},
If[check=!={},
Throw@Message[Validate::repeated,First/@check],
First/@list
]
];
$Dim1Indices=Alternatives[];
*)

Examples:

BeginExamples[]

xATP`CheckRepeated[IndexList[],IndexList[]]

xATP`CheckRepeated[IndexList[AnyIndices],IndexList[]]

xATP`CheckRepeated[IndexList[a,b,_,c,{1,Polar},{1,Polar},Dir[v[a]]],IndexList[Dir[v[a]],d_,_],IndexList[AnyIndices]]

Catch@xATP`CheckRepeated[IndexList[-a,-a_]]

Catch@xATP`CheckRepeated[IndexList[_,a,b,c],IndexList[c]]

Catch@xATP`CheckRepeated[IndexList[_,a,b,c],IndexList[c_]]

Catch@xATP`CheckRepeated[IndexList[a,b,c_h?Q],IndexList[c_]]

xATP`CheckRepeated[IndexList[_,a,b,c],IndexList[_,d]]

xATP`CheckRepeated[IndexList[a,b,c,{1,Polar},d_,Polar[1]]]

xATP`CheckRepeated[IndexList[a,b,c,{1,Polar},{1,Polar},d_,{2,Polar},Polar[2]]]

xATP`CheckRepeated[IndexList[a,b,c,{1,Polar},Dir[v],{1,Polar},{2,Polar},Polar[2]]]

Note that there is no check of type. There is only check of name:

xATP`CheckRepeated[IndexList[-a,{a,Polar}]]

xATP`CheckRepeated[IndexList[a,-Polar[a]]]

Catch@xATP`CheckRepeated[IndexList[a,{a,Polar}]]

Catch@xATP`CheckRepeated[IndexList[a,Polar[a]]]

Catch@xATP`CheckRepeated[IndexList[{a,Polar},Polar[a]]]

It is not possible to have two basis indices with the same name:

Catch@xATP`CheckRepeated[IndexList[{a,Cartesian},{a,Polar}]]

The function is not very efficient for low numbers of indices:

Trace[xATP`CheckRepeated[IndexList[a,b]]]

Remove[a,b,c,d,h,Polar,Cartesian,Q,v]

EndExamples[]

2) CheckHomogeneity

We define CheckHomogeneity as follows. Again, inhomogeneous sets of indices are those sets of different names of indices. In other words, a and a_ are indices with the same name, and therefore they do not count as different indices. This is useful when considering rules, where a_ can be present on the LHS, but not in the RHS, where we will find a, instead.

?CheckHomogeneity

General::inhom="Found inhomogeneous `1`: `2`.";
checkLengthOne[{x_}]:=True;
checkLengthOne[x:{_,__}]:=Throw@Message[Validate::inhom,"indices",ToString[x]];
CheckHomogeneity[x___,IndexList[AnyIndices],y___]:=CheckHomogeneity[x,y];
CheckHomogeneity[]:=IndexList[];
CheckHomogeneity[IndexList[]..]:=IndexList[];
CheckHomogeneity[lists__IndexList]:=If[
checkLengthOne@Union@Map[TakeFrees,Map[DeleteCases[#,0]&,Map[IndexName,{lists},{2}]]],
DeleteDuplicates[Join[lists]]
];

There is a very important point here: the concept of "g-indices of a sum of expressions". Currently we return the (unsorted) union of all indices and therefore all repeated g-indices (components, directions, labels and blanks) appear just once. Compare the use of Join in CheckRepeated with the use of DeleteDuplicates in CheckHomogeneity.

We return all indices, both patterns and not patterns:

BeginExamples[]

xATP`CheckHomogeneity[IndexList[a_,-b_,c,Dir[v],{1,-Polar}],IndexList[a,-b,c,{1,Polar}],IndexList[AnyIndices]]

Catch@xATP`CheckHomogeneity[IndexList[a_,-b_,c],IndexList[a,-b,c],IndexList[a,-b,d],IndexList[AnyIndices]]

Trivial case:

xATP`CheckHomogeneity[IndexList[],IndexList[],IndexList[]]//Trace

Remove[a,b,c,d,v,Polar]

EndExamples[]

3) CheckIndexType

And now we define a function that checks the types of indices. We need to worry about: Index/Basis, Index/Pattern and different bases. It is defined, but we currently do not use it. In fact, we do not include it in the package.

?IndexType

(* Type of indices. PINDEX *)
IndexType[-i_]:=IndexType[i];
IndexType[_Symbol]:="Index";
IndexType[_Blank|_Pattern|_PatternTest]:="Pattern";
IndexType[_Integer]:="Integer";
IndexType[{i_,basis_}]:="Basis"<>IndexType[i]<>"_"<>ToString[UpIndex@basis]; (* BASIS1 *);
IndexType[basis_Symbol?BasisQ[i_]]:="Basis"<>IndexType[i]<>"_"<>ToString[basis]; (* BASIS2 *);
IndexType[imod_?IModQ[i_]]:="IMod"<>IndexType[i]<>"_"<>ToString[imod]; (* IMOD *);
IndexType[_]:="Other";

?CheckIndexType

Validate::type="Found index named `1` with incompatible types `2` and `3`.";
check2[{___,{x_,type1_},{x_,type2_},___}]:=Throw@Message[Validate::type,x,type1,type2]
CheckIndexType[IndexList[]]:=IndexList[]
CheckIndexType[list_IndexList]:=(check2@Union[Cases[{IndexName[#],IndexType[#]}&/@UpIndex/@list,{_Symbol,_}]];list)

BeginExamples[]

xATP`CheckIndexType[IndexList[a_,{b_,Polar},{1,Polar}]]

Catch@xATP`CheckIndexType[IndexList[a_,-a,{1,Polar},{1,-Polar},_,{_,Polar}]]

Catch@xATP`CheckIndexType[IndexList[a,-a,{a,Polar},{-a,-Polar},{1,Polar},{1,-Polar},_]]

Catch@xATP`CheckIndexType[IndexList[{a_,Polar},{-a,-Polar},{1,Polar},{1,-Polar},_,{_,Polar}]]

Catch@xATP`CheckIndexType[IndexList[{a,Polar},{-a,-Cartesian},{1,Polar},{1,-Polar},_,{_,Polar}]]

Remove[a,b,Cartesian,Polar]
EndExamples[]

5.6.2. FindIndices

Basic function. Comments:
	1. We do not check that the indices have been already registered in $AbstractIndices; they are just at the expected positions and have one of  the expected types for a g-index.
	2. The function is threaded over known heads (Plus, Times, Module, Rule, RuleDelayed, inertheads, etc.). It throws an error in other cases.
	3. FindIndices always returns a (possibly empty) list of g-indices.

In version 0.7 this function was private, but now it is public. Therefore we separate the user driver (one argument) from the internal function FindIndices1 (two arguments).

?FindIndices

SetAttributes[FindIndices,HoldFirst];
SetAttributes[FindIndices1,HoldFirst];

Atomic objects (note that this rule includes the constant-symbols and parameters):

FindIndices[0]:=IndexList[AnyIndices];
FindIndices[_Symbol|_String|_Integer|_Rational|_Real|_Complex]:=IndexList[];

Simple case:

FindIndices[_[]]:=IndexList[];

Homogeneity types. There are four possibilities: Times (indices cannot be repeated), Plus (homogeneous free indices), None (no relation at all) or an integer number (ignore all indices but those of element n):

FindIndices[expr_Times]:=FindIndices1[expr,Times];
(* These two should not be needed, but they can correct evaluation leaks in canonicalization *)
FindIndices[expr:VerbatimProduct[_][___]]:=FindIndices1[expr,Times];
FindIndices[expr:CommutingObjects[_][___]]:=FindIndices1[expr,Times];

Note that the LHS of rules (both Rule and RuleDelayed) is evaluated, but here we do not do it. It saves some time.

FindIndices[expr_Plus]:=FindIndices1[expr,Plus];
FindIndices[expr_List]:=FindIndices1[expr,Plus];
FindIndices[expr_Equal]:=FindIndices1[expr,Plus];
FindIndices[Rule[lhs_,rhs_]]:=FindIndices1[Rule[lhs,Evaluate[rhs]],Plus];
FindIndices[RuleDelayed[lhs_,rhs_]]:=FindIndices1[RuleDelayed[lhs,rhs],Plus];
FindIndices[HoldPattern[Set[lhs_,rhs_]]]:=FindIndices1[Set[lhs,rhs],Plus];
FindIndices[HoldPattern[SetDelayed[lhs_,rhs_]]]:=FindIndices1[SetDelayed[lhs,rhs],Plus];

FindIndices[expr_Module]:=FindIndices1[expr,2];
FindIndices[expr_Monomial]:=FindIndices1[expr,1];
FindIndices[expr_Condition]:=FindIndices1[expr,1];

Series must have scalar origin and variable, but the coefficients can be tensors, all with the same indices as in a sum. A lonely O[x]^n term is not assumed to be a scalar, but returns AnyIndices.

FindIndices[HoldPattern[SeriesData[_,_,{RepeatedNull[0]},__]]]:=IndexList[AnyIndices];
FindIndices[expr_SeriesData]:=FindIndices1[expr,3];

Here we define the actions on those four cases

FindIndices1[expr:_[elements__],Times]:=CheckRepeated@@(FindIndices/@Hold[elements]);
FindIndices1[expr:_[elements__],Plus]:=CheckHomogeneity@@(FindIndices/@Hold[elements]);
FindIndices1[expr:_[elements__],None]:=Join@@(FindIndices/@Hold[elements]);
FindIndices1[expr_,n_Integer]:=FindIndices@@Extract[Unevaluated[expr],n,xHold];

Note that in the last definition the head xHold is eliminated (actually replaced) by FindIndices.

Complex conjugation (in case some expression is not evaluated). This is a dangerous definition because, even though it is perfectly correct from the mathematical point of view, it is not true from the syntactic point of view: the returned indices are not really present in the expression. Note that it is an exception with respect to the behaviour of other inert heads. We will find the same problem below with IsIndexOf.

FindIndices[Dagger[expr_]]:=DaggerIndex/@FindIndices[expr];

Basic objects:

CovDIndices[_?CovDQ[inds__]]:=Sequence[inds];
CovDIndices[x_]:=Throw@Message[FindIndices::invalid,x,"derivative"];

(* Basic objects *)
FindIndices[_?xTensorQ[inds___]]:=CheckRepeated[IndexList[inds]];
FindIndices[_?CovDQ[inds__][expr_]]:=CheckRepeated[FindIndices[expr],IndexList[inds]];
FindIndices[CovD[expr_,ders__]]:=CheckRepeated[FindIndices[expr],CovDIndices/@IndexList[ders]];
FindIndices[ParamD[__][expr_]]:=FindIndices[expr];
FindIndices[OverDot[expr_]]:=FindIndices[expr];
FindIndices[LieD[_][expr_]]:=FindIndices[expr];
FindIndices[_?InertHeadQ[expr_,z___]]:=DeleteDuplicates[Join@@Join[{FindIndices[expr]},Cases[{z},_IndexList]]];
FindIndices[expr:_?ProductQ[___]]:=FindIndices1[expr,Times];
(* Scalar shields indices! *)
FindIndices[_Scalar]:=IndexList[];
FindIndices[_?ScalarFunctionQ[___]]:=IndexList[];
FindIndices[Derivative[__Integer][_?ScalarFunctionQ][__]]:=IndexList[];

Indices of patterned objects (currently only tensors and connections):

FindIndices[pattern_PatternTest[inds___]]:=CheckRepeated[IndexList[inds]]/;Last[pattern]===xTensorQ;
FindIndices[pattern_PatternTest[inds__][expr_]]:=CheckRepeated[FindIndices[expr],IndexList[inds]]/;Last[pattern]===CovDQ;

There are additional heads that typically form part of the input:

FindIndices[expr:(_HoldPattern|_ReplaceDummies)]:=FindIndices1[expr,1];

(* Again, this should not be needed, but it may fix evaluation leaks *)
FindIndices[Object[_,_,{allinds_,__}]]:=allinds;

Detection of other heads. The global variable $FindIndicesAcceptedHeads is public, but not protected.

$FindIndicesAcceptedHeads={Hold,HoldForm};
FindIndices[expr:head_[__]]:=If[MemberQ[$FindIndicesAcceptedHeads,head],FindIndices1[expr,None],IndexList[]];

Final definitions:

SetNumberOfArguments[FindIndices,1];
Protect[FindIndices];

This function could be generalized in many ways, but I prefer it to be as simple as possible.

5.6.3. FindFreeIndices, FindDummyIndices, FindBlockedIndices

Three simple extensions of FindIndices:

1) FindFreeIndices:

?FindFreeIndices

SetAttributes[FindFreeIndices,HoldFirst];
FindFreeIndices[expr_,selector_]:=SelectIndices[FindFreeIndices[expr],selector];
FindFreeIndices[expr_]:=TakeFrees@FindIndices[expr];
SetNumberOfArguments[FindFreeIndices,{1,2}];
Protect[FindFreeIndices];

2) FindDummyIndices. We assume that we already now that there are no repeated or inhomogeneous indices. Therefore both members of each pair of dummies must be on the same object:

?FindDummyIndices

SetAttributes[FindDummyIndices,HoldFirst];
FindDummyIndices[expr_,selector_]:=SelectIndices[FindDummyIndices[expr],selector];
FindDummyIndices[expr_]:=TakeUp@TakeOrderedEPairs@FindIndices[expr];
SetNumberOfArguments[FindDummyIndices,{1,2}];
Protect[FindDummyIndices];

3) FindBlockedIndices

?FindBlockedIndices

SetAttributes[FindBlockedIndices,HoldFirst];
FindBlockedIndices[expr_,selector_]:=SelectIndices[FindBlockedIndices[expr],selector];
FindBlockedIndices[expr_]:=TakeBlocked@FindIndices[expr];
SetNumberOfArguments[FindBlockedIndices,{1,2}];
Protect[FindBlockedIndices];

4) FindFreeAndDummyIndices. We assume that we already now that there are no repeated or inhomogeneous indices. Therefore both members of each pair of dummies must be on the same object.

?FindFreeAndDummyIndices

SetAttributes[FindFreeAndDummyIndices,HoldFirst];
FindFreeAndDummyIndices[expr_]:={TakeFrees[#],TakeUp@TakeOrderedEPairs[#]}&@FindIndices[expr];

5.6.4. IsIndexOf

This function is mostly used to find out when contraction of delta, Basis, metric or projector tensors must be done. There is a third argument which specifies the tensor that we are actually trying to contract, to be checked with ContractThroughQ against inert-heads (perhaps against other structures in the future). QUESTION: The contraction through derivatives works in a different way. Is it possible to use the same ideas to treat both cases?

Currently IsIndexOf is used by:
	- delta contraction
	- metric contraction
	- projector contraction
	- MakeOrthogonalDerivative
	- MakeProjectedDerivative
	- ObjectWithIndices

Note the definition on scalar functions: the indices (dummies) of the tensors in a scalar function are shielded.

It is not clear if the definition on Dagger expressions is fully general. QUESTION.

?IsIndexOf

SetAttributes[IsIndexOf,HoldFirst];
(* In general we are not trying to contract anything: use delta *)
IsIndexOf[expr_,index_]:=IsIndexOf[expr,index,delta];
(* Compound expressions. Or in Times (any index), And in Plus (only free indices ensured) *)
IsIndexOf[expr:(_Times|CommutingObjects[_][___]|VerbatimProduct[_][___]|_?ProductQ[___]),index_,f_]:=Or@@(IsIndexOf[#,index,f]&/@Hold@@Unevaluated[expr]);
IsIndexOf[{},index_,f_]:=False;
IsIndexOf[expr:(_Plus|_List),index_,f_]:=And@@(IsIndexOf[#,index,f]&/@Hold@@Unevaluated[expr]);
IsIndexOf[HoldPattern[SeriesData[_,_,coeffs_,__]],index_,f_]:=IsIndexOf[coeffs,index,f];
(* Dagger: temptative definition *)
IsIndexOf[Dagger[expr_],index_,f_]:=IsIndexOf[expr,DaggerIndex[index],f];
(* Tensors *)
IsIndexOf[_?xTensorQ[inds___],index_,f_]:=MemberQ[IndexList[inds],index];
(* Inert heads *)
IsIndexOf[list_IndexList,index_,f_]:=MemberQ[list,index];
IsIndexOf[list:{___IndexList},index_,f_]:=Or@@(IsIndexOf[#,index,f]&/@list);
IsIndexOf[head_?InertHeadQ[expr_,z___],index_,f_]:=If[ContractThroughQ[head,f],IsIndexOf[expr,index,f]||With[{cases=Cases[{z},_IndexList]},IsIndexOf[cases,index,f]],False];
(* Derivatives: no check of compatibility of derivative and tensor f *)
IsIndexOf[_?CovDQ[inds__][expr_],index_,f_]:=MemberQ[IndexList[inds],index]||IsIndexOf[expr,index,f];
IsIndexOf[CovD[expr_,ders__],index_,f_]:=MemberQ[CovDIndices/@IndexList[ders],index]||IsIndexOf[expr,index,f];
IsIndexOf[ParamD[__][expr_],index_,f_]:=IsIndexOf[expr,index,f];
IsIndexOf[OverDot[expr_],index_,f_]:=IsIndexOf[expr,index,f];
IsIndexOf[LieD[_][expr_],index_,f_]:=IsIndexOf[expr,index,f];
(* Scalar structures: shield *)
IsIndexOf[_?ScalarFunctionQ[args__],index_,f_]:=False;
IsIndexOf[Derivative[__Integer][_?ScalarFunctionQ][args__],index_,f_]:=False;
IsIndexOf[_Scalar,index_,f_]:=False;
(* Atoms *)
IsIndexOf[_Symbol,index_,f_]:=False;
IsIndexOf[_Integer|_Rational|_Real|_Complex,index_,f_]:=False;
IsIndexOf[_String,index_,f_]:=False;
(* Other *)
IsIndexOf[expr_,index_,f_]:=Throw[Message[IsIndexOf::nouse,IsIndexOf,expr];ERROR[expr]];
SetNumberOfArguments[IsIndexOf,{2,3}];
Protect[IsIndexOf];

5.6.5. Examples

Examples:

BeginExamples[]

FindIndices[1]

FindIndices[Module[{},1]]

xTensorQ[T]^=True;
xTensorQ[v]^=True;

T[a_,-a_,b_]:=v[b]

T[a,-a,b]

FindIndices[T[a,-a,b]]

FindIndices[0]

FindIndices[Module[{a,b,c},T[a,b_,c,{d,Polar},Dir[v[a]]]v[-c]]]

Complaint on the type of indices:

Catch@FindIndices[T[_,a_,b__,c___,a_/;Q,#,##]]

Homogeneity is always checked:

Catch@FindIndices[T[a_,_]+v[_]]

FindIndices[T[_,#]+v[#,_]]

DefInertHead[test]

test[T[b,a,c,-d],IndexList[e],IndexList[c,b,d]]

FindIndices[Evaluate[%]]

UndefInertHead[test]

T[a,b]x+T[a,b]x^2+O[x]^3

FindIndices[Evaluate[%]]

O[x]^3

FindIndices[Evaluate[%]]

Remove[a,b,c,d,e,Polar,Q,T,v]

More examples:

xTensorQ[T]^=True;
xTensorQ[r]^=True;
CovDQ[Cd]^=True;
CovDQ[CD]^=True;

Patterns and basis indices are correctly found:

FindIndices[CD[-c][Cd[-a][T[a,b]]T[-b]]+Cd[-c][T[a_,-a_]]]

Note that type checking is still not implemented:

FindIndices[CD[{-c,Polar}][Cd[{-a,Polar}][T[a,b]]T[-b]]+Cd[-c][T[a_,-a_]]]

The index of the vector field of the Lie derivative is not found:

FindIndices[LieD[T[D]][T[A,B,C]]]

Here we have problems with scalars and ScalarFunctions:

FindIndices[T[A]/(T[B]T[-B]+r[])+T[A]]

FindIndices[T[A]/(T[B]T[-B])+T[A]]

Rules and Modules:

FindIndices[T[A]->T[A]]

FindIndices[T[A]:>T[A]]

FindIndices[T[A]:>0]

FindIndices[Module[{A,B},T[A,B,-B]]]

FindFreeIndices[T[A]:>Module[{B},T[A,B,-B]]]

FindDummyIndices[T[A]:>Module[{B},T[A,B,-B]]]

Other heads:

FindIndices[h[T[A],r[B]+T[C]]]

FindIndices[Set[T[A_],r[A,B,-B]]]

FindIndices[Hold[Set[T[A_],r[A,B,-B]]]]

FindIndices[Hold[Hold[Set[T[A_],r[A,B,-B]]]]]

The constant B is not interpreted as an index:

FindIndices[r[]^2+B+1+T[A]Cd[-A][r[]]]

Internal structures:

FindIndices[1+r[]^2+LieD[T[B]][r[]+1+T[A]Cd[-A][r[]]]]

CovDs:

FindAllOfType[1+CD[-A][r[]]+LieD[T[A]][r[]+1+T[A]CD[-B][Cd[-A][r[]]]],CovD]

Dummy pairs are represented by the up-index member:

FindDummyIndices[r[]^2+A+1+T[A]Cd[-A][r[]]]

FindDummyIndices[r[]^2+A+1+T[{A,Polar}]Cd[{-A,-Polar}][r[]]]

%//InputForm

FindDummyIndices[r[]^2+A+1+T[Polar@A]Cd[-Polar@A][r[]]]

%//InputForm

Other examples:

FindIndices[T[A$1]Cd[B][ T[C]]Cd[-B][ T[-C,-A$1]]CD[D][Cd[-D][T[-F]]]]

FindFreeIndices[Cd[-A][T[B,-B]]+T[-A]+LieD[T[A]][T[-A]]]

FindFreeIndices[LieD[T[A]][T[-A]+r[-A]]]

Catch@FindFreeIndices[Cd[-A][T[B,-B]]+T[-A]+LieD[T[A]][T[-C]]]

Catch@FindFreeIndices[Cd[-A][T[B,-B]]+T[-A]+LieD[T[A]][T[-A]T[-B]]]

Catch@FindIndices[Cd[-A][T[-B,-B,-A]]+T[-A]+T[-C]]

FindDummyIndices[T[A$1,-a] Cd[B][T[C]]Cd[-B][T[-C,-A$1,a]]Cd[D][Cd[-D][T[-F]]]+T[A$1,-a] Cd[B][T[C]] Cd[-B][T[-C,-A$1,a]]Cd[G][Cd[-G][T[-F]]]]

IsIndexOf:

IsIndexOf[T[A,-B],A]

IsIndexOf[T[A,-B],-A]

IsIndexOf[T[A,-B],B]

IsIndexOf[T[A,-B],-B]

IsIndexOf[T[A,-B]T[B,-C],-C]

IsIndexOf[T[A,-A]+T[B,-B],A]

IsIndexOf[T[A,B,-B]+T[A,C,-B],A]

IsIndexOf[(T[A,B]T[-A,-B])^2,A]

IsIndexOf[T[{A,Polar},B],{A,Polar}]

Patterns don't work. They always give True. PINDEX

Series:

IsIndexOf[T[B],A_]

T[A,B]x+T[A,B]x^2+O[x]^3

IsIndexOf[Evaluate[%],B]

T[A,B]x+T[A,C]x^2+O[x]^3

IsIndexOf[Evaluate[%],B]

Blocked indices:

expr=T[LI[1],A,-A,{B,Polar},{-B,-Polar},{1,Polar},{1,-Polar},Dir[T[Z]],Dir[T[-Z]],C_,_,-_,D_?Q,F_,-F_];

FindIndices[Evaluate@expr]

FindFreeIndices[Evaluate@expr]

FindDummyIndices[Evaluate@expr]

FindBlockedIndices[Evaluate@expr]

Complement[%%%%,%%,ChangeIndex/@%%,%,%%%]

The conclusion is that all patterns qualify either as free or dummy indices. That is strange. In particular I think considering Blank[] and -Blank[] a dummy pair could be an error. QUESTION.

Remove[a,A,A$1,b,B,c,Cd,CD,F,G,h,Polar,r,T,Q,Z,expr]
EndExamples[]

5.6.6. UltraindexOf

UltraindexOf returns the (abstract) free index of a directional argument, or None for pattern expressions. It is not possible to have a pattern index instead of the ultraindex. It is a private function.

(* We need several stupid special cases to avoid messages from the Information commands from covds. This is ugly *)
UltraindexOf[_Pattern _.]:=None;
UltraindexOf[x_Pattern+y_Pattern]:=None;
UltraindexOf[x_Symbol]:=None;
UltraindexOf[x_Slot]:=None;
UltraindexOf[0]:=None;
(* Main function. Recall that it returns the free ultraindex *)
UltraindexOf[Dir[expr_]]:=UltraindexOf[expr];
UltraindexOf[expr_]:=checkultraindex[FindFreeIndices[expr],expr];
(* Internal function. It returns the ultraindex or an error *)
checkultraindex[IndexList[i_],_]:=i;
checkultraindex[_,expr_]:=Throw@Message[Validate::error,"Invalid or no ultraindex."];

UltraindexOf[Dir[expr]]

UltraindexOf[Dir[expr_]]

5.6.7. IndicesOf

The function SelectIndices is in charge of extracting the appropriate indices from a list. Not prepared to handle patterns.

(* Trivial case *)
SelectIndices[expr_,IndexList[],selectors_]:=IndexList[];
(* Threading as Or *)
SelectIndices[expr_,list_IndexList,selectors_List]:=Apply[Join,Map[SelectIndices[expr,list,#]&,selectors]];
(* Not *)
SelectIndices[expr_,list_IndexList,Not[selector_]]:=Complement[list,SelectIndices[expr,list,selector]];
(* Select according to states *)
SelectIndices[expr_,list_IndexList,Free]:=TakeFrees[list];
SelectIndices[expr_,list_IndexList,Dummy]:=TakeEPairs[list];
SelectIndices[expr_,list_IndexList,Blocked]:=Select[list,BlockedQ];
(* Select according to character *)
SelectIndices[expr_,list_IndexList,xAct`xTensor`Up]:=Select[list,UpIndexQ];
SelectIndices[expr_,list_IndexList,xAct`xTensor`Down]:=Select[list,DownIndexQ];
(* Select according to type *)
SelectIndices[expr_,list_IndexList,AIndex]:=Select[list,AIndexQ];
SelectIndices[expr_,list_IndexList,BIndex]:=Select[list,BIndexQ];
SelectIndices[expr_,list_IndexList,CIndex]:=Select[list,CIndexQ];
SelectIndices[expr_,list_IndexList,DIndex]:=Select[list,DIndexQ];
SelectIndices[expr_,list_IndexList,LIndex]:=Select[list,LIndexQ];
(* Select according to associations. BASIS1 and BASIS2 *)
SelectIndices[expr_,list_IndexList,vbundle_?VBundleQ]:=Select[list,IndexOnQ[#,vbundle]&];
SelectIndices[expr_,list_IndexList,basis_Symbol?BasisQ]:=IndexList@@Cases[list,{_,basis|-basis}|basis[_]|-basis[_]];
SelectIndices[expr_,list_IndexList,Basis[basis_]]:=Intersection[list,Flatten[IndexList@@Cases[expr,Basis[index1___,index2:({_,basis|-basis}|basis[_]|-basis[_]),index3___]->IndexList[index1,index2,index3],{0,Infinity}],Infinity,IndexList]];
SelectIndices[expr_,list_IndexList,tensor_?xTensorQ]:=Intersection[list,Flatten[IndexList@@Cases[expr,tensor[inds__]->IndexList[inds],{0,Infinity}],Infinity,IndexList]];
SelectIndices[expr_,list_IndexList,covd_?CovDQ]:=Intersection[list,Join[Flatten[IndexList@@Cases[expr,HoldPattern[covd[inds__][_]]->IndexList[inds],{0,Infinity}],Infinity,IndexList],Flatten[IndexList@@Cases[expr,HoldPattern[CovD[_,ders__]]:>(CovDIndices/@IndexList[ders]),{0,Infinity}],Infinity,IndexList]]];
(* Other cases: error *)
SelectIndices[expr_,list_IndexList,x_]:=Throw@Message[IndicesOf::invalid,x,"index selector"];

This function is the user driver for finding indices:

IndicesOf[][expr_]:=FindIndices[expr];
IndicesOf[selectors___,selector1_][expr_]:=SelectIndices[expr,IndicesOf[selectors][expr],selector1];
Protect[IndicesOf];

5.6.8. Parsing: IndexExpr

Here we introduce a command which rewrites an expression adding the head IndexExpr, which gives information on the free and dummy indices inside its first argument. This function uses TakeFrees and TakeEPairs, but it is completely independent of FindIndices or IsIndexOf, and hence can be considered as a third independent implementation of the process of finding indices. The function ToIndexExpr introduces this head and has certain similarities with the more powerful function Identify used below for canonicalization. Both IndexExpr and ToIndexExpr hold their first argument, to fully block the process of evaluation during that rewriting of an expression:

SetAttributes[{ToIndexExpr,IndexExpr},HoldFirst];

We add a second argument in ToIndexExpr to perform some action on the resulting IndexExpr expression. This will be later used for example to trace dummies. It is very important to note that this function acts on the whole expression with head IndexExpr, in order to access the free-dummy indices information. It must return again an IndexExpr expression because the recursive structure of ToIndexExpr works from the deepest level to 0: the information at level n+1 is used (by freesof) to compute level n.

The function ToIndexExpr acts differently on different types of expressions. Only three cases are nontrivial, those in which free indices can become dummy indices: traces in tensors, traces in tensor products and divergences. Note that in composite expressions we always return a nested IndexExpr structure, except for Plus. This nesting serves no purpose at this moment because IndexExpr is not instructed to do anything on IndexExpr subexpressions. Only freesof is using that information, to avoid recomputing free indices of subexpressions.

(* One argument: default function: Identity *)
ToIndexExpr[expr_]:=ToIndexExpr[expr,Identity];
(* Tensors *)
ToIndexExpr[Bracket[v1_,v2_][inds__],function_]:=With[{iv1=ToIndexExpr[v1,function],iv2=ToIndexExpr[v2,function]},function@IndexExpr[Bracket[iv1,iv2][inds],IndexList[inds],IndexList[]]];
ToIndexExpr[expr:_?xTensorQ[inds___],function_]:=function@IndexExpr[expr,TakeFrees[IndexList[inds]],TakeEPairs[IndexList[inds]]];
(* Tensor products, including Times. Note: iexpr is a List of IndexExpr's *)
ToIndexExpr[HoldPattern[Times[factors__]],function_]:=With[{iexpr=ToIndexExpr[#,function]&/@Unevaluated[{factors}]},With[{all=Apply[Join,freesof/@iexpr]},With[{dummies=TakeEPairs[all]},
function@ReplacePart[IndexExpr[iexpr,Complement[all,dummies],dummies],Times,{1,0}] ]]];
ToIndexExpr[HoldPattern[prod_?ProductQ[factors__]],function_]:=With[{iexpr=ToIndexExpr[#,function]&/@Unevaluated[{factors}]},With[{all=Apply[Join,freesof/@iexpr]},With[{dummies=TakeEPairs[all]},
function@ReplacePart[IndexExpr[iexpr,Complement[all,dummies],dummies],prod,{1,0}] ]]];
(* Covariant derivatives *)
ToIndexExpr[expr:covd_?CovDQ[inds__][expr1_],function_]:=With[{iexpr1=ToIndexExpr[expr1,function]},
With[{all=Join[freesof[iexpr1],IndexList[inds]]},
With[{dummies=TakeEPairs[all]},
function@IndexExpr[covd[inds][iexpr1],Complement[all,dummies],dummies] ]]];
ToIndexExpr[expr:CovD[expr1_,ders__],function_]:=With[{iexpr1=ToIndexExpr[expr1,function]},
With[{all=Join[freesof[iexpr1],CovDIndices/@IndexList[ders]]},
With[{dummies=TakeEPairs[all]},
function@IndexExpr[CovD[iexpr1,ders],Complement[all,dummies],dummies] ]]];
(* Thread over sums. No nesting of IndexExpr *)
ToIndexExpr[expr_Plus,function_]:=ToIndexExpr[#,function]&/@Unevaluated[expr];
(* Series. Keep structure *)
ToIndexExpr[HoldPattern[SeriesData[var_,orig_,coeffs_,rest__]],function_]:=SeriesData[ToIndexExpr[var,function],ToIndexExpr[orig,function],ToIndexExpr[#,function]&/@Unevaluated[coeffs],rest];
(* Other cases: no new dummies *)
ToIndexExpr[LieD[v_][expr_],function_]:=With[{iv=ToIndexExpr[v,function],iexpr=ToIndexExpr[expr,function]},function@IndexExpr[LieD[iv][iexpr],freesof[iexpr],IndexList[]]];
ToIndexExpr[OverDot[expr_],function_]:=With[{iexpr=ToIndexExpr[expr,function]},function@IndexExpr[OverDot[iexpr],freesof[iexpr],IndexList[]]];
ToIndexExpr[ParamD[ps__][expr_],function_]:=With[{iexpr=ToIndexExpr[expr,function]},function@IndexExpr[ParamD[ps][iexpr],freesof[iexpr],IndexList[]]];
ToIndexExpr[symbol_Symbol,function_]:=function@IndexExpr[symbol,IndexList[],IndexList[]];
ToIndexExpr[constant_?ConstantQ,function_]:=function@IndexExpr[constant,IndexList[],IndexList[]];
ToIndexExpr[ih_?InertHeadQ[expr_,z___],function_]:=With[{iexpr=ToIndexExpr[expr,function]},function@IndexExpr[ih[iexpr,z],freesof[iexpr],IndexList[]]];
ToIndexExpr[sf_Symbol?ScalarFunctionQ[expr_],function_]:=With[{iexpr=ToIndexExpr[expr,function]},function@IndexExpr[sf[iexpr],IndexList[],IndexList[]]];
ToIndexExpr[sf_Symbol?ScalarFunctionQ[expr1_,expr2_],function_]:=With[{iexpr1=ToIndexExpr[expr1,function],iexpr2=ToIndexExpr[expr2,function]},function@IndexExpr[sf[iexpr1,iexpr2],IndexList[],IndexList[]]];
(* Other heads *)
ToIndexExpr[head_[expr_],function_]:=If[MemberQ[$FindIndicesAcceptedHeads,head],ReplacePart[head[expr],ToIndexExpr[expr,function],{1}],head[expr]];
(* General definition: do nothing *)
ToIndexExpr[expr_,function_]:=function@IndexExpr[expr,IndexList[],IndexList[]];

Final details:

SetNumberOfArguments[ToIndexExpr,{1,2}];
SetNumberOfArguments[IndexExpr,3];
Protect[ToIndexExpr,IndexExpr];

We need this small function to extract the free indices from previously computed IndexExpr constructs:

freesof[expr_Plus]:=freesof[First[expr]];
freesof[expr_SeriesData]:=freesof[Normal[expr]];
freesof[IndexExpr[_,frees_,_]]:=frees;
freesof[expr_]:=IndexList[];

There is the question of how to deconstruct the IndexExpr structure. The only point is the HoldFirst attribute. We do it using FromIndexExpr (this function does not need HoldFirst because we assume that its first argument is always an IndexExpr expression). The second argument can be used to introduce a holding head which keeps preventing evaluation. The xHold additional wrapper has been added (Sept 2011) after discussing with Stephen Green and Leo Stein, to avoid an unfortunate interaction between dummy tracing and delta contraction:

FromIndexExpr[iexpr_,wrap_:Identity]:=Identity@@(xHold[wrap[iexpr]]//.IndexExpr[expr_,_,_]:>expr);

5.7. ReplaceIndex

5.7.1. ReplaceOneIndex, ReplaceIndexList

This function changes indices according to some rules. There is no reference to the objects having indices. Comments:
	0) There is no restriction on the RHS of the index rules. That is, we can replace an index by anything we want.
	1) We can change the up/down character of an index with a rule like a -> -b.
	2) The rule a->b does not change -a to -b. A separate rule is needed.
	3) Patterns can be replaced, but we send a `Contact JMM´ message. Use only up->up or down->down rules. This is not checked.
	4) Component indices, blanks, labels and directions were left untouched in version 0.7. Now since 0.8 they can be changed as well.
	5) As usual with functions acting on indices, there is no restriction on evaluation.
	6) Basis indices can be changed as a whole. This is also new in 0.8. If a basis index cannot be changed as a whole, then we try to change only its name using the rules for abstract indices (this was the only behaviour in 0.7). The 0.7 rules were safe but too strict for functions like PermuteIndices.
	7) In version 1.0 we add the general concept of IndexModifier, following basis-indices. We first try to change the whole index, and if it does not work then we try to change its "name", always the first argument of the index-modifier.

?ReplaceOneIndex

Patterns can be changed. For instance there can be patterns in dollar-indices, and so ScreenDollarIndices will change them:

replacepattern[i_,rules_,sign_]:=ReplacePart[i,sign ReplaceOneIndex[sign First[i],rules],1];

To avoid Mathematica complaining about having patterns on the RHS we deactivate the message

Off[Rule::rhs]

Correct replacements. The key idea is the use of Replace (and not ReplaceAll), which only tries to replace the whole expression. This is because we can never deconstruct the indices; in particular we must always keep track of their character. Replace scans lists of rules sequentially until it finds the first rule applying. We need special care with basis indices because in version 0.7 only its name was replaced, and now we want to try first the change of the whole index. That forces us to replace basis indices in two steps (this is implemented through the function ReplaceBasisIndex): if the whole index is changed then do not try to change its name; if the whole index is not changed, then try to change its name. This is one of the most critical functions in xTensor and hence we need to throw an error in case something is not clear:

(* Symbols *)
ReplaceOneIndex[i:(_Symbol|-_Symbol),rules_]:=Replace[i,rules];
(* Directions *)
ReplaceOneIndex[i_Dir,rules_]:=Replace[i,rules];
(* Labels *)
ReplaceOneIndex[i:(_LI|-_LI),rules_]:=Replace[i,rules];
(* Components *)
ReplaceOneIndex[i:{_Integer,_},rules_]:=Replace[i,rules]; (* BASIS1 *);
ReplaceOneIndex[i:(_._Symbol?BasisQ[_Integer]),rules_]:=Replace[i,rules];(* BASIS2 *);
(* Basis indices *)
ReplaceOneIndex[i:{_,_},rules_]:=ReplaceBasis1Index[i,Replace[i,rules],rules]; (* BASIS1 *);
ReplaceOneIndex[i:(_._?IModQ[_]),rules_]:=ReplaceBasis2Index[i,Replace[i,rules],rules]; (* BASIS2 & IMOD *);
(* Patterns. PINDEX *)
ReplaceOneIndex[i_Blank,rules_]:=(Message[ReplaceIndex::nopat,i,$WarningFrom];i);
ReplaceOneIndex[i_Pattern,rules_]:=replacepattern[i,rules,1];
ReplaceOneIndex[i_PatternTest,rules_]:=replacepattern[i,rules,1];
ReplaceOneIndex[-i_Pattern,rules_]:=-replacepattern[i,rules,-1];
ReplaceOneIndex[-i_PatternTest,rules_]:=-replacepattern[i,rules,-1];
(* Slots *)
ReplaceOneIndex[i:slot[_],rules_]:=Replace[i,rules];
(* Other cases: throw error *)
ReplaceOneIndex[i_,rules_]:=Throw@Message[ReplaceIndex::invalid,i,"index to be replaced"];

Manipulation of basis-indices is separated according to their notation. QUESTION: Why do we need the CheckBasis?Functions ? :

(* BASIS1 *)
ReplaceBasis1Index[{old_,basis_},{old_,basis_},rules_]:=CheckBasis1Index[{ReplaceOneIndex[old,rules],basis}];
ReplaceBasis1Index[old_,new_,rules_]:=new;
CheckBasis1Index[{-a_,basis_Symbol}]:={-a,-basis};
CheckBasis1Index[{a_Integer,basis_}]:={a,basis};
CheckBasis1Index[{a_?UpIndexQ,-basis_Symbol}]:={a,basis};
CheckBasis1Index[index_]:=index;

(* BASIS2 *)
ReplaceBasis2Index[-imod_[old_],-imod_[old_],rules_]:=CheckBasis2Index[imod[ReplaceOneIndex[-old,rules]],-1];
ReplaceBasis2Index[imod_[old_],imod_[old_],rules_]:=CheckBasis2Index[imod[ReplaceOneIndex[old,rules]],1];
ReplaceBasis2Index[old_,new_,rules_]:=new;
CheckBasis2Index[basis_[a_Integer],-1]:=-basis[a];
CheckBasis2Index[imod_[-a_],_]:=-imod[a];
CheckBasis2Index[index_,_]:=index;

Thread over lists of indices:

ReplaceIndexList[list_IndexList,rules_]:=ReplaceOneIndex[#,rules]&/@list

BeginExamples[]

We can change abstract indices:

Trace[xATP`ReplaceOneIndex[-a,-a->b]]

and basis indices:

BasisQ[Polar]^=True;

xATP`ReplaceOneIndex[{-a,-Polar},{-a,-Polar}->b]

xATP`ReplaceOneIndex[-Polar[a],-Polar[a]->b]

xATP`ReplaceOneIndex[{-a,-Polar},-a->b]

xATP`ReplaceOneIndex[-Polar[a],-a->b]

xATP`ReplaceOneIndex[{-a,-Polar},{{-a,-Polar}->b,-a->c}]

xATP`ReplaceOneIndex[-Polar[a],{-Polar[a]->b,-a->c}]

xATP`ReplaceOneIndex[{-a,-Polar},{-a->c,{-a,-Polar}->b}]

xATP`ReplaceOneIndex[-Polar[a],{-a->c,-Polar[a]->b}]

xATP`ReplaceOneIndex[{-a,-Polar},{-a->b}]

xATP`ReplaceOneIndex[-Polar[a],{-a->b}]

xATP`ReplaceOneIndex[{-a,-Polar},{-a->b,-a->c}]

xATP`ReplaceOneIndex[-Polar[a],{-a->b,-a->c}]

We can change blocked indices:

xATP`ReplaceOneIndex[LI[1],LI[1]->b]

xATP`ReplaceOneIndex[{1,Polar},{{1,Polar}->{3,Polar}}]

xATP`ReplaceOneIndex[Polar[1],{Polar[1]->Polar[3]}]

xATP`ReplaceOneIndex[{-a,-Polar},{{-a,-Polar}->{3,Polar}}]

xATP`ReplaceOneIndex[-Polar[a],{-Polar[a]->Polar[3]}]

Study these changes. Note that both notations give consistent results; in particular whenever the rule changes the character of the index then the result also changes character with respect to the original:

xATP`ReplaceOneIndex[{a,Polar},{a->-b}]

xATP`ReplaceOneIndex[{-a,-Polar},{-a->-b}]

xATP`ReplaceOneIndex[{a,Polar},{a->b}]

xATP`ReplaceOneIndex[{-a,-Polar},{-a->b}]

xATP`ReplaceOneIndex[Polar[a],{a->-b}]

xATP`ReplaceOneIndex[-Polar[a],{-a->-b}]

xATP`ReplaceOneIndex[Polar[a],{a->b}]

xATP`ReplaceOneIndex[-Polar[a],{-a->b}]

Rules changing a-indices into integers are always assumed not to change the character of the index

xATP`ReplaceOneIndex[{a,Polar},{a->3}]

xATP`ReplaceOneIndex[Polar[a],{a->3}]

xATP`ReplaceOneIndex[{a,Polar},{a->-3}]

xATP`ReplaceOneIndex[Polar[a],{a->-3}]

However, the LHS of the rule must have the correct character. In these cases we are changing down-indices and therefore we need -a in the rules:

xATP`ReplaceOneIndex[{-a,-Polar},{-a->3}]

xATP`ReplaceOneIndex[-Polar[a],{-a->3}]

xATP`ReplaceOneIndex[{-a,-Polar},{-a->-3}]

xATP`ReplaceOneIndex[-Polar[a],{-a->-3}]

Using rules a->* does not work, even in the BASIS2 notation:

xATP`ReplaceOneIndex[{-a,-Polar},{a->3}]

xATP`ReplaceOneIndex[-Polar[a],{a->3}]

xATP`ReplaceOneIndex[{-a,-Polar},{a->-3}]

xATP`ReplaceOneIndex[-Polar[a],{a->-3}]

That is different from a direct rule:

-Polar[a]/.a->3

-Polar[a]/.a->-3

Note that the sign of patterns is relevant. It is actually extremely important to care about them because the construction Pattern[-a, Blank[]] is not valid in Mathematica:

xATP`ReplaceOneIndex[a_,a->-b]

xATP`ReplaceOneIndex[-a_,-a->b]

xATP`ReplaceOneIndex[a_,-a->b]

xATP`ReplaceOneIndex[-a_,a->-b]

Let us now assume that the signs are correct:

xATP`ReplaceOneIndex[a_,{a->b,-a->-c}]

xATP`ReplaceOneIndex[-a_,{a->b,-a->-c}]

xATP`ReplaceOneIndex[-a_,{a->b}]

xATP`ReplaceOneIndex[-a_,{-a->-b}]

Pattern basis-indices:

xATP`ReplaceOneIndex[{a_,Polar},{a->b,-a->-c}]

xATP`ReplaceOneIndex[Polar[a_],{a->b,-a->-c}]

xATP`ReplaceOneIndex[{-a_,-Polar},{a->b,-a->-c}]

xATP`ReplaceOneIndex[-Polar[a_],{a->b,-a->-c}]

xATP`ReplaceOneIndex[{-a_,-Polar},{a->b}]

xATP`ReplaceOneIndex[-Polar[a_],{a->b}]

xATP`ReplaceOneIndex[{-a_,-Polar},{-a->-b}]

xATP`ReplaceOneIndex[-Polar[a_],{-a->-b}]

If the rules do not want to change a pattern then there is no message from the replacement:

xATP`ReplaceOneIndex[a_,{b->c,-b->-c}]

xATP`ReplaceOneIndex[-a_,{b->c,-b->-c}]

xATP`ReplaceIndexList[IndexList[a,-a,a_a,-a_a,a_a?Q,-a_a?Q,(-a_)?Q],{a->b,-a->-c}]

xATP`ReplaceIndexList[IndexList[a,-a,Dir[a[a]]],a->-b]

Remove[a,b,c,Polar,Q]
EndExamples[]

5.7.2. HoldReplaceIndex

As explained in the subsection HoldMap of section 1, we need to define two functions to be able to have full control on the process of evaluation. The internal function is called HoldReplaceIndex and returns evaluatable expressions wrapped with xHold. The user-function is ReplaceIndex, which is just a call to HoldReplaceIndex with a final ReplaceRepeated to eliminate xHold. The function HoldReplaceIndex holds its first argument:

SetAttributes[HoldReplaceIndex,HoldFirst]

Simplifying case:

HoldReplaceIndex[expr_,{}]:=xHold[expr]

Action on known cases. It is important to note that the actual replacements are performed by ReplaceOneIndex, and this function is only evaluated when a tensor, form or covariant derivative is detected, i.e., when an expression with one of those heads is detected. The whole process is safe as long as there are no conflicts with the identities of heads.

(* Action on atoms *)
HoldReplaceIndex[x:(_Integer|_Rational|_Real|_Complex|_String|_Symbol),rules_]:=xHold[x];

We need to use ReplacePart and not just mapping ReplaceOneIndex because derivatives and tensors can have a HoldAll attribute, that would prevent its evaluation.

(* Action on derivatives *)
HoldReplaceIndex[covd_?CovDQ[inds__][expr_],rules_]:=With[{newcovd=Apply[covd,ReplaceIndexList[IndexList[inds],rules]]},ReplacePart[xHold[newcovd[expr]],HoldReplaceIndex[expr,rules],{1,1}]];
HoldReplaceIndex[CovD[expr_,ders__],rules_]:=With[{newders=Sequence@@Map[ReplaceOneIndex[#,rules]&,{ders},{2}]},ReplacePart[xHold[CovD[expr,newders]],HoldReplaceIndex[expr,rules],{1,1}]];
HoldReplaceIndex[LieD[v_][expr_],rules_]:=ReplacePart[xHold[LieD[v][expr]],HoldReplaceIndex[expr,rules],{{1,1}}];
HoldReplaceIndex[ParamD[ps__][expr_],rules_]:=ReplacePart[xHold[ParamD[ps][expr]],HoldReplaceIndex[expr,rules],{{1,1}}];
HoldReplaceIndex[OverDot[expr_],rules_]:=ReplacePart[xHold[OverDot[expr]],HoldReplaceIndex[expr,rules],{{1,1}}];

(* Action on elementary objects. Nonindexed tensors considered below *)
HoldReplaceIndex[head_?xTensorQ[inds__],rules_]:=ReplacePart[xHold[head[inds]],ReplaceIndexList[IndexList[inds],rules],Thread[{1,Range@Length@{inds}}],Thread[{Range@Length@{inds}}]]

(* Change indices in additional arguments of an inert head *)
changez[expr:xHold[_[_]],rules_]:=expr;
changez[xHold[ih_[expr_,z__]],rules_]:=changez2[xHold[ih[expr,z]],Replace[{z},list_IndexList:>ReplaceIndexList[list,rules],{1}]];
changez2[xHold[ih_[expr_,z__]],{z2__}]:=xHold[ih[expr,z2]];

(* Action on inert heads *)
HoldReplaceIndex[ih_?InertHeadQ[expr_,z___],rules_]:=changez[ReplacePart[xHold[ih[expr,z]],HoldReplaceIndex[expr,rules],{{1,1}}],rules];

(* Shield scalars *)
HoldReplaceIndex[expr:_?ScalarFunctionQ[___],rules_]:=xHold[expr];
HoldReplaceIndex[expr:Derivative[__Integer][_?ScalarFunctionQ][__],rules_]:=xHold[expr];
HoldReplaceIndex[expr_Scalar,rules_]:=xHold[expr];

Now we must define recursion of HoldReplaceIndex on other expressions. First we deal with special cases. Note how the list of indices coming from the first argument of the Module construct needs to be transformed into an IndexList to be replaced and back to a List.

(* Special cases *)
HoldReplaceIndex[HoldPattern[Module[list_List,expr_]],rules_]:=Apply[xHold[Module[##]]&,{List@@ReplaceIndexList[IndexList@@list,rules],HoldReplaceIndex[expr,rules]}]

Then we have the generic case. Recall what we said before: only when a tensor, form or covd is found the function ReplaceOneIndex does its job. In this generic definition we only find recursion towards deeper levels, looking for one of those objects. This is equivalent to a definition using HoldMap, but a bit faster. It needs some explanations:
	- ReplacePart does not have any Hold argument, what means that we need to care about evaluation.
	- We always Hold the input expression using xHold, what forces us to use the {1, ...} structure in the first thread.
	- The second argument contains a list of objects where the index replacements have been performed.
	- The list {elements} cannot be evaluated and therefore it must always appears as Unevaluated[{elements}].

HoldReplaceIndex[head_[],rules_]:=head[]
HoldReplaceIndex[head_[elements__],rules_]:=ReplacePart[xHold[head[elements]],Map[Function[{x},HoldReplaceIndex[x,rules],{HoldAll}],Unevaluated@{elements}],Thread[{1,Range@Length@Unevaluated@{elements}}],Thread[{Range@Length@Unevaluated@{elements}}]]

5.7.3. ReplaceIndex

Finally we define ReplaceIndex. Note the trick: we perform the calculation using HoldReplaceIndex, which puts xHold everywhere. Then we wrap the resulting expression with Hold and eliminate the xHold heads. Finally we replace the Hold head with the head f:

ReplaceIndex is the function that actually performs the change of indices taking into account the type of expression. However, at this level, there is no check on whether the rules are consistent with the presence of a metric, or the action of derivatives, etc. We do not even check that indices are not repeatd. We just assume that the given rules are correct. There is no need to distinguish among the five kinds of g-indices.

?ReplaceIndex

The function ReplaceIndex holds its mathinput argument:

SetAttributes[ReplaceIndex,HoldFirst]

In ReplaceIndex rules can be a rule or a list of rules, that is rules:(_Rule|{(_Rule)...}). A list of lists of rules, that is rules:{(_List)..}, is threaded. Note that we use Repeated (..) and not RepeatedNull (...).

ReplaceIndex[expr_,rules:{(_List)..},f_:Identity]:=ReplaceIndex[expr,#,f]&/@rules;

Main definition:

ReplaceIndex[expr_,rules_,f_:Identity]:=f@@(Hold[Evaluate[HoldReplaceIndex[expr,rules]]]//.xHold[x_]->x)

We only hold the input expression, and not the rules among indices:

(* Other *)
SetNumberOfArguments[ReplaceIndex,{2,3}];
Protect[ReplaceIndex];

5.7.4. Examples

BeginExamples[]

xTensorQ[T]^=True;
xTensorQ[a]^=True;
CovDQ[CD]^=True;

ReplaceIndex[1]

ReplaceIndex[1,2,3,4]

xATP`HoldReplaceIndex[1,{}]//FullForm

ReplaceIndex[1,{}]

a[a_]:=T[a]

xATP`HoldReplaceIndex[a[a],a->b]//FullForm

ReplaceIndex[a[a],a->b]

ReplaceIndex[a[a],a->b,Hold]

Trace[ReplaceIndex[a[a],a->b]]

T[x_,y_]:=F[x,y]

T[a,b]+(T[a,b]+(T[a,b]+T[a,b]))

Note that T is a tensor, but F is not:

ReplaceIndex[4T[a,b],{a->c}]

ReplaceIndex[4F[a,b],{a->c}]

ReplaceIndex[T[a,b]+(T[a,b]+(T[a,b]+T[a,b])),{a->c}]

ReplaceIndex[T[a,b]+(T[a,b]+(T[a,b]+T[a,b])),{a->c},Hold]

ReplaceIndex[RuleDelayed[T[a,b]+T[a,b],T[a,b]+T[a,b]],a->c]

ReplaceIndex[Rule[T[a,b]+T[a,b],T[a,b]+T[a,b]],a->c]

ReplaceIndex[Module[{a,b},T[a_,b]+T[-a_?Q,b]],{a->c,-a->-d},Hold]

ReplaceIndex[Module[{a,b},T[a_,b]+T[-a_?Q,b]],{a->c,-a->-d}]

xATP`HoldReplaceIndex[Cd[a][CD[-a][a[a,c]]],a->b]//FullForm

ReplaceIndex[Cd[a][CD[-a][a[a,c]]],{}]

ReplaceIndex[Cd[a][CD[-a][a[a,c]]],a->b]

ReplaceIndex[Cd[a][CD[-a][a[a,c]]],{a->b,-a->-b}]

ReplaceIndex[CD[a][CD[-a][a[a,c]]],a->-b]

ReplaceIndex[CD[a][CD[-a][a[a,c]]],-a->b]

ReplaceIndex[a CD[a][CD[-a][a[a,c]]],a->-b]

ReplaceIndex[CD[a][CD[-a][a[a,c]]],{a->-b,c->a}]

ReplaceIndex[CD[a][CD[-a][a[a,c]]],{{a->-b,c->a},{a->-d,c->d}}]

Multiple-index derivatives:

ReplaceIndex[CD[-a,-b][a[a,b]],{-a->-c,-b->-d}]

We must be careful with Lie derivatives. Indices in the heads are not replaced

ReplaceIndex[LieD[a[a]][LieD[a[a]][CD[-a][a[a]]]],a->b,Hold]

ReplaceIndex[LieD[a[a]][LieD[a[a]][CD[-a][a[a]]]],a->b]

ReplaceIndex[a[a,-a],{a->b,-a->-b}]

ReplaceIndex[Bracket[a[a],a[c]][a],a->b]

ScalarFunctions (shielding):

ReplaceIndex[Power[a[a,-a],3],{a->b,-a->-b}]

Delayed rules:

SomeHead[x__]:=OtherHead[x]

ReplaceIndex[a[b,-b]:>SomeHead[CD[-a][a[b,-b,a]]],{b->c,-b->-c,a->d,-a->-d}]

with Module constructs:

ReplaceIndex[a[b,-b]:>Module[{b},CD[-a][a[b,-b,a]]],{b->c,-b->-c,a->d,-a->-d}]

ReplaceIndex[HoldPattern[a[b,-b]]:>Module[{b},CD[-a][a[b,-b,a]]],{b->c,-b->-c,a->d,-a->-d}]

They are dealt with specifically. Note the list of dummies in the previous case and compare with

ReplaceIndex[a[b,-b]:>SomeHead[{b},CD[-a][a[b,-b,a]]],{b->c,-b->-c,a->d,-a->-d}]

Note the differences between using Rule and RuleDelayed.

ReplaceIndex[a[b,-b]->Module[{b},CD[-a][a[b,-b,a]]],{b->c,-b->-c,a->d,-a->-d}]

ReplaceIndex[a[b,-b]:>Module[{b},CD[-a][a[b,-b,a]]],{b->c,-b->-c,a->d,-a->-d}]

ReplaceIndex[a[b,-b]->SomeHead[{b},CD[-a][a[b,-b,a]]],{b->c,-b->-c,a->d,-a->-d}]

Involved constructions. Even totally forbidden constructions:

ReplaceIndex[Function[{x},T[a,c_]],a->b]

ReplaceIndex[Function[{x},T[a_,k]+Hold[Function[{},T[a,c_]]]],a->b]

The replacement of indices can lead to inconsistent situations if the rules are not mathematically valid. For example, assume that the defined covariant derivative CD is not associated to the metric of a bundle. Then the following replacement is invalid:

ReplaceIndex[T[a]CD[-b][a[-a]],{a->-a,-a->a}]

CovDQ[CD]^=False;

Series:

T[a,b,c]x+a[a,b,c]x^2+O[x]^3

ReplaceIndex[Evaluate[%],{a->d}]

Remove[a,b,"b$*",c,Cd,CD,"c$*",d,F,k,OtherHead,Q,SomeHead,T,x,y]
EndExamples[]

5.7.5. ReplaceDummies, SameDummies

Here we first find the dummy indices of an expression and construct new (dollar) dummies to replace the former. There is an important question: both sets must be sorted somehow, so that we replace sorted dummies by sorted newdummies. If we have one term the situation is simple and evident. If we have several terms we must have the same newdummies for all terms of an expression.

0) We can define a fast replacing function which simply adds new $'s to the dummies. This is a private function and right now it is not being used. Perhaps this could be used as a faster replacement for ReplaceDummies when the second argument is empty.

?FastReplaceDummies

SetAttributes[FastReplaceDummies,HoldFirst];
FastReplaceDummies[expr_]:=Module@@{Union[IndexName/@FindDummyIndices[expr]],Unevaluated[expr]}

1a) The function ReplaceDummies just generates new indices and distribute them among the terms of the expression. It is not defined on Module constructs, but a function ReplaceDummiesInModule will be defined below to solve that particular point. The list newdummies is always a list of abstract up-indices.

?ReplaceDummies

QUESTION: On March 4, 2010 I change MathInputExpand[expr] to simply expr in the first argument of the call to ReplaceDummies2 in the next two lines, because I don't understand why it is there. This is a potentially dangerous change, in the sense that it could lead to different-looking results, though still correct.

ReplaceDummies[expr_?NonIndexedScalarQ,_]:=expr;
ReplaceDummies[expr_,newdummies_IndexList:IndexList[]]:=ReplaceDummies2[expr,dummypool[newdummies,FindFreeAndDummyIndices[expr]]];

The function dummypool returns the list of possible dummies to use. It takes into account the value of the global variable $ComputeNewDummies and also the fact the free indices of the expression cannot be used as dummies.

$ComputeNewDummies=True;
dummypool[newdummies_IndexList,{frees_IndexList,dummies_IndexList}]:=DeleteDuplicates@DeleteCases[Join[IndexName/@newdummies,If[$ComputeNewDummies,DummyIn/@VBundleOfIndex/@dummies,IndexList[]]],Alternatives@@(IndexName/@frees)];

New code for the previous cell. Now we return the result of dummypool sorted (with Sort, via Complement). Note that we could have Join[ Complement[ newdummies, frees], DummyIn/@dummies], but the way we do it is a bit safer, though a bit slower :

$ComputeNewDummies=True;
dummypool[newdummies_IndexList,{frees_IndexList,dummies_IndexList}]:=Complement[Join[IndexName/@newdummies,If[$ComputeNewDummies,DummyIn/@VBundleOfIndex/@dummies,IndexList[]]],IndexName/@frees];

Note that dummypool generates more indices than needed, I mean, more than the number of indices in the list dummies.

1b) The function SameDummies sorts (with Union, not DeleteDuplicates@*IndexSort) the dummies and reuses them.

?SameDummies

SameDummies[expr:(_Plus|_SeriesData|_Equal|_List)]:=ReplaceDummies2[expr,Union[IndexName/@FindDummyIndices[expr]]];
SameDummies[expr_]:=expr;

2) Now we have an internal driver. It cannot be implemented in ReplaceDummies to ensure that the DeleteCases structure does its job. Extended to work on Equal and List expressions, as suggested by Teake and Thomas.

ReplaceDummies2[expr:(_Plus|_Equal|_List),newdummies_IndexList]:=ReplaceDummies2[#,newdummies]&/@expr;
ReplaceDummies2[HoldPattern[SeriesData[var_,orig_,coeffs_,rest__]],newdummies_IndexList]:=SeriesData[ReplaceDummies2[var,newdummies],ReplaceDummies2[orig,newdummies],ReplaceDummies2[#,newdummies]&/@coeffs,rest];
ReplaceDummies2[expr_,newdummies_IndexList]:=ReplaceIndex[expr,SameVBundleRules[Sort[IndexName/@FindDummyIndices[expr]],newdummies]]

The newdummies are assumed to be sorted, and hence we do not sort them again. We need Sort in the first argument of SameVBundleRules. This is to ensure that the new indices keep the same ordering as the old indices. We do it via Sort, and not IndexSort. That means that there is no guarantee that ReplaceDummies on a canonicalized expression returns another canonical expression.

Finally we have the most internal part, which finds the rules to be used in the replacement. Note that FindDummyIndices returns the indices in their original order, and that order is kept in SameVBundleRules. On the other hand SameDummies sorts the dummies to be introduced.

md[i_]:={VBundleOfIndex[i],i};
SameVBundleRules[IndexList[],_]:={};
SameVBundleRules[indices_IndexList,newindices_IndexList]:=SameVBundleRules[indices,newindices,$VBundles];
SameVBundleRules[indices_,newindices_,{vbundle_}]:=OneVBundleRules[indices,newindices];
SameVBundleRules[indices_,newindices_,vbundles_List]:=SameVBundleRules2[md/@indices,md/@newindices,vbundles];
SameVBundleRules2[indices_,newindices_,vbundles_]:=Apply[Join,SameVBundleRules[Last/@IndexList@@Cases[indices,{#,_}],Last/@IndexList@@Cases[newindices,{#,_}],{#}]&/@vbundles];
OneVBundleRules[indices_,newindices_]:=With[{tmp=newindices[[Range[Length[indices]]]]},Inner[Rule,indices,tmp,List]~Join~Inner[Rule,Minus/@indices,Minus/@tmp,List]];

SetNumberOfArguments[ReplaceDummies,{1,2}];
SetNumberOfArguments[SameDummies,1];
Protect[ReplaceDummies,SameDummies];

ReplaceDummies[]

ReplaceDummies[1,2,3]

These functions must be only used for simplification, and not for usual dummy replacement on rules. That is done by Module constructs.

5.7.6. DuplicateRule

Given a rule between indices, very often we also need the same rule for their dual indices:

DuplicateRule[HoldPattern[Rule[a_,b_]]]:=Sequence[Rule[a,b],Rule[ChangeIndex[a],ChangeIndex[b]]];
DuplicateRule[list_List]:=DuplicateRule/@list;
DuplicateRule[list_IndexList]:=DuplicateRule/@list;

QUESTION: There should be a parallel function changing to conjugate indices.

5.7.7. SplitIndex

We introduce a command SplitIndex, a generalized version of ReplaceIndex, based on rules of the form a -> IndexList[a1, a2, a3, ...] and returning a list of expressions with the index a replaced by a1, a2, a3, ... respectively. The key idea is that of using ReplaceIndex internally only once, and then folding using ReplaceAll, and not ReplaceIndex:

1) There basic notation for index splitting is a "split-rule":
	index -> IndexList[ i1, i2, ... ]
or a list of them (head List) for several different indices splitted. This other notation is also allowed:
	IndexList[ index1, index2, ... ] -> IndexList[ i1, i2, ... ]
understood as
	{ index1 -> IndexList[ i1, i2, ... ] ,  index2 -> IndexList[ i1, i2, ... ] , ... }
which could be useful when splitting over c-indices in xCoba. The function ArrangeSplitRules is in charge of converting any of those cases into a list of split-rules. Not the use of Reverse to get multiple indices in the expected order. The returned list of split-rules has head IndexList:

ArrangeSplitRules[rule:(Rule|RuleDelayed)[_?GIndexQ,_]]:=IndexList[rule];
ArrangeSplitRules[rules:(Rule|RuleDelayed)[_IndexList,_]]:=Thread[MapAt[Reverse,rules,1],IndexList,1];
ArrangeSplitRules[list_IndexList]:=Flatten[ArrangeSplitRules/@Reverse[list],1,IndexList];
ArrangeSplitRules[list_List]:=ArrangeSplitRules[IndexList@@list];

2) Now we have a list of splitrules. We need to transform each of those split-rules into a column matrix of rules which can be fed to either ReplaceIndex or ReplaceAll. We do that with InterpretSplitRules:

InterpretSplitRules[rule:Rule[_,IndexList[]]]:=Throw@Message[SplitIndex::invalid,rule,"replacement rule"];
InterpretSplitRules[rule:Rule[_,_IndexList]]:=Apply[List,List/@Thread[rule,IndexList]];
InterpretSplitRules[List[rules___]]:=InterpretSplitRules/@IndexList[rules];

3) And this is the main function (most of the temporary variables could be avoided, but the function would be difficult to read then):

?SplitIndex

changefirst[rule_[a_,b_],Rule[a_,c_]]:=rule[c,b];
SplitIndex[expr_,rules_]:=Module[{splitrules,firsts,dollars,rules1,rules2},
splitrules=ArrangeSplitRules[rules];
firsts=First/@splitrules;
dollars=DummyAs/@firsts;
rules1=Inner[Rule,firsts,dollars,List];
rules2=InterpretSplitRules[Inner[changefirst,splitrules,IndexList@@rules1,List]];
Fold[ReplaceAll,ReplaceIndex[expr,rules1],rules2]
];
SetNumberOfArguments[SplitIndex,2];
Protect[SplitIndex];

Comments:
	- This way of working is very safe because, even though most of the replacements are done by ReplaceAll, the first function manipulating expr inside SplitIndex is ReplaceIndex, which changes the indices to be splitted into unique variables, and hence there cannot be any confusion afterwards.
	- Splitting only makes sense with free indices, and perhaps with blocked indices, but never with dummy indices. Not even with both split-rules a->IndexList[c,d] and -a->IndexList[-b, -c]. This is because SplitIndex acts as Outer, producing all combinations, but we would need something like Inner to expand dummies. Use TraceDummy.
	- The notations for SplitIndex and TraceDummy are very different. That does not make much sense.

5.7.8. TraceIndex and TraceDummy

The function TraceDummy is based on the combination of the private functions ToIndexExpr and TraceIndex (do not confuse TraceDummy with TraceIndex, the latter being named after SplitIndex). We first call ToIndexExpr, using the function TraceDummyExpr as second argument. The third argument is a wrapper for those expanded terms. This function does not have attribute HoldFirst, that is, we assume that the original expression cannot be further evaluated.

TraceDummy[expr_List,args__]:=TraceDummy[#,args]&/@expr;
TraceDummy[expr_,rules_,function_:Identity]:=FromIndexExpr[ToIndexExpr[expr,TraceDummyExpr[#,rules,function]&]];
SetNumberOfArguments[TraceDummy,{2,3}];
Protect[TraceDummy];

The function TraceDummyExpr interprets the result from ToIndexExpr and checks that we always trace indices which are really dummy indices:

$TraceDummyVerbose=False;
(* Always a list of rules *)
TraceDummyExpr[expr_,rule:(_Rule|_RuleDelayed),function_]:=TraceDummyExpr[expr,{rule},function];
(* No dummies or no rules: do nothing *)
TraceDummyExpr[expr:IndexExpr[_,_,IndexList[]],_,_]:=expr;
TraceDummyExpr[expr_IndexExpr,{},_]:=expr;
(* General case: dummies and rules *)
TraceDummyExpr[expr:IndexExpr[expr1_,frees_,dummies_],rules:{((Rule|RuleDelayed)[_,_])..},function_]:=With[{tracerules=ChooseRules[dummies,rules]},
With[{traceinds=First/@tracerules},
If[$TraceDummyVerbose,Print["Tracing indices ",traceinds," in ",FromIndexExpr@HoldForm[expr1]]];
ReplacePart[IndexExpr[expr1,frees,Complement[dummies,traceinds,ChangeIndex/@traceinds]],TraceIndex[expr1,tracerules,function],{1},{1}]]];

This small function selects the rules which will be used to trace dummies. This is where we check that we are actually using rules which match the dummies of the subexpression being traced. Note that rules can be rules with patterns on the LHS, but tracerules always has normal g-indices on the LHS. We temporarily block a global variable HEAD to ensure that the Inner construct is performed correctly. The problem comes from the possibility of having head List or IndexList in updummies. In this way updummies always has head HEAD.

ChooseRules[dummies_,rules_]:=Block[{HEAD},With[{updummies=Union[UpIndex/@HEAD@@dummies]},DeleteCases[Inner[Rule,updummies,Replace[updummies,rules,1],IndexList],HoldPattern[Rule[x_,x_]]]]];

This private function is almost identical to SplitIndex, simply adding the commands DuplicateRule on rules1, rules2 and then the final addition of all elements of the list of terms. This function is dangerous for direct tracing because it does not check whether the indices of the splitrules are present or not in the expression being traced. We assume they are, but this is only true when TraceIndex is called from TraceDummy. Note that this function is completely independent from IndexExpr.

SetAttributes[TraceIndex,HoldFirst];
TraceIndex[expr_,IndexList[],function_:Identity]:=Hold[function[expr]];
TraceIndex[expr_,rules_,function_:Identity]:=Module[{splitrules,firsts,dollars,rules1,rules2,terms},
splitrules=ArrangeSplitRules[rules];
firsts=First/@splitrules;
dollars=DummyAs/@firsts;
rules1=Inner[Rule,firsts,dollars,List];
rules2=InterpretSplitRules[Inner[changefirst,splitrules,IndexList@@rules1,List]];
rules1=DuplicateRule/@rules1;
rules2=DuplicateRule/@rules2;
terms=Flatten@Fold[ReplaceAll,ReplaceIndex[expr,rules1,Hold],rules2];
(* function is mapped inside a Hold expression, and hence not yet evaluated. Fixed after Leo found a problem *)
function/@ReplacePart[Thread[terms,Hold],Plus,{1,0}]
];

We can use interesting constructs like these. Note that only the upindex is matched in the rules, but TraceIndex internally duplicates the rules.

TraceDummy[T[a,b,c]T[-a,d,-c],dummy_?TangentM`Q:>IndexList[DummyIn[TangentM1],DummyIn[TangentM2]]]
TraceDummy[T[{a,polar},{-a,-polar}],{a_Symbol,polar}->IndexList[{0,polar},{1,polar},{2,polar},{3,polar}]]

BeginExamples[]

xTensorQ[T]^=True;
BasisQ[polar]^=True;
xAct`xCoba`VBundleOfBasis[polar]^=TM;
AbstractIndexQ[a]^=True;
VBundleOfIndex[a]^=TM;
SubvbundleQ[TM,TM]^=True;

TraceDummy[T[{a,polar},{-a,-polar}],{a_Symbol,polar}->IndexList[{0,polar},{1,polar},{2,polar},{3,polar}]]

TraceDummy[T[polar[a],-polar[a]],polar[a_Symbol]->IndexList[polar[0],polar[1],polar[2],polar[3]]]

Remove[T,polar,a,TM]

EndExamples[]

6. Manifolds and mappings

(***************************** 6.Manifolds ****************************)

{TimeUsed[],SessionTime[],TimeUsed[]/SessionTime[]}

6.0. Comments

If[$ReadingVerbose,Print["Reading section 6: Manifolds."],Null,Null]

Manifolds are considered differentiable (C-smooth-enough) manifolds with no special properties. In the future we could include discrete (differentiability level, topological?) properties of the manifold which would be useful in some calculations, but currently there is none. We only store the dimension of the manifold, and the vbundles for which it is the base. Manifolds are always assumed to be real, in the sense of being locally some (ℝ^dim). There is no complex manifold support in xTensor; I suggest you define a manifold of real dimension 2*dim. We will see later that we support complex vector spaces, but not complex manifolds.

Then we have mappings among manifolds. A mapping is a new type of object in xTensor.

To allow for description of integration of differential forms, we understand that our concept of manifold is actually that of manifold with boundary. We could even generalize it to handle corners, but we do not do that for the moment.

6.1. DefManifold

6.1.0. Comments

Currently the manifold is defined using three sets of objects:
	- The name of the manifold: a symbol not in use in the current session.
	- The dimension.
	- The abstract indices for the tangent bundle.
The indices are essentially used only to define the tangent bundle. The dimension is relevant when defining charts on the manifold, and can be either a nonnegative integer or a constant-symbol (which has to be already defined).

Compare to Sage:
	- It is possible to define the manifold over a field:
		- ‘real’ or an object of type RealField for a manifold over R.
		- ‘complex’ or an object of type ComplexField for a manifold over C.
		- an object in the category of topological fields for other types of manifolds.
	- Manifolds have a structure:
		- ‘topological’ for a topological manifold.
		- ‘differentiable’ for a differentiable manifold (of a given differentiation degree, say 4 for  C^4).
		- ‘smooth’ for a smooth manifold (differentiable of infinite degree).
		- ‘analytic’ for an analytic manifold.
	- Manifolds have a “start_index” that specifies how to count coordinates, etc.
	- A manifold has an atlas, a collection of charts. This is a xCoba concept in xAct (function ChartsOfManifold).

6.1.1. Checks

Intermediate function. First we check the input (note that there are no heads in the argument patterns). The list of indices must have head List and not IndexList, because this is what the user is told to use (they are abstract indices, so there is no possible source of confusion). There must be at least one index. We use ValidateIndex[#, False] to avoid sending the Validate::capital warning message. This is because the indices will be checked again in DefVBundle later. The check is already here to avoid defining the manifold and then finding out that it is not possible to define its tangent bundle. Dimension 0 is special: indices are not required because there is no tangent bundle. Dimension 1 is (currently) not special.

In the past we were rather restrictive with the possible forms for the dimension. Now we accept anything, and so there is no validation of dimension:

checkDefManifold[manifold_,supermanifold_,tbundle_,dim_,indices_]:=(
(* 1.- Validate manifold *)
ValidateSymbol[manifold];
ValidateSymbolInSession[manifold];
(* 2.- Validate supermanifold *)
If[supermanifold=!=Null,
If[!ManifoldQ[supermanifold],Throw@Message[DefManifold::unknown,"supermanifold",supermanifold]];
If[NumberQ[dim]&&NumberQ[DimOfManifold[supermanifold]]&&DimOfManifold[supermanifold]<=dim,
Throw@Message[DefManifold::error,"Dimension of submanifold cannot be larger than that of its supermanifold."]]
];
(* 3.- Validate tbundle *)
Switch[tbundle,
Automatic,Null,
manifold,Throw@Message[DefManifold::error,"A manifold and its tangent bundle cannot share name."],
_,
ValidateSymbol[tbundle];
ValidateSymbolInSession[tbundle]
];
(* 4.- Validate indices *)
If[dim=!=0,
If[Head[indices]=!=List,Throw@Message[DefManifold::invalid,indices,"list of indices"]];
If[indices==={}&&dim=!=0,Throw@Message[DefManifold::empty,3,"indices"]];
(*Dim1: If[dim===1&&Length[indices]=!=1,Throw@Message[DefManifold::invalid,indices,"list of indices for a 1-dim manifold"]];*);
ValidateIndex[#,False]&/@indices
];
);

6.1.2. Tangent

Construction of the name of the tangent vbundle to a given manifold: simply join Tangent and the name of the manifold. Note the difference between using GiveSymbol[Tangent, manifold] and Tangent[manifold]. The latter checks that manifold is ManifoldQ, but not the former, which can hence be used during DefManifold, even before manifold has been declared.

GiveSymbol[Tangent,manifold_Symbol?ManifoldQ]:=SymbolJoin[Tangent,manifold];
Tangent[manifold_Symbol?ManifoldQ]:=GiveSymbol[Tangent,manifold];
PrintAsCharacter[Tangent]="𝕋";

If the manifold is not symbolic then Tangent stays unevaluated, still interpreted as a vbundle. This actually should never happen.

VBundleQ[Tangent[manifold_?ManifoldQ]]^:=True;

This is its formatting:

MakeBoxes[Tangent[manifold_?HeldManifoldQ],StandardForm]:=interpretbox[Tangent[manifold],RowBox[{"T",MakeBoxes[manifold,StandardForm]}]];

Backward compatibility:

TangentBundleOfManifold=Tangent;

6.1.3. Cartesian product manifolds

Define as a manifold:

ManifoldQ[manifold_CartesianProduct]^:=And@@(ManifoldQ/@List@@manifold);

Properties:

DimOfManifold[manifold_CartesianProduct]^:=Plus@@(DimOfManifold/@List@@manifold);
Tangent[manifold_CartesianProduct]^:=CirclePlus@@(Tangent/@List@@manifold);
SplittingsOfManifold[manifold_CartesianProduct]^:={manifold};

6.1.4. Main function

I think Master will never be used with a manifold, because manifolds are the most primitive concepts, but I prepare it anyway. There is no Dagger option here.

?DefManifold

Options[DefManifold]={Tangent->Automatic,Master->Null,PrintAs->Identity,ProtectNewSymbol:>$ProtectNewSymbols,DefInfo->{"manifold",""}};
DefManifold[list_List,rest___]:=Scan[DefManifold[#,rest]&,list];
(* Backwards compatibility (three definitions) *)
DefManifold[manifold_,dim_,indices_List,ultraindex_Symbol,options___?OptionQ]:=
(Print["** DefManifold (legacy): Ultraindex "<>ToString[ultraindex]<>" converted into normal index."];DefManifold[manifold,dim,Append[indices,ultraindex],options]);
DefManifold[manifold_,{integers___Integer?Positive},indices_List,options___?OptionQ]:=
(Print["** DefMainfold (legacy): CNumbers "<>ToString[{integers}]<>" only used to compute dimension."];DefManifold[manifold,Length[{integers}],indices,options]);
DefManifold[supermanifold_,submanifolds:(_List|_CartesianProduct),indices_List,options___?OptionQ]:=
(DefManifold[supermanifold,Apply[Plus,DimOfManifold/@submanifolds],indices,options];
SplitManifold[supermanifold,submanifolds]);
(* Single manifold *)
DefManifold[manifold_,dim_,indices_List,options:OptionsPattern[]]:=
Catch@Module[{tbundle,master,pa,pns,info},
{tbundle,master,pa,pns,info}=OptionValue[{Tangent,Master,PrintAs,ProtectNewSymbol,DefInfo}];
checkDefManifold[manifold,Null,tbundle,dim,indices];
(* Register manifold structure *)
MakeDefInfo[DefManifold,manifold,info];
MakexTensions[DefManifold,"Beginning",manifold,dim,indices,options];
AppendToUnevaluated[$Manifolds,manifold];
ManifoldQ[manifold]^=True;
DefInfo[manifold]^=info;
SetPrintAs[manifold,PrintAsString[manifold,pa]];
SymbolRelations[manifold,master,{}];
DimOfManifold[manifold]^=dim;
SplittingsOfManifold[manifold]^={};
(* Define (co)tangent bundle. DefVBundle assumes that the manifold has been already registered *)
If[dim===0,
If[$DefInfoQ,Print["** DefManifold:  Tangent bundle does not exist for a 0-dim manifold"]],
If[tbundle===Automatic,
tbundle=GiveSymbol[Tangent,manifold],
Tangent[manifold]^=tbundle
];
DefVBundle[tbundle,manifold,dim,indices,Master->manifold,PrintAs:>GiveOutputString[Tangent,manifold],options];
TangentBundleQ[tbundle]^=True;
];
MakexTensions[DefManifold,"End",manifold,dim,indices,options];
If[pns,Protect[manifold]];
];
(* Submanifold of another manifold *)
DefManifold[submanifold_,dim_,supermanifold_?ManifoldQ,indices_List,options:OptionsPattern[]]:=
Catch@Module[{tbundle,master,pa,pns,info},
{tbundle,master,pa,pns,info}=OptionValue[DefManifold,{DefInfo->{"manifold","Submanifold of "<>ToString[supermanifold]<>"."}},{Tangent,Master,PrintAs,ProtectNewSymbol,DefInfo}];
checkDefManifold[submanifold,supermanifold,tbundle,dim,indices];
(* Register manifold structure *)
MakeDefInfo[DefManifold,submanifold,info];
MakexTensions[DefManifold,"Beginning",submanifold,dim,supermanifold,indices,options];
Append[$Manifolds,submanifold];
ManifoldQ[submanifold]^=True;
DefInfo[submanifold]^=info;
SetPrintAs[submanifold,PrintAsString[submanifold,pa]];
SymbolRelations[submanifold,master,{supermanifold}];
submanifold/:SubmanifoldQ[supermanifold,submanifold]=True;
SplittingsOfManifold[submanifold]^={};
DimOfManifold[submanifold]^=dim;
(* Define (co)tangent bundle. DefVBundle assumes that the manifold has been already registered *)
If[dim===0,
If[$DefInfoQ,Print["** DefManifold:  Tangent bundle does not exist for a 0-dim manifold"]],
If[tbundle===Automatic,
tbundle=GiveSymbol[Tangent,submanifold],
Tangent[submanifold]^=tbundle;
];
DefVBundle[tbundle,submanifold,dim,indices,Master->submanifold,PrintAs:>GiveOutputString[Tangent,submanifold],options];
];
MakexTensions[DefManifold,"End",submanifold,dim,supermanifold,indices,options];
(* We do not define an explicit restricion of the bundle Tangentsupermanifold to submanifold *)
If[pns,Protect[submanifold]];
];
(* A zero-dimensional manifold does not need indices *)
DefManifold[manifold_,0,options___?OptionQ]:=DefManifold[manifold,0,{},options];
DefManifold[manifold_,0,supermanifold_?ManifoldQ,options___?OptionQ]:=DefManifold[manifold,0,supermanifold,{},options];
(* Other *)
SetNumberOfArguments[DefManifold,{2,Infinity}];
Protect[DefManifold];

Note that the submanifold has its own indices, those of the tangent vbundle of the submanifold. Perhaps we should use the same indices of the supermanifold, because the tangent vbundle of the submanifold is a subbundle of the tangent vbundle of the supermanifold. This must be linked with the issue of projectors.

DimOfManifold is only used to pass the dimension of the tangent bundle, and to check that the dimensionality of a supermanifold coincides with the sum of the dimensions of the submanifolds.

DimOfManifold[x_]:=Throw@Message[DimOfManifold::unknown,"manifold",ToString[x]];
SetNumberOfArguments[DimOfManifold,1];
Protect[DimOfManifold];

6.1.5. Submanifold structure

I'm not happy with the current structure of submanifolds. It is complicated and too restrictive. QUESTION.

?SplittingsOfManifold

SplittingsOfManifold[manifold_]:=Throw@Message[SplittingsOfManifold::unknown,"manifold", manifold];
SetNumberOfArguments[SplittingsOfManifold,1];
Protect[SplittingsOfManifold];

The manifold structure is rather limited because currently it only admits one level of inclusion, not more. That is submanifolds of submanifolds will not be properly treated.

?SubmanifoldQ

SubmanifoldQ[manifold_,manifold_]:=True;
SubmanifoldQ[_,_]:=False;
SetNumberOfArguments[SubmanifoldQ,2];
Protect[SubmanifoldQ];

Note that currently SubmanifoldQ is only used by DisjointManifoldsQ (which in turn is only used by ZeroDerivativeQ).

?DisjointManifoldsQ

DisjointManifoldsQ[manifolds1_List,manifold2_]:=And@@(DisjointManifoldsQ[#,manifold2]&/@manifolds1);
DisjointManifoldsQ[manifold1_,manifolds2_List]:=And@@(DisjointManifoldsQ[manifold1,#]&/@manifolds2);
DisjointManifoldsQ[manifold1_,manifold2_]:=Not[SubmanifoldQ[manifold1,manifold2]||SubmanifoldQ[manifold2,manifold1]];
SetNumberOfArguments[DisjointManifoldsQ,2];
Protect[DisjointManifoldsQ];

Following a suggestion by Guillaume, we shall first declare both the supermanifold and its submanifolds, and then we shall create the association, with a command SplitManifold, which does more or less what DefManifold does right now in the Cartesian product case. This is more flexible, because we can declare all manifolds in any order, and then do the association. Using DefManifold, right now we can only declare first the submanifolds and then the supermanifold.

(* Cartesian product manifold *)
SplitManifold[supermanifold_,submanifolds_CartesianProduct]:=SplitManifold[supermanifold,List@@submanifolds];
SplitManifold[supermanifold_,submanifolds_List]:=
Catch@Module[{prot=Unprotect[supermanifold]},
(* Checks *)
If[DimOfManifold[supermanifold]=!=Apply[Plus,DimOfManifold/@submanifolds],Throw@Message[DefManifold::error,"Invalid dimension of supermanifold."]];
(* Register *)
xUpAppendTo[SplittingsOfManifold[supermanifold],CartesianProduct@@submanifolds];TagSet[supermanifold,SubmanifoldQ[supermanifold,#],True]&/@submanifolds;
AppendToUnevaluated[$ProductManifolds,supermanifold];
(*SymbolRelations[supermanifold,Null,submanifolds];*)
Protect[Evaluate[prot]];
(* Split tangent bundle *)
SplitVBundle[Tangent[supermanifold],Tangent/@submanifolds];
];

It is unclear whether it is better to register the supermanifold as a visitor or as a host of the subvbundles. SplitManifold is called by DefManifold[supermanifold, {submanifolds}], in which clearly supermanifold is a visitor of the (already existing) submanifold. But on the other hand the idea of splitting seems to suggest the opposite. I have had problems in both cases, so I prefer not to define any SymbolRelations at all in this case.

The variable $ProductManifolds is never used in xTensor. The variable $SumVBundles below is used only in TraceProductDummy.

The submanifold structure is modelled on the idea of Cartesian product of manifolds, and not on the ideas of inmersion or embedding, which require the specification of a mapping.

6.1.6. Undefinition

When we undefine a manifold, we also undefine all tensor fields on that manifold.

?UndefManifold

UndefManifold[list:{___?ManifoldQ}]:=Scan[UndefManifold,list];
UndefManifold[manifold_]:=Catch@With[{servants=ServantsOf[manifold]},
(* Checks *)
If[Not@MatchQ[manifold,_Symbol],Throw@Message[UndefManifold::error,"Only symbols can be undefined."]];
If[Not@ManifoldQ[manifold],Throw@Message[UndefManifold::unknown,"manifold",manifold]];
CheckRemoveSymbol[manifold];
MakexTensions[UndefManifold,"Beginning",manifold];
xUpSet[ServantsOf[manifold],{}];
DropFromHosts[manifold];
(* Undefine servants, including the tangent bundle *)
Undef/@Reverse[servants];
$Manifolds=DeleteCases[$Manifolds,manifold];
$ProductManifolds=DeleteCases[$ProductManifolds,manifold];
MakexTensions[UndefManifold,"End",manifold];
(* Eliminate symbol *)
MakeUndefInfo[UndefManifold,manifold];
RemoveSymbol[manifold];
];
SetNumberOfArguments[UndefManifold,1];
Protect[UndefManifold];

6.1.7. Formatting

TODO: Why is it that manifolds do not participate in the PrintAs system?

Held version of ManifoldQ to avoid evaluation leaks during typesetting:

SetAttributes[HeldManifoldQ,HoldAllComplete];
HeldManifoldQ[expr_]:=ManifoldQ[Unevaluated[expr]];

6.1.7. Boundaries

Our concept of manifold is actually that of “manifold with boundary”. TODO: Propagate this concept through the Mapping functionality and other parts of xTensor.

(* ManifoldBoundary *)
ManifoldQ[ManifoldBoundary[_?ManifoldQ]]^:=True;
DimOfManifold[ManifoldBoundary[M_?ManifoldQ]]^:=DimOfManifold[M]-1;
(* We assume no corners *)
ManifoldBoundary[ManifoldBoundary[M_?ManifoldQ]]:=EmptyManifold;
SetNumberOfArguments[ManifoldBoundary,1];
Protect[ManifoldBoundary];
(* Formatting *)
MakeBoxes[ManifoldBoundary[M_],fmt_]:=RowBox[{"∂",MakeBoxes[M,fmt]}];

(* Empty manifold *)
ManifoldQ[EmptyManifold]^:=True;
ManifoldBoundary[EmptyManifold]^:=EmptyManifold;
DimOfManifold[EmptyManifold]^:=0;
Protect[EmptyManifold];
(* Formatting *)
MakeBoxes[EmptyManifold,fmt_]:="∅";

6.2. Dependencies

6.2.1. DependenciesOf

In the end, all objects are functions of parameters and manifolds (functions of their coordinates). We call them "the dependencies" of those objects. The function DependenciesOf returns a list of parameters and manifolds. We stress that we are talking about manifolds, and not about vector bundles.

SortDependencies sorts the dependencies in a "canonical order": first we have parameters, sorted in alphabetical order, and then we have manifolds, also sorted alphabetically. In most cases we do not need to sort the dependencies, and that is why DependenciesOf does not sort them. Actually, now it is only used when defining a tensor, just for aesthetic reasons.

?SortDependencies

SortDependencies[list_List]:=DeleteDuplicates@Join[Sort@Select[list,ParameterQ],Sort@Select[list,ManifoldQ]];

We separate the action of the (private) function DependenciesOfIndex for the different types of indices. We shall see that in xTensor we assume that if an index belongs to a given vbundle, then the tensor naturally depends on the corresponding base manifold, unless otherwise stated. However, the dependencies of a tensor are given explicitly and are not computed from those of its indices. What we are doing here is taking into account that the CD-type indices store expressions which can add dependencies to those associated to the tensor.

DependenciesOfIndices[]:={};
DependenciesOfIndices[inds__]:=Apply[Union,DependenciesOfIndex/@IndexList[inds]];
DependenciesOfIndex[Dir[expr_]]:=DependenciesOf[expr];
(* If different elements of the basis have different dependencies, then this (private) function must be overwritten *)
DependenciesOfIndex[{a_,basis_}]:=xAct`xCoba`DependenciesOfBasis[basis]; (* BASIS1 *);
DependenciesOfIndex[basis_?BasisQ[a_]]:=xAct`xCoba`DependenciesOfBasis[basis]; (* BASIS2 *);
DependenciesOfIndex[-x_]:=DependenciesOfIndex[x];
DependenciesOfIndex[_Symbol]:={};
DependenciesOfIndex[_LI]:={};
(* Other cases, including patterns *)
DependenciesOfIndex[_]:={AnyDependencies};

Note the difference between the functions DependenciesOf and DependenciesOfTensor. The former expects an expression as input, the latter the name of a tensor. That is, v[] could be the argument for the former, but v would be the argument for the latter. The same thing happens with ManifoldsOf and ManifoldsOfTensor. Perhaps ManifoldsOfTensor should act like SymmetryOfTensor, i.e., first on the whole expression with indices, and then, if that is not defined, on the tensor name. No, because DependenciesOf is already taking care of the indices of the tensor.

?DependenciesOf

DependenciesOf[expr:(_Plus|_Times)]:=Union@@(DependenciesOf/@List@@expr);
DependenciesOf[HoldPattern[SeriesData[var_,orig_,coeffs_,rest__]]]:=Union[DependenciesOf[var],DependenciesOf[orig],DependenciesOf/@coeffs];
DependenciesOf[tensor_?xTensorQ[inds___]]:=Union[DependenciesOfTensor[tensor],DependenciesOfIndices[inds]];
DependenciesOf[covd_?CovDQ[inds__][expr_]]:=Union[DependenciesOfCovD[covd],DependenciesOf[expr],DependenciesOfIndices[inds]];
DependenciesOf[CovD[expr_,ders___,covd_?CovDQ[inds__]]]:=Union[DependenciesOf[CovD[expr,ders]],DependenciesOfCovD[covd],DependenciesOfIndices[inds]];
DependenciesOf[LieD[v_][expr_]]:=Union[DependenciesOf[v],DependenciesOf[expr]];
DependenciesOf[ParamD[__][expr_]]:=DependenciesOf[expr];
DependenciesOf[OverDot[expr_]]:=DependenciesOf[expr];
DependenciesOf[param_Symbol?ParameterQ]:={param};
(* This must be overwritten if invalid *)
DependenciesOf[ih_?InertHeadQ[expr_,z___]]:=Union[DependenciesOf[expr],DependenciesOfInertHead[ih]];
DependenciesOf[prod_?ProductQ[exprs___]]:=Union@Flatten[DependenciesOf/@{exprs}];
DependenciesOf[sf_?ScalarFunctionQ[args__]]:=Union@Flatten[DependenciesOf/@{args}];
DependenciesOf[Derivative[__Integer][sf_?ScalarFunctionQ][args__]]:=Union@Flatten[DependenciesOf/@{args}];
DependenciesOf[x_Symbol?ParameterQ]:={x};
DependenciesOf[x_Symbol?ConstantSymbolQ]:={};
DependenciesOf[expr_?NumericQ]:={};
DependenciesOf[Scalar[expr_]]:=DependenciesOf[expr];
DependenciesOf[_]:={AnyDependencies};
SetNumberOfArguments[DependenciesOf,1];
Protect[DependenciesOf];

Note also that ManifoldsOf and ParametersOf are public functions, but ManifoldsOfTensor and ParametersOfTensor are private. The functions ManifoldsOf and ManifoldsOfTensor are only called by ZeroDerivativeQ. The function ParametersOf is used by ParamD.

Dependencies of pullbacks are handled below in section 9.

?ManifoldsOf

?ManifoldsOfTensor

ManifoldsOf[expr_]:=Select[DependenciesOf[expr],ManifoldQ];
ManifoldsOfTensor[tensor_]:=Select[DependenciesOfTensor[tensor],ManifoldQ];
SetNumberOfArguments[ManifoldsOf,1];
Protect[ManifoldsOf];

?ParametersOf

?ParametersOfTensor

ParametersOf[expr_]:=Select[DependenciesOf[expr],ParameterQ];
ParametersOfTensor[head_]:=Select[DependenciesOfTensor[head],ParameterQ];
SetNumberOfArguments[ParametersOf,1];
Protect[ParametersOf];

Very dirty trick:

?AnyDependencies

ManifoldQ[AnyDependencies]^=True;
ParameterQ[AnyDependencies]^=True;
Protect[AnyDependencies];

The most important role of DependenciesOf is through ManifoldsOf and ZeroDerivativeQ. It is conceivable that it will be relevant as well when working with charts.

6.2.2. Restrictions: At

At is an inert head. It only restricts to submanifolds, not to values of parameters:

InertHeadQ[At]^=True;
LinearQ[At]^=True;
At[tensor_Plus,P_]:=At[#,P]&/@tensor;
At[tensor_Times,P_]:=At[#,P]&/@tensor;
At[x_,P_]:=x/;ManifoldsOf[x]==={};
DefInfo[At]^={"inert head","Generic head to denote restrictions to submanifolds."};
AppendToUnevaluated[$InertHeads,At];

The main property is the following:

DependenciesOf[At[expr_,sub_]]^:=Replace[DependenciesOf[expr],dep_?(SubmanifoldQ[#,sub]&):>sub];

Formatting (YES, the At?InertHeadQ is needed there):

MakeBoxes[At?HeldInertHeadQ[expr_,sub_],fmt_]:=RowBox[{MakeBoxes[expr,fmt],SubscriptBox["|",MakeBoxes[sub,fmt]]}];

SetNumberOfArguments[At,2];
Protect[At];

New idea. I now think that we could use At for multiple purposes, not just restriction of tensor fields. We can also restrict vbundles, mappings, bases, etc.

There are two ways we can do this: either we use At for everything, so that the properties of At[e, sub] are basically the properties of e, or we introduce different heads, say TensorAt, BasisAt, VSpaceAt, etc. We would need:

	At[texpr, sub]
	TensorAt[T, sub]
	VBundleAt[vb, sub]
	BasisAt[vb, sub]		Do we need a ChartAt[chart, sub] ? I don’t think so. Recall that charts are also mappings.

	I think we will not need to use At[index, sub], but it is not fully clear. This is related to our handling of starred indices in mappings.
	Is there such a thing as the restriction of a covariant derivative? I’ll start assuming there isn’t.
	We don’t need ManifoldAt[M, sub], because that’s just sub.
	
	The most difficult case is that of a mapping, because we can have the restriction of the domain of a mapping. Note however that the restriction of a mapping, even if it is to a point, is still a mapping, and not the evaluation of the mapping on that submanifold. So now I’m confused: Is really At a restriction or is it an evaluation? I tend to believe that we need both concepts separately, and that At as an evaluation is more important. We need the At that makes At[TM, p] == TpM in standard differential geometry. And for the evaluation case, do we need At[map[], P] or At[map, P] ? I think it is the former. The latter does not make much sense.

For tensors and bases we can see At as “evaluating the field character at a point”, but for vbundles we don’t have a field, but a disjoint union, so the concept of restriction seems better. Well At[vbundle, p] is effectively InverseFunction[π][p] for the natural projection π of the vbundle.

Clarity seems to prefer the use of TensorAt, etc, but probably it is simpler and safer to use just At. Speedwise, it would be better to use separate symbols, to load each one with less definitions. Actually, I think this last argument is the most important one and we should indeed have separate symbols. In conclusion, At only acts on tensor field expressions and evaluates them at a point. Then we would have

	TensorAt[tensor, P]  and  MetricAt[metric, P]
	BasisAt[basis, P]
	VSpaceAt[vbundle, P]

This VSpace[vbundle, P] seems to be pointing in the direction of an eventual FiberAt[fiberbundle, P].

6.3. Mappings

6.3.0. Comments

Mappings are “functions” that act on points or subsets of a manifold, returning points or subsets of another manifold (which could be the same).

The main notation is ϕ : M -> N, with dom(ϕ)=M, im(ϕ)=N and range ϕ(M).

In principle we could have declared them to be fields, but we want to use ϕ[P] notation for the action of a mapping on a point.

Mappings will be either registered symbols or composition (SmallCircle) of those registered symbols. The only mapping which is given in advance is IdentityMapping[M], and note that it is not a symbol.

All our mappings are assumed to be smooth mappings, and we only declare their local properties. As usual the global properties are taken to be the best possible compatible with those local assumptions.

We register a domain manifold and an image manifold for each mapping. Then there is the range of the mapping, which does not necessarily coincide with the image. The range of a mapping is considered a submanifold of the image (using our “local” concept of manifold).

We don’t use properties InjectiveMappingQ/SurjectiveMappingQ, because those are global properties of the mapping, and xAct should handle only local properties. Local injectivity is ImmmersionQ and local surjectivity is SubmersionQ. That is what we use, with defaults Automatic, meaning True if dimensions allow, and False otherwise.

If the mapping is only an immersion then there is no full notion of inverse mapping, because we cannot define it on all of N. I have tried to define it on ϕ(M) but the programming becomes complicated because we need to handle the subvbundle of TN restricted to ϕ(M), and also because the map ϕ restricted to the image ϕ(M) is really a different map, which complicates matters. In particular it is difficult to come up with a good notation for the indices of the tangent mapping of such inverse of ϕ. We don’t follow this route. What we currently do instead is to assume that there is always a (nonunique) left-inverse map from N to M which does the right thing on ϕ(M) and is arbitrarily extended to the rest of N. We can take it to be a submersion from N to M.

Anyway it might be useful to have a way to restrict mappings to submanifolds, something like MappingAt[ϕ, submanifold], or perhaps RestrictedMapping[ϕ, submanifold].

If the mapping is only a submersion then there is a notion of right inverse (we actually work as if the mapping was a global submersion). This right inverse is not unique in general, but can be chosen to be an immersion. It will be unique if we are working with a diffeormorphism.

If the mapping is not an immersion nor a submersion then there is no inverse associated.

Some notes on global properties (this is proper use of the terminology):
	- Being a diffeomorphism is a global property, but if a map is both an immersion and a submersion then it is a local diffeomorphism. To be a (global) diffeomorphism it would have to be bijective as well.
	- Local injectivity (immersion) does not imply global injectivity. Then we would talk about injective immersions.
	- An embedding is an injective immersion which is also a topological embedding. Then M is diffeomorphic to ϕ(M). An immersion is a local embedding. If M is compact then an injective immersion is an embedding.

Our manifolds are all real, and hence the mappings too.

6.3.1. IdentityMapping

IdentityMapping[M] maps the manifold M into itself. Note that it stays as IdentityMapping[M], instead of converting into IdentityMappingM, as we would have done in previous versions of xTensor.

Properties:

MappingQ[IdentityMapping[M_?ManifoldQ]]^:=True;
InverseMapping[IdentityMapping[M_]]^:=IdentityMapping[M];
MappingDomain[IdentityMapping[M_]]^:=M;
MappingImage[IdentityMapping[M_]]^:=M;
ImmersionQ[IdentityMapping[M_]]^:=True;
SubmersionQ[IdentityMapping[M_]]^:=True;
TangentTensor[IdentityMapping[M_]]^:=delta;

Action:

IdentityMapping[M_][point_]:=point/;SubmanifoldQ[M,point];

Formatting:

PrintAs[IdentityMapping[M_]]^:=StringJoin["\!\(Id\_",PrintAs[M],"\)"];
MakeBoxes[IdentityMapping[M_],StandardForm]:=SubscriptBox["Id",MakeBoxes[M,StandardForm]];

6.3.2. Definition

?DefMapping

Options[DefMapping]={
ImmersionQ->Automatic,
SubmersionQ->Automatic,
InverseMapping->Automatic,
Master->Null,
PrintAs->Identity,
ProtectNewSymbol:>$ProtectNewSymbols,
DefInfo->{"mapping",""}
};
DefMapping[list_List,rest___]:=Scan[DefMapping[#,rest]&,list];
DefMapping[phi_,domain_->image_,options:OptionsPattern[]]:=
Catch@Module[{type,tbundle,immQ,subQ,inv,master,pa,pns,info,definvQ,domdim,imdim,tdom,tim,tindsQ,iindsQ},
{immQ,subQ,inv,master,pa,pns,info}=OptionValue[{ImmersionQ,SubmersionQ,InverseMapping,Master,PrintAs,ProtectNewSymbol,DefInfo}];

(* 1. Name validation: the symbol might be a chart already *)
If[ChartQ[phi],
If[MappingQ[phi],
(* The mapping already exists. This is a duplicated name. Probably this never happens *)
Throw@Message[ValidateSymbol::used,phi,"as a mapping"],
(* Coordinate mapping being defined. Symbol validation already performed. Do nothing *)
Null
],
(* Noncoordinate mapping. Perform symbol validation *)
ValidateSymbol[phi];
ValidateSymbolInSession[phi]
];

(* 2. Consistency checks *)
If[!ManifoldQ[domain],Throw@Message[DefMapping::unknown,"manifold",domain]];
If[!ManifoldQ[image],Throw@Message[DefMapping::unknwon,"manifold",image]];
domdim=DimOfManifold[domain];
imdim=DimOfManifold[image];
If[immQ===Automatic,
immQ=TrueQ[domdim≤imdim],
If[!TrueOrFalse[immQ],Throw@Message[DefMapping::unknown,"value of option ImmersionQ",immQ]];
If[immQ&&domdim>imdim,Throw@Message[DefMapping::error,"Mapping cannot be an immersion because image dimension is smaller than domain dimension."]];
];
If[subQ===Automatic,
subQ=TrueQ[domdim≥imdim],
If[!TrueOrFalse[subQ],Throw@Message[DefMapping::unknown,"value of option SubmersionQ",subQ]];
If[subQ&&domdim<imdim,Throw@Message[DefMapping::error,"Mapping cannot be a submersion because image dimension is larger than domain dimension."]];
];
(* Check for the inverse mapping *)
definvQ=(immQ||subQ)&&Quiet[Catch[InverseMapping[phi]]]===Null;
If[definvQ,
If[inv===Automatic,inv=GiveSymbol[InverseMapping,phi]];
ValidateSymbol@@{inv};
ValidateSymbolInSession[inv];
];

(* 3. Register mapping properties *)
MakeDefInfo[DefMapping,phi,info];
MakexTensions[DefMapping,"Beginning",phi,{domain,image},options];
AppendToUnevaluated[$Mappings,phi];
MappingQ[phi]^=True;
DefInfo[phi]^=info;
SetPrintAs[phi,PrintAsString[phi,pa]];
SymbolRelations[phi,master,{domain,image}];
MappingDomain[phi]^=domain;
MappingImage[phi]^=image;
ImmersionQ[phi]^=immQ;
SubmersionQ[phi]^=subQ;
(* This is the main consequence of being a submersion *)
If[subQ,
phi[domain]=image,
If[immQ,phi/:SubmanifoldQ[image,phi[domain]]=True]
];

(* 4. Register InverseMapping *)
If[definvQ,
With[{iphi=inv},
InverseMapping[phi]^=iphi;
InverseMapping[iphi]^=phi;
(* Define inverse mapping and its differential *)
DefMapping[iphi,image->domain,ImmersionQ->subQ,SubmersionQ->immQ,Master->phi,PrintAs:>GiveOutputString[InverseMapping,phi],DefInfo:>Which[immQ&&subQ,{"inverse mapping",""},immQ,{"left-inverse mapping","Assuming arbitrary extension."},subQ,{"right-inverse mapping","Not uniquely defined."}]];
(* For a submersion there is a right inverse *)
If[subQ,
phi[iphi[x_]]:=x/;SubmanifoldQ[phi[domain],x];
phi/:SmallCircle[phi,iphi]=IdentityMapping[image];
];
(* For an immersion there is a left inverse *)
If[immQ,
iphi[phi[x_]]^:=x/;SubmanifoldQ[domain,x];
phi/:SmallCircle[iphi,phi]=IdentityMapping[domain];
]
]
];

(* Before proceeding, if the domain/image is Reals[_] check whether there are indices already *)
tdom=Tangent[domain];
tim=Tangent[image];
If[Head[domain]===Reals && Quiet[Catch[IndicesOfVBundle[tdom]]]===Null,
tindsQ=True;
Quiet@RegisterIndices[tdom,Take[DeleteCases[xAct`xCoba`Private`$TangentRealsTemporaryIndices,_?AbstractIndexQ],4]];
];
If[Head[image]===Reals&& Quiet[Catch[IndicesOfVBundle[tim]]]===Null,
iindsQ=True;
Quiet@RegisterIndices[tim,Take[DeleteCases[xAct`xCoba`Private`$TangentRealsTemporaryIndices,_?AbstractIndexQ],4]];
];

(* 5. Define the tangent mapping tensor *)
With[{dphi=GiveSymbol[TangentTensor,phi]},
Module[{index1,index2},
{index1}=GetIndicesOfVBundle[tdom,1];
(* This declares the pullback-vundle indices for the first time *)
{index2}=GetIndicesOfVBundle[PullBackVBundle[tim,phi],1];
DefTensor[dphi[-index1,index2],{domain},Master->phi,PrintAs:>GiveOutputString[TangentTensor,phi],DefInfo->{"mapping differential tensor",""}];
]
];

(* 6. Relations between the tangent mappings. Both dphi and diphi are declared at this moment *)
If[definvQ ,
With[{dphi=TangentTensor[phi],diphi=TangentTensor[inv],iphi=inv},
Inv[dphi]^=Precompose[diphi,phi];
Inv[diphi]^=Precompose[dphi,iphi];
Module[{index1,index2,index3,index4,index5,index6,index7,index8},
{index1,index3}=GetIndicesOfVBundle[tdom,2];
{index2,index4}=GetIndicesOfVBundle[PullBackVBundle[tim,phi],2];
{index5,index7}=GetIndicesOfVBundle[tim,2,{index1,index3}];
{index6,index8}=GetIndicesOfVBundle[PullBackVBundle[tdom,iphi],2,{index2,index4}];
If[ImmersionQ[phi],
xTagSetDelayed[{dphi,dphi[-index1_,index2_]Precompose[diphi,phi][-index2_,index3_]},delta[-index1,index3]];
xTagSetDelayed[{diphi,diphi[-index5_,index6_]Precompose[dphi,iphi][-index8_,index5_]},delta[-index8,index6]];
xTagSet[{dphi,InvertibleQ[dphi,Right]},True];
xTagSet[{diphi,InvertibleQ[diphi,Left]},True];
];
If[SubmersionQ[phi],
xTagSetDelayed[{dphi,dphi[-index1_,index2_]Precompose[diphi,phi][-index4_,index1_]},delta[-index4,index2]];
xTagSetDelayed[{diphi,diphi[-index5_,index6_]Precompose[dphi,iphi][-index6_,index7_]},delta[-index5,index7]];
xTagSet[{dphi,InvertibleQ[dphi,Left]},True];
xTagSet[{diphi,InvertibleQ[diphi,Right]},True];
];
]
]
];

(* Remove temporary indices *)
If[tindsQ,RemoveIndices[tdom,All]];
If[iindsQ,RemoveIndices[tim,All]];

MakexTensions[DefMapping,"End",phi,{domain,image},options];
If[pns,Protect[phi]];
];
(* Other *)
SetNumberOfArguments[DefMapping,{2,Infinity}];
Protect[DefMapping];

6.3.3. Undefinition

?UndefMapping

UndefMapping[list:{___?MappingQ}]:=Scan[UndefMapping,list];
UndefMapping[phi_]:=Catch@With[{servants=ServantsOf[phi]},
(* Checks *)
If[Not@MappingQ[phi],Throw@Message[UndefMapping::unknown,"mapping",phi]];
CheckRemoveSymbol[phi];
MakexTensions[UndefMapping,"Beginning",phi];
xUpSet[ServantsOf[phi],{}];
DropFromHosts[phi];
(* Undefine servants, including the tangent map *)
Undef/@Reverse[servants];
(* Undefine indices of the pullback bundle tangent to the image. TODO: Does not work for TangentReals *)
UndefAbstractIndex/@Flatten@IndicesOfVBundle[PullBackVBundle[Tangent[MappingImage[phi]],phi]];
$Mappings=DeleteCases[$Mappings,phi];
MakexTensions[UndefMapping,"End",phi];
(* Eliminate symbol *)
MakeUndefInfo[UndefMapping,phi];
RemoveSymbol[phi];
];
SetNumberOfArguments[UndefMapping,1];
Protect[UndefMapping];

TODO: The indices of the pullback bundle are not being defined, what

6.3.4. Domain, image and range

As usual in xTensor we use “global” terminology but we actually mean local concepts. Here the domain/image/range of a mapping are assumed manifolds, while they are just some open sets at best.

1) The domain of a mapping is the “manifold” on which the mapping acts. The mapping is assumed to be defined on the whole domain.

MappingDomain[phi_]:=Throw@Message[MappingDomain::unknown,"mapping",phi];
SetNumberOfArguments[MappingDomain,1];
Protect[MappingDomain];

2) The image of a mapping is the “manifold” onto which the mapping maps. We do not assume surjectivity, and hence the actual range could be smaller than the image. Range and image coincide for submersions.

MappingImage[phi_]:=Throw@Message[MappingImage::unknown,"mapping",phi];
SetNumberOfArguments[MappingImage,1];
Protect[MappingImage];

3) The range of a manifold under a mapping is also considered a “manifold”, if the object being mapped is a manifold:

Unprotect[ManifoldQ];
ManifoldQ[phi_?MappingQ[x_]]:=ManifoldQ[x];
Protect[ManifoldQ];

If such mapping is an immersion then the dimension of the range equals the dimension of the original manifold:

Unprotect[DimOfManifold];
DimOfManifold[phi_?MappingQ[x_?ManifoldQ]]:=If[ImmersionQ[phi],DimOfManifold[x],Throw@Message[DimOfManifold::error1,"Cannot deduce dimensions of manifold",phi[x]]];
Protect[DimOfManifold];

6.3.5. Composition (SmallCircle)

Explicit compositions. To avoid interferences with Composition, and because SmallCircle has already the right typesetting (and even more important, the esc-sc-esc alias), we will use the latter. Note that SmallCircle[] stays unevaluated because we do not know the manifold to use for IdentityMapping. TODO: Perhaps we should use IdentityMapping[] as meaning the identity for any manifold.

SetAttributes[SmallCircle,{Flat,OneIdentity}];
Verbatim[SmallCircle][phi_?MappingQ]:=phi;
Verbatim[SmallCircle][left___?MappingQ,_IdentityMapping,right___?MappingQ]:=SmallCircle[left,right];

MappingQ[SmallCircle[phis__?MappingQ]]^:=True;

We use the standard right-to-left convention, so the domain is that of the last map and the image is that of the first map:

MappingDomain[SmallCircle[__,phi_?MappingQ]]^:=MappingDomain[phi];
MappingImage[SmallCircle[phi_?MappingQ,__]]^:=MappingImage[phi];

The composition of immersions is an immersion, but if we know that a composition is an immersion then we can only conclude that the rightmost mapping (the first one acting) is an immersion. The composition of submersions is a submersion, but if we know that a composition is a submersion then we can only conclude that the leftmost mapping (the last one acting) is a submersion.

ImmersionQ[SmallCircle[phis__?MappingQ]]:=And@@(ImmersionQ/@{phis});
SubmersionQ[SmallCircle[phis__?MappingQ]]:=And@@(SubmersionQ/@{phis});

QUESTION: The InvertibleMappingQ check is a check of ImmersionQ OR SubmersionQ. That’s probably too permissive. What would be the right check? Do we need to ask the same properties to the “central” maps and to the first/last maps?

InverseMapping[SmallCircle[phis__?InvertibleMappingQ]]:=SmallCircle@@(InverseMapping/@Reverse[{phis}]);

Recall that SmallCircle can be entered as esc-sc-esc, which is very helpful. Note we use parentheses, because the composed map is frequently combined with the pullback and pushforward stars.

PrintAs[SmallCircle[phis__?MappingQ]]^:=StringJoin["(",Riffle[PrintAs/@{phis},$PrecomposeCharacter],")"];

Following Composition in Mathematica, we convert the action of a composition into an explicit nested action of the composed maps:

SmallCircle[phis__?MappingQ][point_]:=Composition[phis][point];

Keep SmallCircle unprotected, as it was initially.

6.3.6. (Local) invertibility

See discussion of local vs global invertibility above.

1) ImmersionQ (left-invertible map):

ImmersionQ[phi_?MappingQ]:=False;
ImmersionQ[phi_]:=Throw@Message[ImmersionQ::unknown,"mapping",phi];
SetNumberOfArguments[ImmersionQ,1];
Protect[ImmersionQ];

2) SubmersionQ (right-invertible map):

SubmersionQ[phi_?MappingQ]:=False;
SubmersionQ[phi_]:=Throw@Message[SubmersionQ::unknown,"mapping",phi];
SetNumberOfArguments[SubmersionQ,1];
Protect[SubmersionQ];

3) Inverse mapping: for ϕ register iϕ, represented as (ϕ^(-1)). The inverse mapping existis only if the mapping is invertible (that is, either an immersion or a submersion). I’m not really sure that the -1 superscript is a good idea. The prepended i is usually clear enough, and less conflicting with other superscripts.

GiveSymbol[InverseMapping,phi_]:=SymbolJoin["i",phi];
GiveOutputString[InverseMapping,phi_]:="\!\("<>PrintAs[phi]<>"\^-1\)";

InverseMapping::noinv="Mapping `1` is not invertible.";
InverseMapping[phi_?MappingQ]:=Throw@Message[InverseMapping::noinv,phi];
InverseMapping[phi_]:=Throw@Message[InverseMapping::unknown,"mapping",phi];
SetNumberOfArguments[InverseMapping,1];
Protect[InverseMapping];

(Local) invertibility, either from the left or the right, or both. This is a private function, so far only used when computing the inverse of a composition.

InvertibleMappingQ[phi_]:=ImmersionQ[phi]||SubmersionQ[phi];

4) DiffeomorphismQ (meaning only the local version):

DiffeomorphismQ[phi_?MappingQ]:=ImmersionQ[phi]&&SubmersionQ[phi];
DiffeomorphismQ[phi_]:=Throw@Message[DiffeomorphismQ::unknown,"mapping",phi];
SetNumberOfArguments[DiffeomorphismQ,1];
Protect[DiffeomorphismQ];

6.3.7. Cartesian product of mappings

Properties:

MappingQ[phi_CartesianProduct]^:=And@@(MappingQ/@List@@phi);
MappingDomain[phi_CartesianProduct]^:=MappingDomain/@phi;
MappingImage[phi_CartesianProduct]^:=MappingImage/@phi;
InverseMapping[phi_CartesianProduct]^:=InverseMapping/@phi;
ImmersionQ[phi_CartesianProduct]^:=And@@(ImmersionQ/@List@@phi);
SubmersionQ[phi_CartesianProduct]^:=And@@(SubmersionQ/@List@@phi);

Behaviour under composition:

CartesianProduct/:SmallCircle[phi1_CartesianProduct,phi2_CartesianProduct]:=ThreadCartesianProduct[SmallCircle,{phi1,phi2}];

phi1_CartesianProduct[phi2_CartesianProduct[point_]]:=ThreadCartesianProduct[SmallCircle,{phi1,phi2}][point];

Action on a point:

phi_CartesianProduct[point_CartesianProduct]:=ThreadCartesianProduct[Compose,{phi,point}];

7. Vector bundles

(***************************** 7.Vector bundles ****************************)

{TimeUsed[],SessionTime[],TimeUsed[]/SessionTime[]}

7.0. Comments

If[$ReadingVerbose,Print["Reading section 7: Vector bundles."],Null,Null]

Nearly everything in this section is about the algebraic structure of the vector space fibers. There is nothing about the differential part, which is handled later in the section on covariant derivatives.  Hence having “Vector bundles” as title might be misleading.  An idea is to introduce vector spaces as a derived type, so that a vector space is a vector bundle over a trivial 0-dimensional space (which we could call None, for example).

Currently the only type of bundle considered in xTensor is a vector bundle (called "vbundle" here), without any further assumption. We will distinguish tangent bundles and inner vbundles because the properties of some objects living on them (like metrics and connections) are different. This is general enough to deal with gauge theories, as shown by Ashtekar et al, and there is no need to specify from the very beginning a gauge group. In case we want to use the gauge group it is important to remember that an inner vbundle plays the role of representation space for the group, and so its dimension only coincides with the group dimension for the fundamental representation. This dimension is called "the number of internal degrees of freedom" by Ashtekar et al.

Though for convenience we use the word bundle everywhere in xTensor, the actual structure of the system is purely algebraic. As pointed out by Ashtekar et al this is due to the fact that our basic objects are already tensor fields on manifolds, and not tensors at a point which have to be later generalized through the bundle idea. This will become a problem later in xCoba, where we will have to define a tensor at a point as a restriction of a tensor field.

As with manifolds, we assume tangent bundles to be real (though they can be complexified), but inner vbundles can be natively complex.

A very important issue is how to relate vbundles and their duals. Sometimes it seems natural for example to say that index a belongs to V and -a to -V, but other times this is problematic because it would seem that a, -a belong to the same structure V (for example when contracting indices). Therefore some of the definitions below keep the signs, but others don't.

Another important issue is how to relate the indices of a fiber bundle and the indices of a pullback of it. At the moment we insert the name of the mapping in the index, so that VBundleOfIndex knows what to return. There is then the associated problem of what is the metric of the pullback bundle.

TODO: $VBundles will not contain the pullback bundles. Hence, some operations threaded over $VBundles might miss some vbundles, say like SameVBundleRules, $FirstMetrics, TransposeDaggerX, SortCovDsStart/Stop, ToCanonical.

7.1. DefVBundle

7.1.0. Comments

Vbundles are always defined being symbolic. We do not allow a defined vbundle to be a pullback (as we *do* with tensors).

The algebraic properties attached to the vbundle actually refer to its standard fiber.

Properties as a vbundle:

	VBundleQ[vbundle]
	BaseOfVBundle[vbundle]
	DimOfVBundle[vbundle]
	IndicesOfVBundle[vbundle]
	LastIndex[vbundle]
	MetricsOfVBundle[vbundle]
	SplittingsOfVBundle[vbundle]
	SubvbundleQ[vbundle, sub]

Generic properties:

	Dagger[vbundle]
	PrintAs[basis]

Properties for a registered basis symbol:
	DefInfo[vbundle]
	MasterOf[vbundle]
	HostsOf[vbundle]
	ServantsOf[vbundle]

7.1.1. Check of input

First we check the input (note that there are no heads in the argument patterns). The list of indices must have head List and not IndexList, because this is what the user is told to use (they are abstract indices, and therefore the is no possibility of confusion). There must be at least one index. Again, we use ValidateIndex with the option False to avoid the message Validate::capital. It will be sent, if needed, by DefAbstractIndex below. Since 0.9.9 we do not validate the dimension:

checkDefVBundle[vbundle_,manifold_,dimF_,indices_,dag_]:=(
(* 1.- Validate vector bundle *)
ValidateSymbol[vbundle];
ValidateSymbolInSession[vbundle];
(* 2.- Validate manifold *)
If[!ManifoldQ[manifold],Throw@Message[DefVBundle::unknown,"manifold",manifold]];
(* 3.- Validate indices *)
If[Head[indices]=!=List,Throw@Message[DefVBundle::invalid,indices,"list of indices"]];
If[indices=={},Throw@Message[DefVBundle::empty,4,"indices"]];
ValidateIndex[#,False]&/@indices;
(* 4.- Validate dag option *)
If[FreeQ[{Real,Complex,Conjugate},dag],Throw@Message[DefVBundle::invalid,dag,"value for option Dagger"]]
);

7.1.2. Register vector bundle structure

We have a list of metrics on the vbundle, the first one being the default metric. Note that we do not redefine $VBundles; initially it is an empty list.

RegisterVBundle[vbundle_Symbol,manifold_]:=(
(* 1.- Register symbol *)
AppendToUnevaluated[$VBundles,vbundle];
VBundleQ[vbundle]^=True;
(* 2.- Register base manifold *)
BaseOfVBundle[vbundle]^=manifold;
(* 3.- There is no associated metric by default *)
MetricsOfVBundle[vbundle]^={};
);

Here we need to decide what to do with the co-vbundles. The functions BaseOfVBundle, MetricsOfVBundle and SplittingsOfVBundle are trivial, but not the function SubvbundleQ. It is not clear either what to do with VisitorsOf[-vbundle]. One might even argue that the metrics for the dual are the inverses, but we do not follow that.

BaseOfVBundle[-vbundle_]:=BaseOfVBundle[vbundle];
BaseOfVBundle[x_]:=Throw@Message[BaseOfVBundle::unknown,"vbundle",x];
SetNumberOfArguments[BaseOfVBundle,1];
Protect[BaseOfVBundle];

MetricsOfVBundle[-vbundle_]:=MetricsOfVBundle[vbundle];
MetricsOfVBundle[x_]:=Throw@Message[MetricsOfVBundle::unknown,"vbundle", x];
SetNumberOfArguments[MetricsOfVBundle,1];
Protect[MetricsOfVBundle];

7.1.3. Metrics in the vector bundle

A vector bundle can have several metrics. They are all stored in MetricsOfVBundle, and only the first one can be used to raise and lower indices. The functions defined here (FirstMetricOfVBundle, FirstMetricQ, $FirstMetrics and MetricEndowedQ) are all defined in terms of MetricsOfVBundle and VBundleOfMetric, and both behave trivially under change of sign of the vbundles. Null is used in various places to mean “there is no metric”.

1) The second argument of FirstMetricOfVBundle says whether we expect to have a metric on the bundle or not. If we do then an error is thrown in case there is none.

?FirstMetricOfVBundle

FirstMetricOfVBundle[vbundle_,mess_:True]:=firstmetricofvbundle[vbundle,MetricsOfVBundle[vbundle],mess];
firstmetricofvbundle[vbundle_,{},True]:=Throw@Message[MetricsOfVBundle::missing,"metric",vbundle];
firstmetricofvbundle[vbundle_,{},False]:=Null;
firstmetricofvbundle[vbundle_,list_List,_]:=First[list];
firstmetricofvbundle[vbundle_,list_,_]:=Throw@Message[MetricsOfVBundle::invalid,list,"list of metrics"];

2) This function says if a metric is the first in its manifold. Note that we throw an error on vbundles without metric, because this question is thought to be used when we already know that the vbundle has a metric, and we are trying to check which one is the first-metric.

?FirstMetricQ

FirstMetricQ[Null,___]:=False;
FirstMetricQ[metric_]:=FirstMetricQ[metric,VBundleOfMetric[metric]];
FirstMetricQ[metric_,vbundle_]:=metric===FirstMetricOfVBundle[vbundle,True];

3) This global variable is computed on the fly giving the first metrics of the manifolds with a metric:

?$FirstMetrics

$FirstMetrics:=DeleteCases[FirstMetricOfVBundle[#,False]&/@$VBundles,Null];

4) This is a Boolean function giving whether there is a metric (perhaps more) or not in a manifold:

?MetricEndowedQ

MetricEndowedQ[vbundle_]:=UnsameQ[MetricsOfVBundle[vbundle],{}];
SetNumberOfArguments[MetricEndowedQ,1];
Protect[MetricEndowedQ];

7.1.4. IndexRange

This is a simple function to avoid typing lots of indices at definition time of a manifold or vbundle.

?IndexRange

IndexRange[first_String,last_String]:=ToExpression/@CharacterRange[first,last];
IndexRange[first_Symbol,last_]:=IndexRange[ToString[first],last];
IndexRange[first_,last_Symbol]:=IndexRange[first,ToString[last]];
IndexRange[range_List]:=IndexRange@@range;
IndexRange[ranges__List]:=Union@@(IndexRange/@{ranges});
IndexRange[x___]:=Throw[Message[IndexRange::invalid,HoldForm[x],"input for IndexRange"]];
Protect[IndexRange];

7.1.5. Abstract indices in the vector bundle

1) Note that the function vbQ and vbpmQ only detect abstract indices. The notation for those two functions is horrible, due to historical reasons: they were probably encoded the first day I started writing a package for tensor computations... Now it is too late to change them.

?RegisterIndexInVBundle

RegisterIndexInVBundle[index_Symbol,vbundle_,options___]:=With[{vbQ=VBundleIndexQ[vbundle]},
DefAbstractIndex[index,options];
xUpSet[VBundleOfIndex[index],vbundle];
xUpSet[vbQ[index],True]
];

2) The definition of the bQ function is a bit involved. There was a simpler coding with bQ[index_Symbol]:=MemberQ[Flatten@IndicesOfVBundle@vbundle,NoDollar@index], but it was too slow when the list of computer-generated indices was too long. Now this list is not used and the function directly checks NoDollar[index]. All indices in the list have upvalue True on the corresponding bQ function, so that if the index is not recognized, then the default (False) definition is used. The bQ function only recognizes abstract indices. The bQ function is a source of memory leaking through the remembered values. Note that an index can have a different remembered value for each vbundle in the problem...

?RegisterIndices

RegisterIndices[vbundle_?VBundleQ,indices:{__Symbol},options___]:=With[{vbQ=VBundleIndexQ[vbundle],vbpmQ=VBundleIndexPMQ[vbundle]},
(* 1.- Properties of the indices *)
RegisterIndexInVBundle[#,vbundle,options]&/@indices;
(* 2.- Properties of the vector bundle. Separate the case of pullback vbundles *)
If[Head[vbundle]===PullBackVBundle,
With[{vb=First[vbundle],map=Last[vbundle]},
xTagSet[{vb,IndicesOfVBundle[vb,map]},{indices,{}}]
],
IndicesOfVBundle[vbundle]^={indices,{}};
];
SetLastIndex[vbundle,{Last[indices],1}];
(* 3.- Q-functions of the vector bundle *)
vbpmQ[-index_]:=vbQ[index];
vbpmQ[index_]:=vbQ[index];
vbQ[-index_]:=False;
vbQ[index_Symbol?DollarQ]:=vbQ[index]^=vbQ[NoDollar@index];
vbQ[_]:=False;
(* 4.- Complex structure *)
DaggerIndex/@indices;
(* 5.- Return indices *)
{indices,{}}
];

3) In these three functions there could be a sign on the RHS associating down-indices to -vbundle, but this is not clear. It is again a question of whether we are referring to the indices or to the up-indices/down-indices.

?IndicesOfVBundle

IndicesOfVBundle[-vbundle_]:=IndicesOfVBundle[vbundle];
(* Pullback vbundle: switch to two argument form *)
IndicesOfVBundle[PullBackVBundle[vbundle_?VBundleQ,phi_?MappingQ]]^:=IndicesOfVBundle[vbundle,phi];
(* First call of IndicesOfVBundle on a PullBackVBundle does this and gets cached. PrintAs will be handled somewhere else *)
IndicesOfVBundle[vbundle_?VBundleQ,phi_?MappingQ]:=
RegisterIndices[PullBackVBundle[vbundle,phi],MakePullBackIndex[#,phi]&/@First[IndicesOfVBundle[vbundle]],PrintAs->Null];
(* Tangent of a submanifold: consider as a pullback vbundle *)
IndicesOfVBundle[Tangent[phi_?MappingQ[manifold_?ManifoldQ]]]:=IndicesOfVBundle[Tangent[MappingImage[phi]],phi];
IndicesOfVBundle[vbundle_]:=Throw@Message[IndicesOfVBundle::unknown,"vector bundle",vbundle];
SetNumberOfArguments[IndicesOfVBundle,1];
Protect[IndicesOfVBundle];

Note the following issue: if we find IndicesOfVBundle[PullBackVBundle[Tangent[N], phi]] then this returns the modified indices IndicesOfVBundle[Tangent[N], phi]. However, if we find IndicesOfVBundle[Tangent[psi[M]]], such that psi[M] is a submanifold of N, then we have two alternative interpretations: a) We consider Tangent[psi[M]] as equivalent to PullBackVBundle[Tangent[N], psi] or b) we consider it as a subvbundle of Tangent[N] and then the relevant mapping is the inclusion mapping of psi[M] in N. The former approach seems more reasonable, because it allows “parametrizing” ψ[M] with M.

This function decides which index must appear as free index in directional arguments after canonicalization:

FirstIndexOfVBundle[-vbundle_]:=FirstIndexOfVBundle[vbundle];
FirstIndexOfVBundle[vbundle_]:=IndicesOfVBundle[vbundle][[1,1]];

The index to be used when new (numeric i76) indices are created:

?LastIndex

LastIndex[-vbundle_]:=LastIndex[vbundle];
LastIndex[PullBackVBundle[vbundle_, phi_]] := LastIndex[vbundle, phi];
SetNumberOfArguments[LastIndex,{1,2}];
Protect[LastIndex];

This is the function to be used to update the LastIndex:

SetLastIndex[-vbundle_,update_]:=SetLastIndex[vbundle,update];
SetLastIndex[PullBackVBundle[vb_Symbol,phi_],1]:=xTagSet[{vb,LastIndex[vb,phi]},LastIndex[vb,phi]+{0,1}];
SetLastIndex[PullBackVBundle[vb_Symbol,phi_],new_]:=xTagSet[{vb,LastIndex[vb,phi]},new];
SetLastIndex[vbundle_,1]:=xUpSet[LastIndex[vbundle],LastIndex[vbundle]+{0,1}];
SetLastIndex[vbundle_,new_]:=xUpSet[LastIndex[vbundle],new];
(* Remove upvalue *)
SetLastIndex[vbundle_]:=xUpSet[LastIndex[vbundle]];

4) This function returns the vector bundle which a g-index belongs to. VERY IMPORTANT QUESTION: Currently we associate vbundle both to x and -x. We could drop the definitions for patterns and use PatternToIndex, but we prefer to leave it as it is to keep the message VBundleOfIndex::unknown.

?VBundleOfIndex

VBundleOfIndex[x:-_Dir]:=Throw@Message[VBundleOfIndex::invalid,x,"index"];
(* Note that there is no minus sign on the RHS *)
VBundleOfIndex[-x_]:=VBundleOfIndex[x];
VBundleOfIndex[_Blank]:=Throw@Message[VBundleOfIndex::nouse,"VBundleOfIndex","a Blank pattern index"];
(* PINDEX *)
VBundleOfIndex[x_Pattern]:=VBundleOfIndex[First[x]];
VBundleOfIndex[x_PatternTest]:=VBundleOfIndex[First[x]];
VBundleOfIndex[v_Dir]:=VBundleOfIndex[UltraindexOf[v]];
(* C indices *)
VBundleOfIndex[{_Integer,basis_}]:=xAct`xCoba`VBundleOfBasis[basis]; (* BASIS1 *);
VBundleOfIndex[basis_Symbol?BasisQ[_Integer]]:=xAct`xCoba`VBundleOfBasis[basis]; (* BASIS2 *);
(* B indices. No check of consistency of abstract index and basis *)
VBundleOfIndex[{x_,_}]:=VBundleOfIndex[x]; (* BASIS1 *);
(* Other index modifiers *)
VBundleOfIndex[phi_?MappingQ[x_]]:=With[{vb=VBundleOfIndex[x]},vb/;vb===Tangent[MappingImage[phi]]];
VBundleOfIndex[imod_Symbol?IModQ[x_]]:=VBundleOfIndex[x];(* BASIS2 *);
(* Special case for definition of tensors with variable rank *)
VBundleOfIndex[AnyIndices[vbundle_?VBundleQ]]:=vbundle;
VBundleOfIndex[index_Symbol?AIndexQ]:=VBundleOfIndex@NoDollar@index;
VBundleOfIndex[x_LI]:=Labels;
(* VBundleOfIndex[index_]:=VBundleOfIndex[ToExpression@SymbolName@index]/;FreeQ[$ContextPath,Context[index]]*)
VBundleOfIndex[index_]:=Message[VBundleOfIndex::unknown,"index", index];
SetNumberOfArguments[VBundleOfIndex,1];
Protect[VBundleOfIndex];

Vector bundle of an index, taking care of signs. It is convenient to keep the head AnyIndices here, instead of removing it as we do in VBundleOfIndex. This function is currently used in DefTensor, SeparateMetric and ToCanonical.

SignedVBundleOfIndex[AnyIndices[vbundle_?VBundleQ]]:=AnyIndices[vbundle];
SignedVBundleOfIndex[index_?UpIndexQ]:=VBundleOfIndex[index];
SignedVBundleOfIndex[index_?DownIndexQ]:=-VBundleOfIndex[index];

A common construction:

VBundleUpQ[index_]:={VBundleOfIndex[index],UpIndexQ[index]};

Note that a cnumber does not identify a vector bundle uniquely but the basis does it.

5) We associate all labels to a ficticious manifold/vector bundle called Labels. This is a dirty trick to keep the current structure of xTensor. Its properties are:

(* These upvalues are used *)
VBundleQ[Labels]^:=True;
PrintAs[Labels]^:=Labels;
MetricsOfVBundle[Labels]^:={};
(* Are these other used too? We print a message in case they are *)
xAct`xCoba`CNumbersOf[Labels]^:=(Print["CNumbersOf[Labels] called. Tell JMM"];{});
ManifoldQ[Labels]^:=(Print["ManifoldQ[Labels] called. Tell JMM"];True);
SplittingsOfManifold[Labels]^:=(Print["SplittingsOfManifold[Labels] called. Tell JMM"];{});
DimOfManifold[Labels]^:=(Print["DimOfManifold[Labels] called. Tell JMM"];0);
DimOfVBundle[Labels]^:=(Print["DimOfVBundle[Labels] called. Tell JMM"];0);
VisitorsOf[Labels]^:=(Print["VisitorsOf[Labels] called. Tell JMM"];{});
ServantsOf[Labels]^:=(Print["ServantsOf[Labels] called. Tell JMM"];{});
IndicesOfVBundle[Labels]^:=(Print["IndicesOfVBundle[Labels] called. Tell JMM"];{});
BaseOfVBundle[Labels]^:=(Print["BaseOfVBundle[Labels] called. Tell JMM"];Null);

7.1.6. Special definitions for a 1-dim vbundle. Now deactivated

RegisterDim1VBundle[vbundle_Symbol,index_]:=(
xUpSet[Dim1IndexQ[index],True];
xUpSet[IndexName[index],0];
DummyIn[vbundle]^=index;
NewIndexIn[vbundle]^=index;
vbundle/:GetIndicesOfVBundle[vbundle,n_,_]:=Table[index,{n}];
)

Dim1IndexQ[-i_]:=Dim1IndexQ[i];
Dim1IndexQ[_]:=False;

7.1.7. Main function

There are two possibilities for the third argument:
	1) a positive integer, the dimension
	2) a constant-symbol, interpreted as the dimension
In other case we throw an error.

Note that it is not possible to define a 0-dimensional vector bundle. Note also that RegisterIndices uses DaggerIndex, which itself uses DaggerQ and hence requires the SetDaggerPair already in place. That forces us to break the dagger manipulations in two groups.

Options[DefVBundle]={Dagger->Real,Master->Null,PrintAs->Identity,ProtectNewSymbol:>$ProtectNewSymbols,DefInfo->{"vbundle",""}};
DefVBundle[list_List,rest___]:=Scan[DefVBundle[#,rest]&,list];
(* Backwards compatibility *)
DefVBundle[vbundle_,manifold_,dimF_,indices_,ultraindex_Symbol,options___]:=
(Print["** DefVBundle (legacy): Ultraindex "<>ToString[ultraindex]<>" converted into normal index."];DefVBundle[vbundle,manifold,dimF,Append[indices,ultraindex],options]);
(* Backwards compatibility *)
DefVBundle[vbundle_,manifold_,subvbundles_List,indices_,options___?OptionQ]:=
(DefVBundle[vbundle,manifold,Apply[Plus,DimOfVBundle/@subvbundles],indices,options];
SplitVBundle[vbundle,subvbundles]);
(* Simple vector bundle *)
DefVBundle[vbundle_,manifold_,dimF_,indices_,options:OptionsPattern[]]:=
Catch@Module[{dag,master,pa,pns,info},
{dag,master,pa,pns,info}=OptionValue[{Dagger,Master,PrintAs,ProtectNewSymbol,DefInfo}];
checkDefVBundle[vbundle,manifold,dimF,indices,dag];
MakeDefInfo[DefVBundle,vbundle,info];
MakexTensions[DefVBundle,"Beginning",vbundle,manifold,dimF,indices,ultraindex,options];
Switch[dag,
Real,Dagger[vbundle]^=vbundle,
Complex,SetDaggerPair[vbundle,MakeDaggerSymbol[vbundle]],
Conjugate,Null
];
RegisterVBundle[vbundle,manifold];
RegisterIndices[vbundle,indices];
(*Dim1: If[dimF===1,RegisterDim1VBundle[vbundle,First[indices]]]; *)
If[dag===Complex,
DefVBundle[Dagger[vbundle],manifold,dimF,DaggerIndex/@indices,Dagger->Conjugate,Master->vbundle,options,DefInfo->{"conjugated vbundle","Assuming fixed anti-isomorphism between "<>ToString[vbundle]<>" and "<>ToString[Dagger[vbundle]]}]];
DimOfVBundle[vbundle]^=dimF;
SplittingsOfVBundle[vbundle]^={};
DefInfo[vbundle]^=info;
SetPrintAs[vbundle,AddDaggerCharacter[PrintAsString[vbundle,pa],dag]];
SymbolRelations[vbundle,master,{manifold}];
MakexTensions[DefVBundle,"End",vbundle,manifold,dimF,indices,ultraindex,options];
If[pns,Protect[vbundle]];
];
(* Other cases. Errors *)
SetNumberOfArguments[DefVBundle,{4,Infinity}];
Protect[DefVBundle];

The dag check is complicated. It uses a particular order: it first checks whether any of the vbundles involved is complex. Second, it checks that the splitting of the dagger is not already done (to avoid the standard Dagger loop). Third, it checks that the supervbundle is actually complex, and throws an error if not.

SplitVBundle[vbundle_,splitting_CirclePlus]:=SplitVBundle[vbundle,List@@splitting];
SplitVBundle[vbundle_,{}]:=Null;
SplitVBundle[vbundle_,subvbundles_List]:=Catch@Module[{prot=Unprotect[vbundle],dag,dagsplits},
(* Checks. DimOfVBundle effectively checks that subvbundles contains vbundles *)
If[DimOfVBundle[vbundle]=!=Apply[Plus,DimOfVBundle/@subvbundles],Throw@Message[DefVBundle::error,"Invalid dimension of subvbundle."]];
dagsplits=SplittingsOfVBundle[Dagger@vbundle];
dag=(Or@@(DaggerQ/@Prepend[subvbundles,vbundle]))&&
(dagsplits==={}||List@@Last[dagsplits]=!=Dagger/@subvbundles)&&
(DaggerQ[vbundle]||Throw@Message[SplitVBundle::error,"Real vbundle cannot be splitted in complex subvbundles."]);
(* Register *)
xUpAppendTo[SplittingsOfVBundle[vbundle],CirclePlus@@subvbundles];
TagSet[vbundle,SubvbundleQ[vbundle,#],True]&/@subvbundles;
AppendToUnevaluated[$SumVBundles,vbundle];
(*SymbolRelations[vbundle,Null,subvbundles];*)
Protect[Evaluate[prot]];
If[dag,SplitVBundle[Dagger[vbundle],Dagger/@subvbundles]];
];
SetNumberOfArguments[SplitVBundle,2];
Protect[SplitVBundle];

Again, we do not register any SymbolRelations.

Dimensions of vbundle and its dual coincide:

?DimOfVBundle

DimOfVBundle[-vbundle_]:=DimOfVBundle[vbundle];
DimOfVBundle[x_]:=Throw@Message[DimOfVBundle::unknown,"vbundle",x];
SetNumberOfArguments[DimOfVBundle,1];
Protect[DimOfVBundle];

TangentBundleQ[vb_?VBundleQ]:=False;
TangentBundleQ[x_]:=Throw@Message[TangentBundleQ::unknown,"vbundle",x];
SetNumberOfArguments[TangentBundleQ,1];
Protect[TangentBundleQ];

7.1.8. Undefinition

When we undefine a vector bundle, we also undefine all tensor fields on that bundle. If it is complex we also undefine its conjugate, which is a servant.

?UndefVBundle

UndefVBundle[list:{___?VBundleQ}]:=Scan[UndefVBundle,list];
UndefVBundle[vbundle_]:=Catch@With[{servants=ServantsOf[vbundle],manifold=BaseOfVBundle[vbundle]},
If[!VBundleQ[vbundle],Throw@Message[UndefVBundle::unknown,"bundle",vbundle]];
CheckRemoveSymbol[vbundle];
MakexTensions[UndefVBundle,"Beginning",vbundle];
xUpSet[ServantsOf[vbundle],{}];
DropFromHosts[vbundle];
Undef/@Reverse[servants];
UndefAbstractIndex/@Flatten@IndicesOfVBundle[vbundle];
$VBundles=DeleteCases[$VBundles,vbundle];
$SumVBundles=DeleteCases[$SumVBundles,vbundle];
Remove[Evaluate@VBundleIndexQ[vbundle],Evaluate@VBundleIndexPMQ[vbundle]];
MakexTensions[UndefVBundle,"End",vbundle];
MakeUndefInfo[UndefVBundle,vbundle];
RemoveSymbol[vbundle];
];
SetNumberOfArguments[UndefVBundle,1];
Protect[UndefVBundle];

Note that the functions vbundle`Q and vbundle`pmQ must be removed explicitly.

7.1.9. Direct sums and tensor products

Direct sums. For the addition of vbundles over the same base this is actually the Whitney sum, but we extend it to also cover the more general case of vbundle over different bases by using DeleteDuplicates below.

SetAttributes[CirclePlus,{Flat,OneIdentity}];
Verbatim[CirclePlus][vbundle_]:=vbundle;

Properties of a direct sum vbundle:

VBundleQ[vbundle_CirclePlus]^:=And@@(VBundleQ/@List@@vbundle);
BaseOfVBundle[vbundle_CirclePlus]^:=CartesianProduct@@DeleteDuplicates[BaseOfVBundle/@List@@vbundle];
DimOfVBundle[vbundle_CirclePlus]^:=Plus@@(DimOfVBundle/@List@@vbundle);
IndicesOfVBundle[vbundle_CirclePlus]^:=TODO;
LastIndex[vbundle_CirclePlus]^:=TODO;
(* Metric tensors by blocks using respective members of the MetricsOfVBundle lists *)
MetricsOfVBundle[vbundle_CirclePlus]^:=Module[{metrics,min},
metrics=MetricsOfVBundle/@List@@vbundle;
min=Min[Length/@metrics];
metrics=Take[#,min]&/@metrics;
BlockTensor[DiagonalArray[#,2,Zero]]&/@Transpose[metrics]
];
SplittingsOfVBundle[vbundle_CirclePlus]^:={vbundle};
CirclePlus/:SubvbundleQ[large_CirclePlus,small_CirclePlus]:=If[Length[large]===Length[small],Inner[SubvbundleQ,large,small,And],False];
Dagger[vbundle_CirclePlus]^:=Dagger/@vbundle;

Formatting:

PrintAs[vbundle_CirclePlus]^:=StringJoin@@Riffle[PrintAs/@List@@vbundle,"⊕"];

Tensor products. Currently this is DEACTIVATED, because it is not used and we need the symbol CircleTimes for the tensor product of tensors.

SetAttributes[CircleTimes,{Flat,OneIdentity}];
Verbatim[CircleTimes][vbundle_]:=vbundle;

Properties of a tensor product vbundle:

VBundleQ[vbundle_CircleTimes]^:=And@@(VBundleQ/@List@@vbundle);
BaseOfVBundle[vbundle_CircleTimes]^:=TODO;
DimOfVBundle[vbundle_CircleTimes]^:=Times@@(DimOfVBundle/@List@@vbundle);
IndicesOfVBundle[vbundle_CircleTimes]^:=TODO;
LastIndex[vbundle_CircleTimes]^:=TODO;
MetricsOfVBundle[vbundle_CircleTimes]^:=TODO;
SplittingsOfVBundle[vbundle_CircleTimes]^:=TODO;
CircleTimes/:SubvbundleQ[vbundle_CircleTimes,small_]:=TODO;
Dagger[vbundle_CircleTimes]^:=Dagger/@vbundle;

Formatting:

PrintAs[vbundle_CircleTimes]^:=StringJoin@@Riffle[PrintAs/@List@@vbundle,"⊗"];

7.1.10. The pullback bundle

This must be the first definition, to avoid the checks in this case:

PullBackVBundle[vbundle_?VBundleQ,_IdentityMapping]:=vbundle;

Ensure consistency of arguments:

PullBackVBundle::vbmap="Base of vbundle `1` does not coincide with the image of mapping `2`.";
PullBackVBundle[vbundle_?VBundleQ,phi_?MappingQ]:=$Failed/;MappingImage[phi]=!=BaseOfVBundle[vbundle]&&Throw@Message[PullBackVBundle::vbmap,vbundle,phi]

Basic definitions:

VBundleQ[PullBackVBundle[vbundle_?VBundleQ,phi_?MappingQ]]^:=True;
PullBackVBundle[-vbundle_,phi_]:=-PullBackVBundle[vbundle,phi];
(* It is a right-action with respect to composition *)
PullBackVBundle[PullBackVBundle[vbundle_?VBundleQ,phi1_?MappingQ],phi2_?MappingQ]:=PullBackVBundle[vbundle,SmallCircle[phi1,phi2]];

IndicesOfVBundle for a PullBackVBundle object was already handled before.

(* The dimension of a bundle is that of its standard fiber, shared by a bundle and its pullbacks *)
DimOfVBundle[PullBackVBundle[vbundle_?VBundleQ,phi_?MappingQ]]^:=DimOfVBundle[vbundle];

Field related properties:

BaseOfVBundle[PullBackVBundle[vbundle_?VBundleQ,phi_?MappingQ]]^:=MappingDomain[phi];
Dagger[PullBackVBundle[vbundle_?VBundleQ,phi_?MappingQ]]^:=PullBackVBundle[Dagger[vbundle],Dagger[phi]];
HasDaggerCharacterQ[PullBackVBundle[vbundle_?VBundleQ,phi_?MappingQ]]^:=HasDaggerCharacterQ[vbundle];
MetricsOfVBundle[PullBackVBundle[vbundle_?VBundleQ,phi_?MappingQ]]^:=Precompose[#,phi]&/@MetricsOfVBundle[vbundle];
SplittingsOfVBundle[PullBackVBundle[vbundle_,phi_]]^:=PullBackVBundle[#,phi]&/@SplittingsOfVBundle[vbundle];
SubvbundleQ[PullBackVBundle[large_,phi_],PullBackVBundle[small_,phi_]]^:=SubvbundleQ[large,small];

Formatting.

PrintAs[PullBackVBundle[vbundle_,phi_]]^:=StringJoin["(\!\(",PrintAs[vbundle],"\^*\))"];

Special formatting rule for this case:

MakeBoxes[PullBackVBundle[vbundle_?HeldVBundleQ,phi_?MappingQ],StandardForm]:=PullBackBox[MakeBoxes[vbundle,StandardForm],phi];

7.1.11. Formatting

Held version of VBundleQ to avoid evaluation leaks during typesetting:

SetAttributes[HeldVBundleQ,HoldAllComplete];
HeldVBundleQ[expr_]:=VBundleQ[Unevaluated[expr]];

StandardForm:

xTensorFormStart[VBundle]:=(MakeBoxes[vb_Symbol?HeldVBundleQ,StandardForm]:=interpretbox[vb,PrintAs[Unevaluated[vb]]]);
xTensorFormStop[VBundle]:=(MakeBoxes[vb_Symbol?HeldVBundleQ,StandardForm]=.);
xTensorFormStart[VBundle]

7.1.12. Examples

BeginExamples[]

DefManifold[S2,2,{a,b,c,d,e,f}]

?S2

?TangentS2

?a

AIndexQ[-a]//Trace

DaggerIndex[a]

?TangentS2`Q

?TangentS2`pmQ

Dagger[TangentS2]

UndefManifold[S2]

?S2`*

?TangentS2`*

?a

?a$*

DefManifold[S2,2,{a,b,c,d,e,f}]

Here we overload the system capitals:

DefVBundle[Fiber,S2,3,{A,B,C,D},Dagger->Real]

The D still is interpreted as a derivative:

D[f[x],x]

but it is also an index:

AbstractIndexQ[D]

VBundleOfIndex[D]

?Fiber

?Fiber†

?A

?A†

?A††

UndefVBundle[Fiber]

?S2

Though we have undefined the index D, it is still the derivative:

D[f[x],x]

AbstractIndexQ[D]

Now the vbundle is complex:

DefVBundle[Fiber,S2,3,{A,B,C,D},Dagger->Complex]

?Fiber

?Fiber†

UndefVBundle[Fiber]

UndefManifold[S2]

?A

?A†

Remove[x];

Product manifolds:

DefManifold[S,2,{a,b,c}]

DefManifold[R,3,{A,B,C}]

DefManifold[T,4,{𝔄,𝔅,ℭ}]

DefManifold[SRT,{S,R,T},{α,β,χ}]

SRT is a visitor of S, R and T and must be undefined first:

UndefManifold[SRT]

UndefManifold[S]

UndefManifold[R]

UndefManifold[T]

Now we choose the name of the tangent bundle:

DefManifold[S,4,{a,b,c,d,e},Tangent->TS]

?S

?TS

Undef[S]

A one-dimensional manifold. Currently we do not use the single index idea.

DefManifold[M1,1,{a,b,c,d}]

?M1

?TangentM1

UndefManifold[M1]

EndExamples[]

7.2. Comparing vbundles

This is a new function which will take into account duality when comparing vbundles. It is not currently used or documented, nor included in the package.

SameVBundleQ[vbundle1_,vbundle2_]:=SameVBundleQ[vbundle1,vbundle2,MetricEndowedQ[vbundle1]];
SameVBundleQ[vbundle_,vbundle_,_]:=True;
SameVBundleQ[vbundle_,-vbundle_,True]:=True;
SameVBundleQ[-vbundle_,vbundle_,True]:=True;
SameVBundleQ[_,_,_]:=False;
SetNumberOfArguments[SameVBundleQ,{2,3}];
Protect[SameVBundleQ];

7.3. Subvbundles

These are the functions dealing with the relations among vbundles and their subvbundles:

?SplittingsOfVBundle

SplittingsOfVBundle[-vbundle_]:=-SplittingsOfVBundle[vbundle];
SplittingsOfVBundle[x_]:=Throw@Message[SplittingsOfVBundle::unknown,"vbundle", x];
SetNumberOfArguments[SplittingsOfVBundle,1];
Protect[SplittingsOfVBundle];

The function SubvbundleQ is now only used by IndexOnQ and Validate (to check the contents of the slots of a tensor).

?SubvbundleQ

SubvbundleQ[vbundle_,vbundle_]:=True;
SubvbundleQ[All,vbundle_]:=True;
SubvbundleQ[_,_]:=False;
SetNumberOfArguments[SubvbundleQ,2];
Protect[SubvbundleQ];

The All definition is there because the tensors delta and Gdelta have SlotsOfTensor={All, ...}.

Dummies on the subvbundles of a vbundle. Note that vb gives contravariant indices but -vb gives covariant indices.

?SubdummiesIn

SubdummiesIn[vbundle_]:=Apply[IndexList,DummyIn/@List@@(Last@SplittingsOfVBundle[vbundle])];
SetNumberOfArguments[SubdummiesIn,1];
Protect[SubdummiesIn];

DisjointVBundlesQ[vbundles1_List,vbundle2_]:=And@@(DisjointVBundlesQ[#,vbundle2]&/@vbundles1);
DisjointVBundlesQ[vbundle1_,vbundles2_List]:=And@@(DisjointVBundlesQ[vbundle1,#]&/@vbundles2);
DisjointVBundlesQ[vbundle1_,vbundle2_]:=Not[SubvbundleQ[vbundle1,vbundle2]||SubvbundleQ[vbundle2,vbundle1]];
SetNumberOfArguments[DisjointVBundlesQ,2];
Protect[DisjointVBundlesQ];

7.4. Generation of indices on a vector bundle

We need four different structures:

7.4.0. Comments

The command DaggerIndex is able to create and store the complex conjugated index when needed. That simplifies the manipulation of indices in complex vbundles here.

7.4.1. DummyIn, DummyAs

This function generates new dollar dummies:

?DummyIn

We do not use DefAbstractIndex or RegisterIndexInVBundle because those do symbol validation and that takes much time. Here we just want to get a dollar-index.

DummyIn[-vbundle_]:=-DummyIn[vbundle];
DummyIn[Labels]:=LI[General];
DummyIn[vbundle_?VBundleQ]:=(
VBundleIndexQ[vbundle][#1]^=True;
NoDollar[#1]^=#2;
AbstractIndexQ[#1]^=True;
#1)&@@{Unique[#],#}&@First[LastIndex[vbundle]];
DummyIn[vbundle_,AIndex|-AIndex]:=DummyIn[vbundle];
DummyIn[vbundle_,basis_]:={DummyIn[vbundle],basis};
DummyIn[vbundle_]:=Throw@Message[DummyIn::unknown,"vector bundle",vbundle];
SetNumberOfArguments[DummyIn,{1,2}];
Protect[DummyIn];

We have introduced a second argument to specify the possibility of a basis. Note that the character of vbundle and basis must match.

DummyAs[i] gives an **abstract** dummy index in the vector bundle of i, even if i is a basis index. We use upQ to allow this function acting on named patterns (unnamed patterns throw an error in VBundleOfIndex anyway):

?DummyAs

DummyAs[i:(_LI|-_LI)]:=i;
DummyAs[i_]:=If[upQ[i],UpIndex,DownIndex][DummyIn[VBundleOfIndex[i]]];

Extension to bases:

DummyAs[i_,AIndex]:=DummyAs[i];
DummyAs[i:_Symbol|-_Symbol,Automatic]:=DummyAs[i,AIndex];

BASIS1 notation:

DummyAs[i_,basis_]:=With[{f=If[upQ[i],UpIndex,DownIndex]},{f[DummyIn[VBundleOfIndex[i]]],f[basis]}];
DummyAs[i:{_,basis_},Automatic]:=DummyAs[i,basis];

BASIS2 notation (now deactivated):

DummyAs[i_,basis_]:=If[upQ[i],UpIndex,DownIndex][basis[DummyIn[VBundleOfIndex[i]]]];
DummyAs[basis_?BasisQ[i_],Automatic]:=DummyAs[i,basis];
DummyAs[-basis_?BasisQ[i_],Automatic]:=DummyAs[-i,basis];

SetNumberOfArguments[DummyAs,1];
Protect[DummyAs];

There is an important problem concerning memory. Creating an index takes a few bytes, but for very long computations that could be important and fill up the memory. This has a very difficult solution because we cannot remove all symbols containing a dollar, of course. I have tried to use the Temporary attribute, but that only works inside a Module construct, and in general we need to move indices around arbitrarily. The problem is most important with ReplaceDummies, and there we can stop it using the global variable $ComputeNewDummies, but I need something more general. I define the function RemoveDollarIndices[number], which removes all dollar indices having that number at least.

BeginExamples[]

DefManifold[M3,3,{a,b,c,d}]

DummyIn[TangentM3]

Information[Evaluate[%]]

DaggerIndex[%%]

DummyAs/@{a,-a,{a,polar},{-a,-polar}}

?d

?d$*

UndefManifold[M3]

?d$*

Remove[polar]

EndExamples[]

7.4.2. AddIndices, RemoveIndices (in the first list)

1) Register the new indices in the first list of IndicesOfVBundle:

AddIndicesInFirstList[PullBackVBundle[vb_Symbol?VBundleQ,phi_],indices_]:=Module[{inds=IndicesOfVBundle[vb,phi]},
xTagSet[{vb,IndicesOfVBundle[vb,phi]},{Join[First@inds,indices],Last@inds}];
];
AddIndicesInFirstList[vbundle_Symbol?VBundleQ,indices_]:=Module[{inds=IndicesOfVBundle[vbundle]},
xUpSet[IndicesOfVBundle[vbundle],{Join[First@inds,indices],Last@inds}];
];

With this function we can add more user-chosen indices to a given vbundle.

?AddIndices

AddIndices[-vbundle_,indices_List]:=AddIndices[vbundle,UpIndex/@indices];
AddIndices[vbundle_?VBundleQ,indices_List]:=(
RegisterIndexInVBundle[#,vbundle]&/@indices;
AddIndicesInFirstList[vbundle,indices];
SetLastIndex[vbundle,{Last@indices,Last@LastIndex[vbundle]}];
If[DaggerQ[vbundle]&&!HasDaggerCharacterQ[vbundle],AddIndices[Dagger[vbundle],MakeDaggerSymbol/@indices]];
);
AddIndices[vbundle_,_]:=Throw@Message[AddIndices::unknown,"vector bundle",vbundle];
SetNumberOfArguments[AddIndices,2];
Protect[AddIndices];

2) Remove indices from the first list of IndicesOfVBundle:

RemoveIndicesInFirstList[PullBackVBundle[vb_Symbol?VBundleQ,phi_],indices_]:=Module[{inds=IndicesOfVBundle[vb,phi]},
xTagSet[{vb,IndicesOfVBundle[vb,phi]},{DeleteCases[First@inds,Alternatives@@indices],Last@inds}];
RemoveSymbol/@Intersection[indices,First@inds];
];
RemoveIndicesInFirstList[vbundle_Symbol?VBundleQ,indices_]:=Module[{inds=IndicesOfVBundle[vbundle]},
xUpSet[IndicesOfVBundle[vbundle],{DeleteCases[First@inds,Alternatives@@indices],Last@inds}];
RemoveSymbol/@Intersection[indices,First@inds];
];

This function removes user-chosen indices. This is a dangerous operation. It should be generalized to remove indices from the second list.

?RemoveIndices

RemoveIndices[vbundle_,All]:=RemoveIndices[vbundle,First@IndicesOfVBundle[vbundle]];
RemoveIndices[-vbundle_,indices_]:=RemoveIndices[vbundle,UpIndex/@indices];
RemoveIndices[vbundle_?VBundleQ,indices_List]:=Module[{vbinds},
If[DaggerQ[vbundle]&&!HasDaggerCharacterQ[vbundle],RemoveIndices[Dagger[vbundle],DaggerIndex/@indices]];
RemoveIndicesInFirstList[vbundle,indices];
vbinds=IndicesOfVBundle@vbundle;
If[vbinds==={{},{}},
SetLastIndex[vbundle],
SetLastIndex[vbundle,{Last@First@vbinds,Last@LastIndex[vbundle]}];
]
];
RemoveIndices[vbundle_,_]:=Throw@Message[RemoveIndices::unknown,"vector bundle",vbundle];
SetNumberOfArguments[RemoveIndices,2];
Protect[RemoveIndices];

3) Examples:

BeginExamples[]

DefManifold[S2,2,{a,b,c}]

AddIndices[TangentS2,{d,e}]

IndicesOfVBundle[TangentS2]

RemoveIndices[TangentS2,{d}]

?d

UndefManifold[S2]

EndExamples[]

7.4.3. NewIndexIn (in the second list)

Add a new index in the second list:

AddIndexInSecondList[vbundle:PullBackVBundle[vb_Symbol?VBundleQ,phi_],ind_]:=Module[{inds=IndicesOfVBundle[vb,phi]},
xTagSet[{vb,IndicesOfVBundle[vb,phi]},{First@inds,Append[Last@inds,ind]}];
];
AddIndexInSecondList[vbundle_Symbol?VBundleQ,ind_]:=Module[{inds=IndicesOfVBundle[vbundle]},
xUpSet[IndicesOfVBundle[vbundle],{First@inds,Append[Last@inds,ind]}];
];

The function NewIndexIn gives a new (computer-generated) index to be appended to the second list of indices of the vbundle. There is no good reason why this function is public, because it is used nowhere except for GetIndicesOfVBundle, which is the recommended user driver for index generation.

?NewIndexIn

NewIndexIn[-vbundle_]:=NewIndexIn[vbundle];
NewIndexIn[vbundle_?HasDaggerCharacterQ]:=NewIndexIn[Dagger[vbundle]];
NewIndexIn[vbundle_?VBundleQ]:=Module[{ind},
(* Decide what the next index will be *)
Label[trynext];
ind=SymbolJoin@@Prepend[LastIndex[vbundle],Context@@{First@LastIndex[vbundle]}];
Check[Catch@ValidateIndex[ind],SetLastIndex[vbundle,1];Goto[trynext]];
(* Register new index *)
RegisterIndexInVBundle[ind,vbundle];
AddIndexInSecondList[vbundle,ind];
SetLastIndex[vbundle,1];
(* Synchronize conjugate vbundle *)
If[DaggerQ[vbundle]&&!HasDaggerCharacterQ[vbundle],
With[{vbdagger=Dagger[vbundle],inddagger=MakeDaggerSymbol[ind]},
RegisterIndexInVBundle[inddagger,vbdagger];
AddIndexInSecondList[vbdagger,inddagger];
SetLastIndex[vbdagger,{LastIndex[vbdagger][[1]],LastIndex[vbundle][[2]]}];
]
];
(* Return new index *)
ind
];
NewIndexIn[vbundle_]:=Message[NewIndexIn::unknown,"vector bundle",vbundle];
SetNumberOfArguments[NewIndexIn,1];
Protect[NewIndexIn];

BeginExamples[]

DefManifold[S2,2,{a,b,c,d,e}]

NewIndexIn[TangentS2]

?TangentS2

?e1

UndefManifold[S2]

EndExamples[]

7.4.4. GetIndicesOfVBundle

GetIndicesOfManifold gives n indices of a vbundle, checking that they do not belong to a given list. This is just a “multiplicity driver” for NewIndexIn.

?GetIndicesOfVBundle

GetIndicesOfVBundle[vbundle_,number_]:=GetIndicesOfVBundle[vbundle,number,{}];
GetIndicesOfVBundle[vbundle_,number_,list_IndexList]:=GetIndicesOfVBundle[vbundle,number,List@@list];
GetIndicesOfVBundle[-vbundle_,number_,list_List]:=GetIndicesOfVBundle[vbundle,number,list];
GetIndicesOfVBundle[vbundle_?VBundleQ,number_Integer?NonNegative,list_List]:=Module[{ind,output},
output=Complement[Flatten@IndicesOfVBundle@vbundle,list];
While[Length[output]<number,
ind=NewIndexIn[vbundle];
If[FreeQ[list,ind],AppendTo[output,ind]]
];
output[[Range[number]]]];
GetIndicesOfVBundle[_,_,list_/;Head[list]=!=List]:=Throw@Message[GetIndicesOfVBundle::invalid,list,"list of indices"];
GetIndicesOfVBundle[_Symbol?VBundleQ,number_,_List]:=Throw@Message[GetIndicesOfVBundle::invalid,number,"nonnegative integer"];
GetIndicesOfVBundle[vbundle_,_,_List]:=Throw@Message[GetIndicesOfVBundle::invalid,vbundle,"vector bundle"];
SetNumberOfArguments[GetIndicesOfVBundle,{2,3}];
Protect[GetIndicesOfVBundle];

BeginExamples[]

DefManifold[S2,2,{a,b,c,d,e}]

GetIndicesOfVBundle[TangentS2,6,{d,e1,e3}]

?TangentS2

GetIndicesOfVBundle[]
GetIndicesOfVBundle[1]
GetIndicesOfVBundle[1,2,3,4]

UndefManifold[S2]

?S2

EndExamples[]

7.5. Examples

BeginExamples[]

$Manifolds

Checks of possible errors:

DefManifold[]

DefManifold[1]

Catch@DefManifold[MM,2,{}]

Catch@DefManifold[a+b,3,{a,b}]

Catch@DefManifold[MM,{a+b},{a,b}]

QUESTION: Why are these not errors anymore?

DefManifold[1,2]

Catch@DefManifold[1,{},3]

Catch@DefManifold[MM,1,A]

Valid cases, the first with capital-letter indices:

DefManifold[M2,2,{A,B,C,D,F,G,H,J,K,L,M}]

$ContextPath

UndefManifold[M2]

Remove[f,x]

Reconstruct M2 again:

DefManifold[M2,2,{A,B,C,D,F,G,H,J,K,L,M}]

All information about M2:

?M2

and its tangent manifold:

?TangentM2

The indices are now stored in $AbstractIndices:

$AbstractIndices

We generate a new index M1:

LastIndex[TangentM2]

NewIndexIn[TangentM2]

LastIndex[TangentM2]

Now we cannot generate index M2 because M2 is a manifold. We get M3:

NewIndexIn[TangentM2]

LastIndex[TangentM2]

?TangentM2

Trace[TangentM2`Q[M3]]

Trace[TangentM2`Q[-M3]]

The M`Q functions do not recognize basis indices:

TangentM2`Q[{M3}]

GetIndicesOfVBundle[TangentM2,17]

Length[%]

?TangentM2

NewIndexIn[TangentM2]

?TangentM2

DefManifold[S2,2,{a,b,c,d,e,f,g,h,i,j,k,l,m}]

?a

DefManifold[Mprod,{M2,S2},{alpha,beta,mu,nu,sigma,lambda,rho,eta}]

Catch@DefManifold[Mother,{M3,M2,S2},{Alpha,Beta}]

Interrogate manifolds as contexts concerning their two associated functions:

?TangentM2`*

?Mprod

?TangentMprod

?eta

$AbstractIndices

$Manifolds

$VBundles

DisjointManifoldsQ[M2,S2]

DisjointManifoldsQ[Mprod,S2]

DisjointManifoldsQ[{M2,S2},Mprod]

UndefManifold[Mprod]

??TangentMprod

??Mprod

$Manifolds

$ProductManifolds

$VBundles

$SumVBundles

Catch@UndefManifold[Mother]

IndicesOfVBundle[M1,M2]

Catch@IndicesOfVBundle[M1]

DefManifold[N2,2,{P,Q}]

DefConstantSymbol[DIM,PrintAs->"d"]

DefManifold[Ms,DIM,{p,q}]

?Ms

?TangentMs

Remove[MM,Mother,Alpha]

$Manifolds

Catch@DefManifold[Mstrings,{"r","theta","phi"},{as,bs,cs,ds,es}]

?Mstrings

Remove[Mstrings,as,bs,cs,ds,es]

$Manifolds

Now we check the Dagger options:

DefVBundle[Fiber,S2,3,{𝔄,𝔅,ℭ,𝔇,𝔈},Dagger->Real]

?Fiber

NewIndexIn[Fiber]

?𝔈1

GetIndicesOfVBundle[Fiber,10]

AddIndices[Fiber,{𝔉,𝔊}]

GetIndicesOfVBundle[Fiber,20]

RemoveIndices[Fiber,{𝔇,𝔉}]

?𝔇

?𝔉

IndicesOfVBundle[Fiber]

UndefVBundle[Fiber]

DefVBundle[Fiber,S2,3,{𝔄,𝔅,ℭ,𝔇,𝔈},Dagger->Complex]

?Fiber

?Fiber†

NewIndexIn[Fiber]

GetIndicesOfVBundle[Fiber,10]

IndicesOfVBundle[Fiber]

IndicesOfVBundle[Fiber†]

?𝔈4

?𝔈4†

AddIndices[Fiber,{𝔉,𝔊}]

?𝔉

?𝔉†

GetIndicesOfVBundle[Fiber,20]

RemoveIndices[Fiber,{𝔇,𝔉}]

IndicesOfVBundle[Fiber]

IndicesOfVBundle[Fiber†]

?𝔇

?𝔉

?𝔇†

?𝔉†

UndefVBundle[Fiber]

UndefManifold[S2]

UndefManifold[N2]

UndefManifold[Ms]

UndefManifold[M2]

UndefConstantSymbol[DIM]

$Manifolds

EndExamples[]

8. Index formatting

(**************************** 8.Formatting ****************************)

{TimeUsed[],SessionTime[],TimeUsed[]/SessionTime[]}

8.0. Comments

This section is essentially a simple working proposal. There are three objectives:
	- Conversion to LATEX
	- Cut and pasting
	- Possibility of walking through the indices of an expression with the cursor (this is less important).

If[$ReadingVerbose,Print["Reading section 8: Formatting."],Null,Null]

Study this (note that several of them are xTensor symbols):

?*Form*

8.1. Formatting of a single index

8.1.1. CIndexForm and $CIndexForm

The global variable $CIndexForm decides whether coordinate-indices are written using the corresponding number (the default) or the name of the coordinate.

?$CIndexForm

$CIndexForm=False;
(* Treat dual indices in the same way *)
CIndexForm[ind_Integer,-basis_]:=CIndexForm[ind,basis];
CIndexForm[ind_Integer,chart_?ChartQ]:=If[$CIndexForm,With[{c=xAct`xCoba`Coordinate[ind,chart]},PrintAs[c]],ToString[ind]];
CIndexForm[ind_Integer,basis_]:=ToString[ind];

8.1.2. IndexForm

IndexForm is an important function because it essentially contains the formatting of indices in StandardForm. This means that the functions defined here will be used last, when little control can be exerted. In other words, errors coming from these functions are very difficult to debug. For the same reasons, errors cannot be thrown, only sent. Hence, we must try to make them as simple and independent as possible. It is now a public function, but we recommend not to interfere with it. If the user wants to change the output of a particular *abstract* index, this can be easily and safely done changing the PrintAs definition for that index.

This function is the essential driver that gives the string corresponding to each kind of index. It is very important to note that we assume that we are supplying an index, without any reference to its up/down character: It always returns a string, which can have any length.

?IndexForm

(* Throw error if a minus is received. This should never happen *)
IndexForm[-x_]:=(Message[IndexForm::nouse,"IndexForm",-x];PrintAs[-x]);
(* Directional index. Long expressions give # *)
IndexForm[Dir[v_?xTensorQ[_]]]:=PrintAs[v];
IndexForm[Dir[v_]]:="#";
(* Labels. Use PrintAs again *)
IndexForm[LI[]]:=" ";
IndexForm[LI[x_]]:=PrintAs[x];
IndexForm[LI[x__]]:=Apply[StringJoin,PrintAs/@{x}];
(* Component index. Color according to basis *)
IndexForm[{ind_Integer,basis_}]:=ColorString[CIndexForm[ind,basis],xAct`xCoba`BasisColor[basis]]; (* BASIS1 *);
IndexForm[basis_?BasisQ[ind_Integer]]:=ColorString[CIndexForm[ind,basis],xAct`xCoba`BasisColor[basis]]; (* BASIS2 *);
(* Basis index. Color according to basis *)
IndexForm[{ind_,basis_}]:=ColorString[IndexForm[ind],xAct`xCoba`BasisColor[basis]]; (* BASIS1 *);
IndexForm[basis_?BasisQ[ind_]]:=ColorString[IndexForm[ind],xAct`xCoba`BasisColor[basis]]; (* BASIS2 *);
(* QUESTION: What happens for general index modifiers ? *)
(* Pattern or PatternTest index. Underline. PINDEX *)
IndexForm[ind_PatternTest]:=Underline[IndexForm[First[ind]]];
IndexForm[ind_Pattern]:=Underline[IndexForm[First[ind]]];
(* Blank family. Use an underscore as suggested by Thomas *)
IndexForm[ind_Blank]:="_";
IndexForm[ind_BlankSequence]:="_";
IndexForm[ind_BlankNullSequence]:="_";
(* Abstract index *)
IndexForm[ind_Symbol]:=PrintAs[ind];
(* Derivative in Postfix notation *)
IndexForm[ind_,der_]:=First[SymbolOfCovD[der]]<>IndexForm[ind];
(* Projected indices *)
IndexForm[ind_,Null]:=IndexForm[ind];
IndexForm[ind_,Null,{_,delta}]:=IndexForm[ind];
IndexForm[ind_,der_,{_,delta}]:=IndexForm[ind,der];
IndexForm[ind_,Null,{xAct`xTensor`Up,proj_}]:=StringJoin["\!\(",IndexForm[ind],"\&",PrintAsSmaller[proj],"\)"]
IndexForm[ind_,Null,{xAct`xTensor`Down,proj_}]:=StringJoin["\!\(",IndexForm[ind],"\+",PrintAsSmaller[proj],"\)"];
IndexForm[ind_,der_,pr_]:=First[SymbolOfCovD[der]]<>IndexForm[ind,Null,pr];
(* List of indices (with head IndexList) *)
IndexForm[list_IndexList]:=Apply[StringJoin,IndexForm/@list];
(* Slots *)
IndexForm[ind_Slot]:=ToString[ind];
IndexForm[ind_SlotSequence]:=ToString[ind];
(* Any other case *)
IndexForm[x_]:=(Message[IndexForm::nouse,"IndexForm",ToString[x],$WarningFrom];ToString[x]);
SetNumberOfArguments[IndexForm,{1,2}];
Protect[IndexForm];

8.1.3. Examples

BeginExamples[]

IndexForm[i]//FullForm

IndexForm[i_]

IndexForm[i_?M3`Q]

IndexForm[a+b]

xAct`xCoba`BasisColor[polar]^=RGBColor[1,0,0];
xAct`xCoba`BasisColor[-basis_]=xAct`xCoba`BasisColor[basis];

IndexForm[{1,polar}]

IndexForm[{A,polar}]

IndexForm[{A†,polar}]

IndexForm[Dir[a+b+c]]

Check of CIndexForm:

$CIndexForm=True;

ChartQ[polar]^=True;
xAct`xCoba`Coordinate[1,polar]="h";

IndexForm[{1,polar}]

Clear up:

xAct`xCoba`Coordinate[1,polar]=.

Remove[polar,A†,basis]

$CIndexForm=False;

Remove[a,A,b,c,i]

EndExamples[]

8.1.4. Special formattings

This function has been provided by Thomas, to have daggered indices formatted with primes instead of daggers, using SetOptions[DefAbstractIndex, PrintAs -> PrimeDagger]:

PrimeDagger[ind_]:=If[DaggerIndexQ@ind,StringJoin[StringDrop[ToString@ind,-StringLength@$DaggerCharacter],"'"],ind];

8.2. Formatting of a sequence of indices

8.2.1. IndexPair

This function controls the horizontal space that is given to each index: one space to normal indices and two spaces to derivatives (Postfix) indices. It uses UpIndex, what could be a source of problems (that is why we mark the $WarningFrom global variable). The pair IndexPair / UpIndexPair is introduced to avoid using UpIndex twice:

IndexPair[ind_,other___]:=Block[{$WarningFrom="Index Formatting"},UpIndexPair[ind,UpIndex[ind],other]];
(* Standard index *)
UpIndexPair[upind_,upind_]:={blanks[IndexLength[upind]],IndexForm[upind]};
UpIndexPair[downind_,upind_]:={IndexForm[upind],blanks[IndexLength[upind]]};
(* Derivative index in Postfix notation *)
UpIndexPair[upind_,upind_,der_]:={blanks[IndexLength[upind,der]],IndexForm[upind,der]};
UpIndexPair[downind_,upind_,der_]:={IndexForm[upind,der],blanks[IndexLength[upind,der]]};
(* Projected index *)
$ProjectedFormat=True;
UpIndexPair[upind_,upind_,der_,proj_]:=If[$ProjectedFormat||proj===delta,{blanks[IndexLength[upind,der]],IndexForm[upind,der,{xAct`xTensor`Up,proj}]},{ColorString[PrintAs[proj],GrayLevel[0.6]],IndexForm[upind,der]}];
UpIndexPair[downind_,upind_,der_,proj_]:=If[$ProjectedFormat||proj===delta,{IndexForm[upind,der,{xAct`xTensor`Down,proj}],blanks[IndexLength[upind,der]]},{IndexForm[upind,der],ColorString[PrintAs[proj],GrayLevel[0.6]]}];
(* Printing length of an index *)
IndexLength[upind_BlankSequence]:=1;
IndexLength[upind_BlankNullSequence]:=1;
(* This is inconvenient with indices containing linear syntax, like pullback indices
IndexLength[upind_]:=Length@Characters@ToString@PrintAs@IndexName[upind];*)
IndexLength[upind_]:=1;
IndexLength[upind_,Null]:=IndexLength[upind];
(* This is inconvenient with StyleBox[...]
DerSymbolLength[symbol_String]:=Length@Characters[symbol]*)
DerSymbolLength[symbol_String]:=1;
IndexLength[upind_,der_]:=IndexLength[upind]+DerSymbolLength[First@SymbolOfCovD[der]];
blanks[length_]:=StringJoin@@Table[" ",{length}];
(* New simpler formatting
blanks[__]:=" ";
*)

8.2.2. AddIndex

The function AddIndex gets the couple {downstring,upstring} and adds an index to the corresponding string and space(s) to the other.

Special case for multiple-index derivatives. Put derivative sign together with the first index only :

AddIndex[strings_List,IndexList[a_,b___],der_]:=Fold[AddIndex,AddIndex[strings,a,der],IndexList[b]];

General case:

AddIndex[{downstring_String,upstring_String},ind__]:={downstring<>#1,upstring<>#2}&@@IndexPair[ind];

8.2.3. Examples

Examples:

BeginExamples[]

xATP`IndexPair[A]

xATP`IndexPair[-A]

xATP`IndexPair[A$10]

xATP`IndexPair[-A$10]

xATP`IndexPair[-C_]

xATP`AddIndex[{"A "," B"},-C_]

xATP`AddIndex[{"A "," B"},-C_]

SymbolOfCovD[Cd]^={";","∂"};

xATP`AddIndex[{"A  "," BC"},D_,Cd]

InputForm[%]

xATP`AddIndex[{"A  "," BC"},D_,Cd]

InputForm[%]

xATP`AddIndex[{"A  "," BC"},IndexList[D,F,G],Cd]

SymbolOfCovD[Cd]^=Null;

xTensorQ[v]^=True;

xATP`AddIndex[{"A "," B"},Dir[v[A]]]

xATP`AddIndex[{"A "," B"},Dir[v[-A]]]

SymbolOfCovD[Cd]^={ColorString["¸",Hue[0]],ColorString["▽",Hue[0]]}

xAct`xCoba`BasisColor[polar]^=RGBColor[0,1,0];

xATP`AddIndex[{"A "," B"},{C,polar}]

xATP`AddIndex[{"A "," B"},{2,-polar}]

xATP`AddIndex[{"A  "," BC"},{D,polar},Cd]

xATP`AddIndex[{"A  "," BC"},{D_,polar},Cd]

Remove[polar,Cd,v,A$10,F,G]
EndExamples[]

In summary, the only problem that (I think) there could be here is a problem coming from UpIndex/DownIndex acting on patterns without a definite height (for instance x_); we issue a warning in that case.

8.3. Screening of dollar-indices

8.3.1. Definitions

Indices do not change their up/down character.

We separate the process in several steps. This should be simplified somehow:

1. This function gives all indices (actually their names) involved in the original expression, after eliminating their up/down character and their Pattern character. We eliminate labels, blanks, integer-basis indices and directions (g-indices with name 0). All other indices must be kept in order to make sure that we do not introduce new indices with names already in use. Note that the argument has a BlankSequence. This is to make sure that the same dollar-index in different expressions is mapped to the same index. Expressions are held. Indices are sorted lexicographically (using Sort through Union). Flatten is there to eliminate braces in {exprs}. IndexName gives only 0s and symbols or -symbols; then the 0s are deleted and therefore there are no problems using UpIndex. Recall that IndexName on {a,basis} gives a: and on a_ gives a.

SetAttributes[screenindices,HoldAll];
screenindices[exprs__]:=Union[UpIndex/@DeleteCases[IndexName/@Join@@(FindIndices/@Unevaluated[{exprs}]),0]]

2. This function gives the replacing rules for the dollar-indices of the list, both up/down cases. At this point we assume that the list of indices only contains abstract up-indices (no patterns, basis indices, labels or directions) and therefore there are no problems coming from DollarQ. This function is highly recursive. Probably it can be rewritten without recursion.

screenrules[indices_IndexList]:=screenrules[indices,Select[indices,DollarQ]];
screenrules[indices_,dollarindices_]:=screenrules[Complement[indices,dollarindices],dollarindices,{}];
screenrules[used_,IndexList[],rules_]:=rules;
getindex[index_,used_]:=First@GetIndicesOfVBundle[VBundleOfIndex[index],1,List@@used];
screenrules[used_,IndexList[index_,indices___],rules_]:=screenrules[used,IndexList[indices],rules,index,getindex[index,used]];screenrules[used_,indices_,rules_,index_,newindex_]:=screenrules[Append[used,newindex],indices,Join[rules,{index->newindex,-index->-newindex}]];

3. Recursion on isolated expressions  (QUESTION: what can we do with the ScalarFunctions?):

MapOnIsolated[expr_,f_]:=EvaluateHeld[EvaluateHeld[RecursiveIsolated[expr,f],RecursiveIsolated],f];

The Unevalutated here is useless because the expression has been already evaluated by RecursiveIsolated.

RecursiveIsolated[expr_,f_]:=Unevaluated[expr]/.{
LieD[v_][x_]:>LieD[RecursiveIsolated[f[v],f]][RecursiveIsolated[x,f]],
Scalar[v_]:>Scalar[RecursiveIsolated[f[v],f]],
Dir[v_]:>Dir[RecursiveIsolated[f[v],f]],
Bracket[v1_,v2_]:>Bracket[RecursiveIsolated[f[v1],f],RecursiveIsolated[f[v2],f]]};

It might happen that the mapped function f gets into some held arguments and does not evaluate. We force evaluation with the function

EvaluateHeld[expr_,f_]:=xEvaluateAt[expr,Drop[#,-1]&/@Position[expr,f]];

A similar function to collect all isolated expressions (again, not arguments of ScalarFunctions). Using the argument f we can avoid evaluation:

SetAttributes[ExtractIsolated,HoldFirst];
ExtractIsolated[expr_,f_]:=Join[ExtractIsolated[expr,f,LieD],ExtractIsolated[expr,f,Dir],ExtractIsolated[expr,f,Scalar],ExtractIsolated[expr,f,Bracket]];
next[{list___,0}]:={list,1};
ExtractIsolated[expr_,f_,head:(LieD|Dir|Scalar)]:=Extract[Hold[expr],next/@Position[Hold[expr],head],f];
next2[{list___,0,0}]:=Sequence[{list,0,1},{list,0,2}];
ExtractIsolated[expr_,f_,Bracket]:=Extract[Hold[expr],next2/@Position[Hold[expr],Bracket],f];

4. Final function. It is listable and threaded over Plus, to avoid generating lots of new indices with long expressions, and also Equal (as required by Alfonso). That assumes that free indices are never dollar-indices!

SetAttributes[ScreenDollarIndices,Listable]

ScreenDollarIndices[ScreenDollarIndices]:=ScreenDollarIndices;

ScreenDollarIndices[InformationData[assoc_,rest___]]:=InformationData[ScreenDollarIndices[assoc],rest];

ScreenDollarIndices[expr_Plus]:=ScreenDollarIndices/@expr;
ScreenDollarIndices[HoldPattern[SeriesData[var_,orig_,coeffs_,rest__]]]:=SeriesData[ScreenDollarIndices[var],ScreenDollarIndices[orig],ScreenDollarIndices/@coeffs,rest];
ScreenDollarIndices[Equal[lhs_,rhs_]]:=Equal[ScreenDollarIndices[lhs],ScreenDollarIndices[rhs]];

We include this particular case to avoid screening of the output of Trace:

ScreenDollarIndices[x_HoldForm]:=x

Note that the argument of ScreenDollarIndices is assumed to be already evaluated. Note also that ScreenDollarIndices does not use SameDummies at the beginning: it is just a 1-1 translation of dollar-indices to nondollar-indices.

ScreenDollarIndices[expr_]:=Block[{$WarningFrom="ScreenDollarIndices"},MapOnIsolated[ReplaceIndex[expr,screenrules@screenindices[expr]],ScreenDollarIndices]
];

SetNumberOfArguments[ScreenDollarIndices,1];
Protect[ScreenDollarIndices];

It is not convenient to set a Hold attribute for ScreenDollarIndices because it would not evaluate its argument. ScreenDollarIndices is always used on the final (already evaluated) output, and therefore it is reasonable to assume that the input cannot be further evaluated.

QUESTION: Is it more natural to assing ScreenDollarIndices to $PrePrint or to $PostPrint? Currently we recommend the use of $PrePrint.

??ScreenDollarIndices

Something which can happen is that after screening of dollar-indices the expression can be further evaluated. This is annoying, but I can't help it.

8.3.2. Examples

BeginExamples[]

DefManifold[M,4,{A,B,C,D,F,G,H,J}]

xATP`screenrules[IndexList[A,B,F$,H$,J,F]]

ScreenDollarIndices[]

ScreenDollarIndices[1,2]

ScreenDollarIndices[1]

xTensorQ[T]^=True;
CovDQ[Cd]^=True;

DefManifold[MM,3,IndexRange[a,q]]

$AbstractIndices

ScreenDollarIndices[T[i$,k$,l$,-l$]:>Module[{j$},T[i$,j$,-j$,k$]]]

ScreenDollarIndices[T[Dir[T[i$,-i$,z]],i$,k$,{l$,polar},{-l$,-polar}]:>Module[{j$},T[i$,{j$,polar},{-j$,-polar},k$]]]

ScreenDollarIndices[T[i$,k$,l$,-l$]:>Module[{j$},LieD[T[z,a$]T[-a$]][T[i$,j$,-j$,k$]]]]

ScreenDollarIndices[HoldPattern[T[B$1_,-B$1_,B$]]:>Module[{A$},T[A$,-A$,B$]]]

ScreenDollarIndices[HoldPattern[T[{B$1_,basis_},{-B$1_,-basis_},B$]]:>Module[{A$},T[A$,-A$,B$]]]

ScreenDollarIndices[HoldPattern[T[i$,k$,l$,-l$]]:>Module[{j$},T[i$,j$,-j$,k$]]]

ScreenDollarIndices[T[i$,k$,l$,-l$]:>ReplaceDummies[T[i$,j$,-j$,k$]]]

Note that the new indices in the first and second elements are completely independent:

{Cd[-f$][T[B$101,-A$1,-A$0,a$,b,c$]],Cd[-f$][T[-A$1,-A$2,-B$]]}//ScreenDollarIndices

RuleDelayed[T[B101,a,c$,-c$,-a],Module[{C$,D$},T[B101,-D$,-C$,D$,C$]]]//ScreenDollarIndices

RuleDelayed[T[B101,a,c$,-c$,-a],T[B101,-C$,-B$,C$,B$]]//ScreenDollarIndices

DefManifold[N2,2,{P,Q}]

?N2

T[P$1,-P$1,P$2,-P$2,P$3,-P$3,P$4,-P$4,P$5,-P$5]//ScreenDollarIndices

$AbstractIndices

UndefManifold/@{N2,MM,M};

Remove[B101,Cd,polar,T,basis]

Remove[a$,A$,A$0,A$1,A$2,B$,B$1,B$101,c$,C$,D$,f$,F$,H$,i$,j$,k$,l$,P$1,P$2,P$3,P$4,P$5,z,Z]

EndExamples[]

9. Tensors

(****************************** 9.Tensors *****************************)

{TimeUsed[],SessionTime[],TimeUsed[]/SessionTime[]}

9.0. Comments

Currently in xTensor we are trying to manipulate simultaneously five orthogonal generalizations of normal tensors on a manifold:
	- Gauge inner vbundles,
	- Complex tensors,
	- Product vbundles,
	- Induced vbundles,
	- Pullback vbundles.
I'm not sure any combination of those is correctly implemented. Probably not.

If[$ReadingVerbose,Print["Reading section 9: Tensors."],Null,Null]

9.1. Orthogonality with respect to a vector

9.1.1. Explicit orthogonality to a vector: SetOrthogonal

With SetOrthogonal (a public function) we create an orthogonality rule (or several of them). Note that we use the option MetricOn on all indices and not only on the contracted index. This option will only have effect if there is a metric in the vbundle of index, because MakeRule has a MetricEndowedQ check. There are four checks in this function:
	1.- The rule is not already defined (do nothing otherwise).
	2.- The index of vector[index] is an abstract index (throw an error otherwise).
	3.- The index can be contracted (throw an error otherwise).
	4.- The rule has been correctly implemented (send a message otherwise).
Checks 2 and 3 are performed with checkSetOrthogonal.
When the orthogonality is on all indices, we store the information in OrthogonalToVectorQ, which is a totally independent function.

checkSetOrthogonal[list_,index_]:=Which[
!AIndexQ[index],Throw@Message[DefTensor::error,"Index of orthogonal vector must be abstract."],
FreeQ[list,ChangeIndex@index],Throw@Message[DefTensor::error,"Index of orthogonal vector cannot be contracted."],
True,Null];

?SetOrthogonal

DefTensor::noorth="Tensor `1` could not be made orthogonal to vector `2`.";

(* Orthogonality in all indices of tensor. Assume there is a metric *)
SetOrthogonal[tensor_?xTensorQ[AnyIndices[vbundle_?VBundleQ]],vector_?xTensorQ]:=With[{vbQ=VBundleIndexQ[vbundle],i=DummyIn[vbundle]},
xTagSetDelayed@@Hold[{tensor, tensor[___,i_,___]vector[-i_?vbQ]},0];
xTagSetDelayed@@Hold[{tensor, tensor[___,-i_?vbQ,___]vector[i_]},0];
xUpSet[OrthogonalToVectorQ[vector][tensor],True];
];
SetOrthogonal[tensor_?xTensorQ[inds___],vector_?xTensorQ]:=(Map[SetOrthogonal[tensor[inds],vector[#]]&,Map[ChangeIndex,Select[IndexList[inds],AIndexQ]]];
xUpSet[OrthogonalToVectorQ[vector][tensor],True];
);
(* Orthogonality in a given index *)
SetOrthogonal[tensor_?xTensorQ[inds___],vector_?xTensorQ[index_]]:=If[tensor[inds] vector[index]=!=0,
checkSetOrthogonal[IndexList[inds],index];
AutomaticRules[tensor,MakeRule[{tensor[inds]vector[index],0},MetricOn->All,ContractMetrics->True],Verbose->False];
If[tensor[inds]vector[index]=!=0,Message[DefTensor::noorth,tensor[inds],vector[index]]]
];
SetNumberOfArguments[SetOrthogonal,2];
Protect[SetOrthogonal];

9.1.2. Explicit projections with a projector: SetProjected

This is a parallel function SetProjected to set projection rules. Note that MakeRule has a HoldFirst attribute and hence we need Evaluate in order to get the computed value of newtensor. Note also that Evaluate must be directly under MakeRule and not deeper because otherwise it wouldn't get evaluated. Note the strange If condition; this is to ensure that the product tensor[inds]projector[i1,i2] does not evaluate already to something else. We also need to consider both possibilities of ordering the projector and the tensor.

checkSetProjected[list_,IndexList[i1_,i2_]]:=Which[
!AIndexQ[i1]||!AIndexQ[i2],Throw@Message[DefTensor::error,"Indices of projector must be abstract."],
Sort[{Length@TakeEPairs@Append[list,i1],Length@TakeEPairs@Append[list,i2]}]=!={0,2},Throw@Message[DefTensor::error,"One and only one pair of indices must be contracted to project a tensor."],
True,Null];

?SetProjected

Here we are assuming that we can attach definitions to the main head of the tensor.

SetProjected[tensor_?xTensorQ[AnyIndices[vbundle_?VBundleQ]],projector_?xTensorQ]:=With[{vbQ=VBundleIndexQ[vbundle],i=DummyIn[vbundle],j=DummyIn[vbundle]},
xTagSetDelayed@@Hold[{tensor,tensor[left___,i_,right___]projector[-i_,j_]},tensor[left,j,right]];
xTagSetDelayed@@Hold[{tensor,tensor[left___,-i_,right___]projector[i_,j_]},tensor[left,j,right]];
xTagSetDelayed@@Hold[{tensor,tensor[left___,i_,right___]projector[j_,-i_]},tensor[left,j,right]];
xTagSetDelayed@@Hold[{tensor,tensor[left___,-i_,right___]projector[j_,i_]},tensor[left,j,right]];
];
SetProjected[tensor_?xTensorQ[inds__],projector_?xTensorQ]:=SetProjected[tensor[inds],projector[DummyAs[#],ChangeIndex[#]]]&/@Select[IndexList[inds],AIndexQ];
SetProjected[tensor_?xTensorQ[inds__],projector_?xTensorQ[i1_,i2_]]:=Module[{product=tensor[inds]projector[i1,i2],newtensor},
checkSetProjected[IndexList[inds],IndexList[i1,i2]];
If[product===Unevaluated[tensor[inds]projector[i1,i2]]||product===Unevaluated[projector[i1,i2]tensor[inds]],
newtensor=ReplaceIndex[tensor[inds],{-i1->i2,-i2->i1}];
AutomaticRules[tensor,MakeRule[Evaluate@{tensor[inds]projector[i1,i2],newtensor},MetricOn->All,ContractMetrics->True],Verbose->False]]
];
SetNumberOfArguments[SetProjected,2];
Protect[SetProjected];

9.1.3. Implicit orthogonality to a vector: OrthogonalToVectorQ

Orthogonality to vectors. This private function is used with two different notations. First on tensor names: we use remembered values (but not upvalues). Then we can have it acting on general expressions. It checks that tensor is orthogonal to vector in ALL its indices (of tensor or expression). The same double notation is possible in SetOrthogonal, and hence SetOrthogonal sets OrthogonalToVectorQ if there is orthogonality in all indices. I thank Cyril and Thomas for various improvements in this function. Cyril has suggested implementing some sort of linearity, which might accelerate checks, but it feels unnecessary and strictly speaking it is not general because v could be orthogonal to w1+w2 without being orthogonal to any of them.

(* Tensor names. Incompatible with the use of variable-rank tensors *)
OrthogonalToVectorQ[vector_][tensor:(delta|Gdelta|Basis)]:=Throw@Message[DefTensor::nouse,"OrthogonalToVectorQ",tensor];
OrthogonalToVectorQ[vector_][tensor_?xTensorQ]:=xUpSet[
OrthogonalToVectorQ[vector][tensor],
Module[{inds=SlotsOfTensor[tensor]},
If[MemberQ[inds,AnyIndices[_]],
Throw@Message[OrthogonalToVectoQ::error,"Cannot decide orthogonality to the variable-rank tensor "<>ToString[tensor]],
inds =DummyIn/@inds;
OToVcheck[vector,tensor@@inds,Select[inds,EIndexQ]]
]
]
];
(* TensorDerivative with induced derivatives. Contributed by Cyril *)
OrthogonalToVectorQ[vector_][TensorDerivative[tensor_?xTensorQ,ders___,covd_Symbol?InducedCovDQ][inds___,ind_]]:=Last@InducedFrom@MetricOfCovD@covd===vector&&OrthogonalToVectorQ[vector][TensorDerivative[tensor,ders][inds]];
OrthogonalToVectorQ[vector_][TensorDerivative[tensor_?xTensorQ,ders___,LieD[vector_[i_]]][inds___]]:=With[{tensor1=TensorDerivative[tensor,ders]},OrthogonalToVectorQ[vector][tensor1[inds]]&&(IndicesOf[Free,xAct`xTensor`Up][tensor1@@(DummyIn/@SlotsOfTensor[tensor1])]===IndexList[] || LieD[vector[i]][vector[-i]]===0)];
(* General expressions. QUESTION: Why does the general definition look only at the free indices? *)
OrthogonalToVectorQ[vector_][tensor_?xTensorQ[inds___]]:=OrthogonalToVectorQ[vector][tensor];
OrthogonalToVectorQ[vector_][LieD[vector_?xTensorQ[i_]][expr_]]:=OrthogonalToVectorQ[vector][expr]&&(IndicesOf[Free,xAct`xTensor`Up][expr]===IndexList[]||LieD[vector[i]][vector[-i]]===0);
OrthogonalToVectorQ[vector_][expr_]:=With[{uexpr=UxSort[expr]},OToVcheck[vector,uexpr, List@@FindFreeIndices[uexpr]]];
(* Actual check *)
OToVcheck[vector_,expr_,inds_List]:=And@@Map[ContractMetric@GradNormalToExtrinsicK[#]===0&,expr (vector/@ChangeIndex/@Select[inds,EIndexQ])];
(* Variant added by Thomas *)
HasOrthogonalIndexQ[expr_,vector_[ind_]]:=And[MemberQ[FindFreeIndices[expr],-ind,1],OToVcheck[vector,expr,{-ind}]]

Protect[OrthogonalToVectorQ];

QUESTION: How do we know that the list of indices in the OToV check only has abstract indices? What would happen otherwise?

Some comments from Cyril. I'm not sure they are still applicable:

I only had to add these rules to xTensor.m so that it could work fine:

OrthogonalToVectorQ[vector_][expr1_  expr2_] := OrthogonalToVectorQ[vector][expr1] && OrthogonalToVectorQ[vector][expr2];
OrthogonalToVectorQ[vector_][expr1_  + expr2_] := OrthogonalToVectorQ[vector][expr1] && OrthogonalToVectorQ[vector][expr2];

Indeed, when you have an expression of the type T[a,b,c] S[-b,d], the current OrthogonalToVectorQ will not know how to deal with it
and will use OtoVCheck, which basically contracts with the vector n normal to the hypersurfaces. If the tensor T is not orthogonal in its c index, but only in its a,b indices then OrthogonalToVectorCheck will say “True”. But then it will apply Leibniz rule, and the projecetd derivative will act directly on T[a,b,c], leading to an error “Error : Indices derivative acts on non projected expression”. I must say this happens to me when my tensor is a Lie derivative, but still, I think that is the way OrthogonalTOVectorCheck should work. Protect for Leibniz rule and linearity.

9.2. Definition

9.2.1. Tensor checks

0) Temporal definition for this notebook, just for checking:

AutomaticRules[x___]:=Print[ToString[{x}]];

1) This function is used when the tensor is vanishing. We temporarily eliminate the RuleDelayed::rhs message because it complains about having a pattern on the rhs. This is not an error, it is just a warning message.

Off[RuleDelayed::rhs];
(* PINDEX *)
makepattern[a_Symbol]:=Pattern[a,Blank[]];
makepattern[-a_Symbol]:=makepattern[a];
makepattern[a_]:=a;
On[RuleDelayed::rhs];

2) A simple function which converts bundles into their base manifolds. It is also a filter of the possible dependencies a tensor can have:

baseifbundle[manifold_?ManifoldQ]:=manifold;
baseifbundle[param_Symbol?ParameterQ]:=param;
baseifbundle[vbundle_?VBundleQ]:=BaseOfVBundle[vbundle];
baseifbundle[x_]:=Throw@Message[DefTensor::unknown,"dependency",x];

3) Three particular error messages:

DefTensor::wrongsym="Symmetry properties are inconsistent with indices of tensor.";
DefTensor::nodummy="Tensor cannot be defined with dummy indices.";
DefTensor::zero="Symmetry makes tensor zero. Use VanishingQ instead.";

4) Check indices:

DefTensorCheckIndices[indices___]:=
Module[{},
(* Only types A and L are accepted *)
If[Not[AIndexQ[#]||LIndexQ[#]],Throw@Message[DefTensor::invalid,#,"index at definition"]]&/@{indices};
(* If we accept a single index for Dim1 spaces then we need to delete that index from the list in this check *)
If[TakeEPairs@IndexList[indices]=!=IndexList[],Throw@Message[DefTensor::nodummy]]
];

4) Main checks. Comments:
	- There is a check of type A or L for the input indices. Therefore we can use either of upQ or UpIndexQ.
	- Dagger->Complex is valid independently of whether all indices are real or not, but it has different meanings: if all indices are real we are complexifying the tensor space, but if they are not we are constructing a tensor on the conjugated vector space. Perhaps we should use different names (Complexified and Complex respectively, for example), but there is no possible confusion right now.
	- If the tensor has variable rank then we do not implement the orthogonality relations. That seems dangerous to me. Hence, we also skip the corresponding check.
	- In the past we have always included as dependencies the base manifolds of the vbundles of the indices, but now we do not do that. The argument was that there is no sense of a constant tensor. That might be true for tangent vbundles, but probably not for inner vbundles.

DefTensorChecks[head_[indices___],dependencies_,sym_,{dag_,forcesym_,weight_,grade_,frobeniusQ_,ot_,pw_,anynumberQ_}]:=Module[{alldependencies,manifolds,parameters,vbundles,SGS,tableaux},

(* 1. Validate name *)
ValidateSymbol[head];
ValidateSymbolInSession[head];

(* 2. Check indices and consistency with the vbundles *)
DefTensorCheckIndices[indices];
vbundles=SignedVBundleOfIndex/@{indices};

(* 3. Check dependencies: manifolds and parameters *)
alldependencies=SortDependencies[baseifbundle/@Flatten[{dependencies}]];
manifolds=Select[alldependencies,ManifoldQ];
parameters=Select[alldependencies,ParameterQ];
Throw[Message[DefTensor::unknown,"manifold or parameter",#]]&/@Complement[alldependencies,manifolds,parameters];

(* 4. Check Dagger option and decide whether it is compatible with the indices of the tensor *)
If[FreeQ[{Real,Imaginary,Complex,Conjugate,Hermitian,Antihermitian},dag],Throw@Message[DefTensor::invalid,dag,"value for option Dagger"]];
If[DaggerIndex@IndexList[indices]===IndexList[indices],
If[MemberQ[{Hermitian,Antihermitian},dag],Throw@Message[DefTensor::invalid,dag,"value for Dagger: only real indices"]],
If[MemberQ[{Real,Imaginary},dag],Throw@Message[DefTensor::invalid,dag,"value for Dagger: complex indices"]];
If[MemberQ[{Hermitian,Antihermitian},dag],TransposeDaggerRules[IndexList[indices],$VBundles]]
];

(* 5. Check weight *)
checkweight[head,weight];

(* 6. Check grades *)
checkgrade[grade];

(* If tensor has a variable number of slots we cannot check much more... *)
If[anynumberQ,

(* Print["** DefTensor: No checks on indices for a variable-rank tensor."] *)
Null,

(* 7. Check symmetries *)
{SGS,tableaux}=DefTensorSymmetryChecks[head[indices],sym,forcesym,vbundles];

(* 8. Check orthogonal vectors and projectors *)
If[ot=!={}&&TakeEIndices[{indices}]==={},Throw@Message[DefTensor::error,"A scalar cannot be orthogonal to a vector"]];
Map[If[!xTensorQ[Head[#]],Throw@Message[DefTensor::unknown,"vector",#]]&,ot];
If[pw=!={}&&TakeEIndices[{indices}]==={},
Throw@Message[DefTensor::error,"A scalar cannot be projected"]];
Map[If[!xTensorQ[Head[#]],Throw@Message[DefTensor::unknown,"projector",#]]&,pw];

];

{SortDependencies[alldependencies],vbundles,SGS,tableaux}

];

5) Check the weight option:

checkweight[0]:=Null;
checkweight[weight_Plus]:=checkweight/@weight;
checkweight[basis_Symbol?BasisQ]:=Null;
checkweight[n_?ConstantQ basis_]:=checkweight[basis];
checkweight[x_]:=Throw@Message[DefTensor::invalid,x,"weight for tensor"];

6) Check the grade option:

checkgrade[0]:=Null;
checkgrade[list_List]:=checkgrade/@list;
checkgrade[prod_?ProductQ->grade_Integer]:=Null;
checkgrade[graderule_]:=Throw@Message[DefTensor::invalid,graderule,"grade specification"];

9.2.2. Symmetry checks

1) The symmetry argument is given either as a symmetry group (with head GenSet or StrongGenSet, or the v9-inert Symmetric/Antisymmetric) or as a tableau or list of tableaux. The input can be given in terms of numeric slots or their indices at definition time, but it is inmediately converted into slots. First, check the heads:

validsymmetryhead[_GenSet|_StrongGenSet|_xAct`xTableau`Tableau|_Symmetric|_Antisymmetric]:=Null;
validsymmetryhead[list_List]:=validsymmetryhead/@list;
validsymmetryhead[x_]:=Throw@Message[DefTensor::invalid,x,"symmetry specification"];

2) This function finds all moved points in a given (strong or not) generating set or list of tableaux:

symslots[StrongGenSet[base_,GS_]]:=symslots[GS];
symslots[Symmetric[list_]]:=list;
symslots[Antisymmetric[list_]]:=list;
symslots[GenSet[]]:={};
symslots[GenSet[cycs__]]:=Union@Flatten[symslots/@{cycs}];
symslots[-xAct`xPerm`Cycles[cycs___]]:={cycs};
symslots[xAct`xPerm`Cycles[cycs___]]:={cycs};
symslots[xAct`xTableau`Tableau[lists___]]:=Union@Flatten[{lists}];
symslots[list_List]:=symslots/@list;

3) Compute the SGS of the symmetry:

As pointed out by Thomas, it is important that the base contains all moved points in the tensor, even though many of them might be irrelevant. It is also important, for later compatibility with the option OrderedBase->True, that the points in the base are sorted.

movedpoints[-perm_]:=movedpoints[perm];
movedpoints[xAct`xPerm`Cycles[cycs___]]:=Join[cycs];
movedpoints[perm_]:=movedpoints[TranslatePerm[perm,xAct`xPerm`Cycles]];
support[GS_]:=Apply[Union,movedpoints/@GS]

SGSofsym[GenSet[]]:=StrongGenSet[{},GenSet[]];
SGSofsym[SGS_StrongGenSet]:=SGS;
SGSofsym[sym:(_Symmetric|_Antisymmetric)]:=SchreierSims[{},sym];
SGSofsym[GS_GenSet]:=Check[Catch@SchreierSims[support[GS],GS],Throw@Message[DefTensor::invalid,GS,"symmetry identification"]];
SGSofsym[tab_xAct`xTableau`Tableau]:=xAct`xTableau`StrongGenSetOfTableau[tab];
SGSofsym[x_]:=Throw@Message[DefTensor::unknown,"symmetry",x]

4) Main checks:

DefTensorSymmetryChecks[head_[indices___],sym_,forcesym_,slots_]:=Module[{rules,numsym,symnumslots,tableaux,SGS,order,group},

(* Check structure of sym argument *)
validsymmetryhead[sym];

(* Transform indices to numeric slots; permutations in Cycles notation *)
rules=Thread@Rule[{indices},Range@Length@{indices}];
numsym=Flatten[{sym}]/.rules/.gs_GenSet:>TranslatePerm[gs,xAct`xPerm`Cycles];

(* Check that different symmetry arguments are disjoint *)
symnumslots=Flatten@symslots[numsym];
If[Union@symnumslots=!=Sort@symnumslots,Throw@Message[DefTensor::error,"Repeated slots in symmetry."]];

(* Select tableaux and construct SGS *)
tableaux=Cases[numsym,_xAct`xTableau`Tableau];
SGS=Apply[JoinSGS,SGSofsym/@numsym];

(* First consistency check only on small groups (up to 6 symmetry-slots) *)
If[Length[symnumslots]≤6,
group=Dimino[GenSet@SGS];
If[Intersection[group,Map[Minus,group]]=!=Group[],Throw@Message[DefTensor::zero]]];

(* Consistency check on all groups *)
If[PermMemberQ[-xAct`xPerm`Cycles[],SGS],Throw@Message[DefTensor::zero]];

(* ForceSymmetries check only on small groups if there are indices with different character or vbundle *)
If[!forcesym,
If[Length@Union@slots[[symnumslots]]>1,
If[(order=OrderOfGroup[SGS])>10000,
Print["  Order of group of symmetry: ",order," > 10000. ForceSymmetry check not performed."],
If[Head[group]===Symbol,group=Dimino[GenSet@SGS]];If[Length@Union[PermuteList[slots,#]&/@List@@group]=!=1,Throw@Message[DefTensor::wrongsym]]
]
]
];

{SGS,tableaux}
];

9.2.3. Definition

DefTensor requires two arguments, but the third (the symmetry) is optional, and must not be confused with the first option:

?OptionQ

Options[DefTensor]={
Dagger->Real,
Master->Null,
PrintAs->Identity,
VanishingQ->False,
ForceSymmetries->False,
WeightOfTensor->0,
GradeOfTensor->0,
FrobeniusQ->False,
OrthogonalTo->{},
ProjectedWith->{},
ProtectNewSymbol:>$ProtectNewSymbols,
DefInfo->{"tensor",""},
TensorID->{}
};
DefTensor[list_List,rest___]:=Scan[DefTensor[#,rest]&,list];
(* No symmetry *)
DefTensor[tensor_,dependencies_,options___?OptionQ]:=DefTensor[tensor,dependencies,GenSet[],options];
(* General definition *)
DefTensor[head_[indices___],dependencies_,sym_,options:OptionsPattern[]]:=Catch@Module[{
dag,pa,van,forcesym,weight,grade,frobeniusQ,ot,pw,pns,master,info,tensorID,
anynumberQ,alldependencies,vbundles,uniqueslots,SGS,tableaux},

(* Options *)
{dag,pa,van,forcesym,weight,grade,frobeniusQ,ot,pw,pns,master,info,tensorID}=OptionValue[{Dagger,PrintAs,VanishingQ,ForceSymmetries,WeightOfTensor,GradeOfTensor,FrobeniusQ,OrthogonalTo,ProjectedWith,ProtectNewSymbol,Master,DefInfo,TensorID}];
ot=Flatten[{ot},1];
pw=Flatten[{pw},1];
anynumberQ=MemberQ[{indices},AnyIndices[_?VBundleQ]];
If[van &&anynumberQ,Throw@Message[DefTensor::error,"Cannot define orthogonal tensor with variable rank."]];

(* Checks *)
{alldependencies,vbundles,SGS,tableaux}=DefTensorChecks[head[indices],dependencies,sym,{dag,forcesym,weight,grade,frobeniusQ,ot,pw,anynumberQ}];

(* DefInfo *)
If[Length[info]>2,info=If[dag===Conjugate,info[[{1,3}]],info[[{1,2}]]]];
MakeDefInfo[DefTensor,head[indices],info,van];

MakexTensions[DefTensor,"Beginning",head[indices],dependencies,sym,options];

(* Register tensor symmetries. Not possible for a variable rank tensor *)
If[!anynumberQ,
SymmetryGroupOfTensor[head]^=SGS;
If[tableaux=!={},SymmetryTableauxOfTensor[head]^=tableaux]];

(* Register tensor name *)
AppendToUnevaluated[$Tensors,head];
xTensorQ[head]^=True;

(* Vbundles and dependencies *)
SlotsOfTensor[head]^=vbundles;
DependenciesOfTensor[head]^=alldependencies;

(* Other *)
uniqueslots=Union@DeleteCases[UpIndex/@(vbundles/.AnyIndices->Identity/.PullBackVBundle[vb_,phi_]:>Sequence[vb,phi]),Labels];
SymbolRelations[head,master,DeleteCases[Union[alldependencies,uniqueslots],AnyDependencies]];
If[frobeniusQ,FrobeniusQ[head]^=frobeniusQ];
DefInfo[head]^=info;
TensorID[head]^=tensorID;
SetPrintAs[head,AddDaggerCharacter[PrintAsString[head,pa],dag]];
If[weight=!=0,WeightOfTensor[head]^=weight;PrintAs[head]^=addweight[PrintAs[head],weight]];
If[grade=!=0,
grade=Flatten[{grade}];
With[{prod=#[[1]],int=#[[2]]},TagSet[head,GradeOfTensor[head,prod],int]]&/@grade
];

(* Complex conjugation *)
Switch[dag,
Conjugate,Null,
Real,Dagger[head]^=head,
Imaginary,Dagger[head]^=MultiplyHead[-1,head],
_,
With[{daghead=MakeDaggerSymbol[head]},
SetDaggerPair[head,daghead];
DefTensor[Apply[daghead,DaggerIndex@IndexList[indices]],dependencies,SGS,Dagger->Conjugate,Master->head,options];
With[{prot=Unprotect[daghead]},
Switch[dag,
Hermitian,daghead[inds___]:=TransposeDagger[head[inds]];
HermitianQ[head]^=True,
Antihermitian,daghead[inds___]:=-TransposeDagger[head[inds]];
AntihermitianQ[head]^=True,
Complex,Null
];
Protect[prot];
]
]
];

(* Vanishing and projections *)
If[van,
SetDelayed[Evaluate[makepattern/@head[indices]],0],
Map[SetOrthogonal[head[indices],#]&,ot];
Map[SetProjected[head[indices],#]&,pw]
];

MakexTensions[DefTensor,"End",head[indices],dependencies,sym,options];

(* Protection *)
If[pns,Protect[head]];

];
SetNumberOfArguments[DefTensor,{2,Infinity}];
Protect[DefTensor];

Functions to detect Hermitian and antihermitian tensors. Note that for a Hermitian tensor we have an upvalue True for HermitianQ[tensor], but not for its Dagger conjugate. I think this is not a problem because the dagger tensor (**on indices**) is automatically converted into the original tensor.

HermitianQ[tensor_]:=False;
AntihermitianQ[tensor_]:=False;
SetNumberOfArguments[HermitianQ,1];
SetNumberOfArguments[AntihermitianQ,1];
Protect[HermitianQ,AntihermitianQ];

addweight[string_String,weight_Plus]:=Fold[addweight,string,List@@weight];
addweight[string_String,n_.basis_Symbol?BasisQ]:=TildeString[string,n,xAct`xCoba`BasisColor[basis]];

Other definitions:

SymmetryGroupOfTensor[0]:=StrongGenSet[{1},GenSet[-xAct`xPerm`Cycles[]]];
SymmetryGroupOfTensor[tensor_?xTensorQ[inds___]]:=SymmetryGroupOfTensor[tensor];
SymmetryGroupOfTensor[tensor_?xTensorQ]:=StrongGenSet[{},GenSet[]];
SymmetryGroupOfTensor[tensor_]:=Throw@Message[SymmetryGroupOfTensor::unknown,"tensor",tensor];
SymmetryTableauxOfTensor[tensor_?xTensorQ[inds___]]:=SymmetryTableauxOfTensor[tensor];
SymmetryTableauxOfTensor[tensor_?xTensorQ]:={};
SymmetryTableauxOfTensor[tensor_]:=Throw@Message[SymmetryTableauxOfTensor::unknown,"tensor",tensor];
SlotsOfTensor[tensor_]:=Throw@Message[SlotsOfTensor::unknown,"tensor",tensor];
DependenciesOfTensor[tensor_]:=Throw@Message[DependenciesOfTensor::unknown,"tensor",tensor];
TensorID[tensor_]:={};
FrobeniusQ[tensor_?xTensorQ]:=False;
FrobeniusQ[tensor_]:=Throw@Message[FrobeniusQ::unknown,"tensor",tensor];
WeightOfTensor[tensor_?xTensorQ]:=0;
WeightOfTensor[tensor_]:=Throw@Message[WeightOfTensor::unknown,"tensor",tensor];
tmp={SymmetryGroupOfTensor,SymmetryTableauxOfTensor,SlotsOfTensor,DependenciesOfTensor,TensorID,FrobeniusQ,WeightOfTensor};
SetNumberOfArguments[#,1]&/@tmp;
Protect[Evaluate[tmp]];

This function is now not being used (hence deactivated and not included in the package):

SymmetrySlotsOfTensor[head_?xTensorQ]:=Complement[Range@#,StablePoints[GenSet@SymmetryGroupOfTensor[head],#]]&@Length[SlotsOfTensor[head]];
SymmetrySlotsOfTensor[tensor_]:=Throw@Message[SymmetrySlotsOfTensor::unknown,"tensor",tensor];
SetNumberOfArguments[SymmetrySlotsOfTensor,1];
Protect[SymmetrySlotsOfTensor];

9.2.4. Undefinition

Note that if the tensor is a metric then we use UndefMetric, which undefines a number of associated objects, unsets MetricQ and calls back UndefTensor. To avoid using UndefTensor twice on the same tensor we need to add the Return[] call.

UndefTensor[list:{___?xTensorQ}]:=Scan[UndefTensor,list];
UndefTensor[tensor_]:=Catch@With[{servants=ServantsOf[tensor]},
If[!xTensorQ[tensor],Throw@Message[UndefTensor::unknown,"tensor",tensor]];
If[MetricQ[tensor],UndefMetric[tensor];Return[]];
CheckRemoveSymbol[tensor];
MakexTensions[UndefTensor,"Beginning",tensor];
xUpSet[ServantsOf[tensor],{}];
DropFromHosts[tensor];
Undef/@Reverse[servants];
$Tensors=DeleteCases[$Tensors,tensor];
MakexTensions[UndefTensor,"End",tensor];
MakeUndefInfo[UndefTensor,tensor];
RemoveSymbol[tensor];
]
SetNumberOfArguments[UndefTensor,1];
Protect[UndefTensor];

9.2.5. The tensor Zero, and MultiplyHead

It cannot be simpler:

?Zero

xTensorQ[Zero]^=True;
SlotsOfTensor[Zero]^:=AnyVBundles;
SymmetryGroupOfTensor[Zero]^:=StrongGenSet[{1},GenSet[-xAct`xPerm`Cycles[]]];
DependenciesOfTensor[Zero]^:={};
Dagger[Zero]^:=Zero;
Zero[___]:=0;
Protect[Zero];
MultiplyHead[k_,tensor_Symbol][inds___]:=k tensor[inds];
HeadOfTensor[tensor_?xTensorQ[inds___],{inds___}]:=tensor;
HeadOfTensor[k_?ConstantQ tensor_?xTensorQ[inds___],{inds___}]:=MultiplyHead[k,tensor];
HeadOfTensor[0,{___}]:=Zero;
TensorPlus[tensors__][inds___]:=Plus@@Through[{tensors}[inds]];
TensorPlus[][___]:=0;

9.2.6. Examples

BeginExamples[]

Let us create an inner complex bundle:

DefManifold[M2,2,{A,B,C,D,F,G,H}]

DefManifold[S2,2,{a,b,c,d,e,f,g,h}]

DefVBundle[InnerC,M2,3,{U,W},Dagger->Complex]

Errors:

DefTensor[]

Catch@DefTensor[T[S,-A,c],{M2,S2}]

Catch@DefTensor[T[A+B,-C,c],{M2,S2}]

Catch@DefTensor[T[A,-A,c],{M2,S2}]

DefParameter[time]

DefTensor[T[A,-B,c],{M2,S2,time}]

?T

Catch@DefTensor[T[A,-B,c],{M2,S2}]

DefTensor[TT[A,-B,c],{M2,S2},PrintAs->"𝔗",OrthogonalTo->{T[-A]}]

DefTensor[TTT[A,-B,c],{M2,S2},PrintAs->"𝔗",OrthogonalTo->{T[-A]},ProjectedWith->{T[-A,C]}]

$Tensors

?TT

DefTensor[TTTT[A],M2,VanishingQ->True]

TTTT[-A]

Catch@DefTensor[CdS[-a][TT[A,-B,c]],{M2,S2}]

Remove[CdS]

Catch@DefTensor[TC[W,-A,c],{M2,S2}]

DefTensor[TC[W,-A,c],{M2,S2},Dagger->Complex]

?TC

?TC†

Dagger[TC[U,-A,b]]//Trace

UndefTensor[TC]

DefTensor[TCC[U,W†],{M2,S2},Dagger->Hermitian]

TCC[U,W†]

Dagger[%]

UndefTensor[TCC]

Catch@DefTensor[C[A],{M2,S2}]

DefTensor[S[A],{M2,S2}]

Catch@DefTensor[r[],{M2},OrthogonalTo->{T[A]}]

DefTensor[r[],{M2}]

?r

Dagger[r[]]//Trace

Catch@DefTensor[R[-A,B],{M2},Symmetric[{1,2}]]

DefTensor[R[-A,-B],{M2},Symmetric[{1,2}]]

?R

DefTensor[RR[-C,-A,-B],{M2},Symmetric[{-B,-A}]]

?RR

DefTensor[RRR[-C,-A,-B],{M2},GenSet[-Perm[{-C,-B,-A}],-Perm[{-A,-C,-B}]]]

?RRR

DefTensor[RRRR[-C,-A,-B],{M2},GenSet[-Perm[{-C,-B,-A}]]]

?RRRR

UndefTensor/@$Tensors;

Check of ManifoldsOf:

DefTensor[v[-A],M2]

DefTensor[r[],M2]

DefTensor[w[a],S2]

ManifoldsOf[r[]]

ManifoldsOf[1]

ManifoldsOf[1+r[]]

ManifoldsOf[r[]+w[a]w[-a]]

DefConstantSymbol[x]

ManifoldsOf[1+r[]x]

ManifoldsOf[1+r[]x+O[x]^2]

UndefTensor/@$Tensors;

Check of ReplaceDummies:

DefTensor[T[-A,-B],M2]

DefTensor[t[-a,-b,W],S2,Dagger->Complex]

ReplaceDummies[T[A,-A,B]t[a,-a,b]]

ReplaceDummies[T[A,-A,B,W]t[a,-a,b,-W]]

ReplaceDummies[T[A,-A,B,W†]t†[a,-a,b,-W†]]

ReplaceDummies[T[{A,Polar},{-A,-Polar},B]t[a,-a,b]]

ReplaceDummies[T[A,-A,B]t[{a,Polar},{-a,-Polar},b],IndexList[a$,b$,A$,B$]]

The problem here is simply that we could be trying to undefine t and t† twice:

$Tensors

UndefTensor/@Drop[$Tensors,-1];

$Tensors

UndefParameter[time]

$AbstractIndices

UndefVBundle[InnerC]

Remove[Polar]

UndefManifold/@{M2,S2};

$Manifolds

Remove[a$,A$,b$,B$,x]

EndExamples[]

9.2.7. Explicit tensors

We introduce a new way of working with a tensor:

	ATensor[name, slots, deps, sym]

We don’t yet handle Daggering information.

ATensor[name_,slots_]:=ATensor[name,slots,{}];
ATensor[name_,slots_,deps_]:=ATensor[name,slots,deps,StrongGenSet[{},GenSet[]]];

xTensorQ[ATensor[name_,slots_,deps_,sym_]]^:=True;
PrintAs[ATensor[name_,slots_,deps_,sym_]]^:=name;
SlotsOfTensor[ATensor[name_,slots_,deps_,sym_]]^:=slots;
DependenciesOfTensor[ATensor[name_,slots_,deps_,sym_]]^:=deps;
SymmetryGroupOfTensor[ATensor[name_,slots_,deps_,sym_]]^:=sym;
HostsOf[ATensor[name_,slots_,deps_,sym_]]^:=DeleteDuplicates[Join[slots,deps]];
Dagger[tensor_ATensor]^:=tensor;
TensorID[tensor_ATensor]^:={};
DefInfo[tensor_ATensor]^:={"tensor",""};

Protect[ATensor];

9.3. delta tensors

9.3.1. delta

In the past there was a delta object for each vector bundle, but this is not needed, so now there is a single delta function, which is much simpler.

A problem with the delta objects is the position of the indices. Working with the Spinors package has shown that the problem was bigger than I had thought (I thank Alfonso for pointing this out). In the absence of a metric we have the delta[-a, b] tensor as identity in the tangent bundle when it acts on its first index, and as identity in the cotangent bundle when it acts on its second index (this is a trick to avoid using delta[-a, b] and codelta[b, -a], which are equal). That is, in the absence of a metric it is syntactically incorrect to have delta[a, -b]. When we add a metric we can define such object:
		delta[a, -b] = g[a, c] delta[-c, d] g[-d, -b]
with index positions following the see-saw convention in spinor theory. When the metric has symmetries the delta tensor inherits those symmetries: if the metric is symmetric then delta is symmetric; if the metric is antisymmetric then delta is antisymmetric. Basis has the same behaviour because we formally have metric = delta = Basis, all three being tensors.

The rules to change among them are the following:
	- Indices with the same height: use metric.
	- Indices with mixed positions:
		- abstract indices: use delta.
		- at least one basis-index: use Basis.
It is clear that Basis and delta are totally redundant, and actually many authors (for example Penrose and Rindler) only use delta, but I find it ugly. It is also simpler from the point of view of the distinction between xTensor and xCoba, and avoids excesive overloading of delta.

Properties of delta. The SlotsOfTensor[delta] value is only used in xTensor to compute the number of indices, and therefore it is not important what we write inside. DependenciesOf is only used by derivatives, and hence it doesn't matter what we say about delta. We actually say nothing because all derivatives anhililate delta.

(* Register delta *)
xTensorQ[delta]^=True;
DependenciesOfTensor[delta]^={};
PrintAs[delta]^="δ";
SlotsOfTensor[delta]^={-All,All};
MasterOf[delta]^=Symbol;
Dagger[delta]^=delta;

Additional properties of delta:
	- Dimension of vector bundle
	- Automatic contraction of abstract indices of delta: first try to contract second index. Assume both indices of delta belong to same manifold.
	- Conversion into Basis if there is at least one basis index.
	- Vanishing derivative in true delta cases (i.e. mixed abstract indices)

We use the technique of "hiding attributes", suggested by Michael Trott, to avoid an exponential explosion in the number of checks for delta contraction. Now there is a single check per index of delta.

delta in the priviledged DU configuration:

(* DU delta *)
delta[-a_Symbol,a_Symbol]:=DimOfVBundle@VBundleOfIndex[a];
delta/:(f_Symbol/;f===Times)[expr1___,delta[-a_Symbol,b_Symbol],expr2___]:=ReplaceIndex[expr1 expr2,-b->-a]/;IsIndexOf[expr1 expr2,-b,delta];
delta/:(f_Symbol/;f===Times)[expr1___,delta[-a_Symbol,b_Symbol],expr2___]:=ReplaceIndex[expr1 expr2,a->b]/;IsIndexOf[expr1 expr2,a,delta];
delta[a_,b:{_,_Symbol}]:=Basis[a,b];
delta[a:{_,-_Symbol},b_]:=Basis[a,b];
delta[a,b:_?BasisQ[_]]:=Basis[a,b];
delta[a:-_?BasisQ[_],b_]:=Basis[a,b];
delta/:(_?FirstDerQ)[delta[-_Symbol,_Symbol]]:=0;
ParamD[__][delta[-_Symbol,_Symbol]]:=0;

delta in the opposite UD configuration. There might be a sign, controlled by the function SymmetryOfIndex.

(* UD delta. Use SymmetryOfIndex *)
delta[a_Symbol,-a_Symbol]:=SymmetryOfIndex[a]DimOfVBundle@VBundleOfIndex[a];
delta/:(f_Symbol/;f===Times)[expr1___,delta[a_Symbol,-b_Symbol],expr2___]:=SymmetryOfIndex[a]ReplaceIndex[expr1 expr2,b->a]/;IsIndexOf[expr1 expr2,b,delta];
delta/:(f_Symbol/;f===Times)[expr1___,delta[a_Symbol,-b_Symbol],expr2___]:=SymmetryOfIndex[a]ReplaceIndex[expr1 expr2,-a->-b]/;IsIndexOf[expr1 expr2,-a,delta];
delta[a_,b:{_,-_Symbol}]:=SymmetryOfIndex[a]Basis[b,a];
delta[a:{_,_Symbol},b_]:=SymmetryOfIndex[b]Basis[b,a];
delta[a_,b:-_?BasisQ[_]]:=SymmetryOfIndex[a]Basis[b,a];
delta[a:_?BasisQ[_],b_]:=SymmetryOfIndex[b]Basis[b,a];
delta/:(_?FirstDerQ)[delta[_Symbol,-_Symbol]]:=0;
ParamD[__][delta[_Symbol,-_Symbol]]:=0;

The symmetry of delta is given by the symmetry of the metricof the vbundle of its indices:

(* Symmetry of delta is symmetry of metric *)
SymmetryGroupOfTensor[delta[a_,b_]]^:=With[{metric=FirstMetricOfVBundle[VBundleOfIndex[a],False]},If[metric===Null,StrongGenSet[{},GenSet[]],SymmetryGroupOfTensor[metric]]];

The trick converting delta into a metric is used in RHS of rules sometimes. With non-symmetric metrics we print a message:

(* Conversion to metric if both indices are abstract and have same height *)
delta[a_Symbol,b_Symbol]:=With[{metric=FirstMetricOfVBundle[VBundleOfIndex[a],True]},
If[SymmetryOfMetric[metric]=!=1,Message[delta::warning,"delta converted into non-symmetric "<>ToString[metric]]];
metric[a,b]
];
delta[-a_Symbol,-b_Symbol]:=With[{metric=FirstMetricOfVBundle[VBundleOfIndex[a],True]},
If[SymmetryOfMetric[metric]=!=1,Message[delta::warning,"delta converted into non-symmetric "<>ToString[metric]]];
metric[-a,-b]
];
(* Protection *)
SetNumberOfArguments[delta,2];
SetAttributes[delta,{ReadProtected,Protected}];

It is important to note that we are not checking that the indices of delta belong to the same vector space. In principle, if they didn't, we should transform delta into Zero.

We have introduced for the first time the tensor Basis, and hence we need to identify it as a tensor:

xUpSet[xTensorQ[Basis],True];

??Basis

9.3.2. Generalized delta: Gdelta

This is the generalized delta tensor with two antisymmetric sets of indices. We closely follow Lovelock and Rund:

1) Tensorial properties:

(* Register Gdelta *)
xTensorQ[Gdelta]^=True;
DependenciesOfTensor[Gdelta]^={};
PrintAs[Gdelta]^="δ";
SlotsOfTensor[Gdelta]^={AnyIndices[All]};
MasterOf[Gdelta]^=Symbol;
Dagger[Gdelta]^=Gdelta;
(* Two basic cases *)
Gdelta[]:=1;
Gdelta[a_,b_]:=delta[a,b];
(* The symmetry is computed from the number of indices *)
SymmetryGroupOfTensor[Gdelta]^:=StrongGenSet[{},GenSet[]];
SymmetryGroupOfTensor[Gdelta[inds__]]^:=Gdeltasym[Length[{inds}]/2,SymmetryOfIndex[First[{inds}],False]];
(* Derivatives *)
Gdelta/:HoldPattern[(_?FirstDerQ)[Gdelta[l:(-_Symbol)..,r:(_Symbol)..]]]:=0/;Length[{l}]===Length[{r}];

Actual computation of the strong generating set:
(Fixed sign in xTensor 1.1.0, reported by David Cassani.)

Gdeltasym[n_Integer,sym_Integer]:=StrongGenSet[Range[2n],GenSet@@Join[Minus/@xAct`xPerm`Cycles/@Partition[Range[n],2,1],Minus/@xAct`xPerm`Cycles/@Partition[Range[n+1,2n],2,1],If[sym=!=0,{sym^n xAct`xPerm`Cycles@@Transpose[{Range[n],Range[n+1,2n]}]},{}]]];
Gdeltasym[_]:=Throw@Message[Gdelta::error,"Found Gdelta with odd number of arguments."];

2) Contractions inside the generalized delta. In this function we use DimOfVBundle@VBundleOfIndex[b], and so this means that we assume that we are not working with an induced metric.

Gdelta[a___,-b_Symbol,c___,b_Symbol,d___]:=contractGdelta[{a,c,d},Length[{a,-b,c,b,d}]/2,Length[{a,-b}],Length[{a,-b,c,b}]];
Gdelta[a___,b_Symbol,c___,-b_Symbol,d___]:=SymmetryOfIndex[b]contractGdelta[{a,c,d},Length[{a,b,c,-b,d}]/2,Length[{a,b}],Length[{a,b,c,-b}]];
contractGdelta[list2_,semil_,p1_,p2_]:=Which[
!IntegerQ[semil],Throw@Message[Gdelta::error,"Found Gdelta with odd number of arguments."],
1≤p1≤semil&&1≤p2≤semil,0,
1≤p1-semil≤semil&&1≤p2-semil≤semil,0,
True,(-1)^(p1+p2-semil)(DimOfVBundle[VBundleOfIndex[First[list2]]]-semil+1)Apply[Gdelta,list2]];

3) UNDER DEVELOPMENT. In fact, the algorithm below is incorrect right now (see [post] in the xAct forum), so I deactivate it and go back to Gdelta expansion. The algorithm was copied from GAMMA, and I probably copied it incorrectly. I don’t understand it well enough to fix my copy.

Contractions of the generalized delta with other tensors. It performs all contractions in a “half-delta” simultaneously, but if there are contractions in the two halves then it needs two iterations. Note the standard issues of signs and factorials, which are more difficult in our case because we do not automatically sort the indices.

This function detects contractions, without worrying about their structure. That will be sorted out later.

(*Gdelta/:(f_/;f===Times)[expr1___,gdelta_Gdelta,expr2___]:=With[{tinds=ChangeIndex/@Select[FindIndices[Times[expr1,expr2]],ABIndexQ]},
System`Echo[contractGdeltaTimes[IndexList@@gdelta,tinds,Length[gdelta]/2,Expand@Times[expr1,expr2]]]/;Intersection[IndexList@@gdelta,tinds]=!=IndexList[]
];*)
Gdelta/:(f_/;f===Times)[expr1___,gdelta_Gdelta,expr2___]:=Expand[Times[expr1,ExpandGdelta[gdelta],expr2]];

QUESTION: Is it worth spending time finding out which factor of the product is actually contracted with the Gdelta? The computation would then be simpler...
QUESTION: contractGdeltaTimes uses AntisymmetricBlocksOf[Times[expr1, expr2]] which can potentially be a sum. Hence we have introduced a Expand. This means that multiplying by Gdelta automatically expands expressions. Is that OK?

The algorithm that follows is incorrect. See this [post]. I’ve deactivated it above and forced a call to ExpandGdelta. A pity, but difficult to fix.

This intermediate driver decides in which antisymmetric block of Gdelta and in which antisymmetric block of the expr the contraction will be performed:

contractGdeltaTimes[ginds_IndexList,tinds_IndexList,semil_Integer,sum_Plus]:=contractGdeltaTimes[ginds,tinds,semil,#]&/@sum;
contractGdeltaTimes[ginds_IndexList,tinds_IndexList,semil_Integer,0]:=0;
contractGdeltaTimes[ginds_IndexList,tinds_IndexList,semil_Integer,expr_]:=Module[{linds,rinds,ablocks,blocks,ctr},
(* Separate two subsets of indices of delta (both antisymmetric blocks) *)
If[!IntegerQ[semil],Throw@Message[Gdelta::error,"Found Gdelta with odd number of arguments."]];
linds=Take[ginds,semil];
rinds=Take[ginds,-semil];
(* Separate the antisymmetric blocks of the expression expr *)
ablocks=AntisymmetricBlocksOf[expr];
(* Find block pairs containing a contraction. Select one of longest length *)
ctr=Flatten[Outer[{#1,#2,Intersection[#1,#2]}&,{linds,rinds},Map[ChangeIndex,ablocks,{2}]],1];
ctr=First@SortBy[ctr,-Length[Last[#]]&];
(* If the result will not contain Gdelta and there is just one contraction then change to ExpandGdelta, which is faster
If[Length[ctr[[1]]]≤2&&Length[ctr[[2]]]≤2&&Length[ctr[[3]]]==1,
Return[Expand[ExpandGdelta[Gdelta@@ginds] expr]]
];*)
(* As usual, try to contract first the second half of the indices of delta *)
If[ctr[[1]]===rinds,
contractGdeltaExpansion[Right,linds,rinds,ctr[[3]],expr],
contractGdeltaExpansion[Left,rinds,linds,ctr[[3]],expr]
]
];

This is an important function in this algorithm. Supplying its actual values by hand can speed up enormously the computations for cases with many indices. In the general case it falls of to the general group-theoretical computation implemented in AntisymmetricBlocks.

AntisymmetricBlocksOf[Gdelta[inds__]]:=IndexList@@@Partition[{inds},Length[{inds}]/2];
AntisymmetricBlocksOf[Times[gdelta_Gdelta,rest__]]:=Join[AntisymmetricBlocksOf[gdelta],AntisymmetricBlocksOf[Times[rest]]];
AntisymmetricBlocksOf[expr_]:=With[{sym=SymmetryOf[expr]},
Extract[IndexList@@(Last/@sym[[3]]),List/@AntisymmetricBlocks[sym[[4]],Length[sym[[3]]]]]
];

Find the antisymmetric blocks of a SGS. This algorithm is quadratic, and it can probably be made linear. It should be moved to xPerm:

AntisymmetricBlocks[sgs_]:=AntisymmetricBlocks[sgs,PermDeg[sgs]];
AntisymmetricBlocks[Antisymmetric[range_],n_]:=Join[{range},List/@Complement[Range[n],range]];
AntisymmetricBlocks[Symmetric[range_],n_]:=List/@Range[n];
AntisymmetricBlocks[sgs_,n_]:=Join[#,List/@Complement[Range[n],Sequence@@#]]&@(Sort/@ConnectedComponents[Graph[UndirectedEdge@@@Identity@@@(Minus/@Select[Minus/@xAct`xPerm`Cycles/@Subsets[Range[n],{2}],PermMemberQ[#,sgs]&])]]);

This function is essentially taken from the package GAMMA`, by Ulf Gran. I’ve copied the signs, though I must admit I don’t understand them:

contractGdeltaExpansion[side_,oinds_,cinds_,ictrs_,expr_]:=With[{crest=DeleteCases[cinds,Alternatives@@ictrs],len=Length[ictrs]},
len!(-1)^(Plus@@Flatten[Position[cinds,Alternatives@@ictrs]]+len(len+1)/2)Total[
With[{orest=DeleteCases[oinds,Alternatives@@#]},
Times[
Signature[Join[#,orest]],
Gdelta@@join[orest,crest,side],
ReplaceIndex[expr,Thread[List@@(ChangeIndex/@ictrs)->List@@#]]
]
]&/@Subsets[oinds,{len}]
]
];
join[list1_,list2_,Right]:=Join[list1,list2];
join[list1_,list2_,Left]:=Join[list2,list1];

This is Gran’s code, for reference, slightly edited. Important comment: Any of the v lists is an antisymmetric group of indices of the tensor z. Why is this only contracting in the first argument (x) of GAMMAdelta? Do we need a separate definition for the second (y) argument?

PositionList[lis_,find_]:=Map[Position[lis,#][[1]]&,find]
GAMMAdelta/:GAMMAdelta[x_List,y_List]z_[w___List,v_List,s___List]:=Module[{
same=ReplaceList[{x,v},{{___,t_,___},{___,t_,___}}:>t],poslist1,poslist2,xxleft,lensame,yycomb,lenyycomb,actyycomb,actyycompo,i
},
lensame=Length[same];
poslist1=PositionList[x,same];
xxleft=Delete[x,poslist1];
poslist2=PositionList[v,same];
yycomb=Subsets[y,{lensame}];
lenyycomb=Length[yycomb];
Power[-1,Evaluate[Plus@@Flatten[poslist1]-lensame(lensame+1)/2]]/lenyycomb Sum[
actyycomb=yycomb[[i]];
actyycompo=Complement[y,actyycomb];
Signature@Join[actyycomb,actyycompo]GAMMAdelta[xxleft,actyycompo]z[w,ReplacePart[v,actyycomb,poslist2,List/@Range@Length@poslist2],s],
{i,lenyycomb}
]
]/;Intersection[x,v]=!={};

4!/2GAMMAdelta[{x1,x2,x3,x4},{y1,y2,y3,y4}]T[{x1,x2},{z1,z2}]

4!/2GAMMAdelta[{x1,y1,x2,y2},{z1,w1,z2,w2}]T[{x1,y1},{z1,w1}]

GAMMAdelta[{x2,y2},{z1,z2}] T[{w1,w2},{z1,w1}]

4) This function expands the generalized delta into normal deltas. The function ExpandGdelta acts only on those Gdelta's for the delta tensor (or first-metric of the vbundle), and not with induced metrics.

ExpandGdelta[expr_]:=expr/.Gdelta[inds__]:>expandGdelta[delta][inds];

We need this additional function to expand the product of two epsilons using other metric, for instance an induced metric:

expandGdelta[metric_][a_,b_]:=metric[a,b];
expandGdelta[metric_][indices___]:=Module[{semil=Length[{indices}]/2},
If[!IntegerQ[semil],Throw@Message[Gdelta::error,"Found Gdelta with odd number of indices."]];Det@Outer[metric,{indices}[[Range[semil]]],{indices}[[Range[semil+1,2semil]]],1]];

9.3.3. Examples

BeginExamples[]

DefManifold[M4,4,{A,B,C,D}]

Working with delta:

delta[A,-A]

delta[-A,A]

delta[-A,B]delta[-B,C]

Catch@delta[-A,-B]

Note that when both indices of delta can be contracted, then the second one is contracted:

DefTensor[T[A,B],M4]
DefTensor[aa[A],M4]

delta[-A,B]T[A,-B]

delta[A,-B]T[-A,B]

delta[-A,B]aa[A,-B]

delta[A,-B]aa[-A,B]

UndefTensor/@{T,aa};

Generalized delta:

Gdelta[-A,-B,C,D]//ExpandGdelta

delta[-D,A]%//Expand

Catch@UndefTensor[delta]

Gdelta[-A,-B,C,D]

delta[-D,B]%

UndefManifold[M4]

EndExamples[]

9.3.4. An even more general delta, the super-delta: Sdelta

We generalize Gdelta, which is always antisymmetric, to a general concept of delta with two sets of indices with any symmetry group. This acts as a projector onto the tensors with the given symmetry.

(* General info *)
xTensorQ[Sdelta[sym_]]^:=True;
PrintAs[Sdelta[sym_]]^="δ";
SlotsOfTensor[Sdelta[sym_]]^:={AnyIndices[All]};
DependenciesOfTensor[Sdelta[sym_]]^:={};
(* Symmetry info *)
Sdelta[sym_GenSet][inds___]:=Sdelta[SchreierSims[{},sym]][inds];
SymmetryGroupOfTensor[Sdelta[sym_][inds___]]^:=With[{n=Length[{inds}]},JoinSGS[sym,sym/.p_Integer?Positive:>p+n/2]/;Or[EvenQ[n],Throw[]]];
(* Other info *)
Dagger[Sdelta[sym_]]^:=Sdelta[sym];
DefInfo[Sdelta[sym_]]^:={"tensor","super delta of adjustable symmetry"};
HostsOf[Sdelta[sym_]]^:={};
TensorID[Sdelta[sym_]]^:={};
Protect[Sdelta];

This function converts Sdelta into a linear combination of products of delta with the same effect:

ExpandSdelta[expr_]:=expr/.Sdelta[sym_][inds___]:>expandSdelta[sym,delta][inds];
oneSterm[metric_,first_List,last_List][-perm_]:=-oneSterm[metric,first,last][perm];
oneSterm[metric_,first_List,last_List][perm_]:=Inner[metric,first,PermuteList[last,perm],Times];
expandSdelta[sym_,metric_][inds___]:=With[{first=Take[{inds},Length[{inds}]/2],last=Take[{inds},-Length[{inds}]/2],grouplist=Dimino[sym]},Apply[Plus,oneSterm[metric,first,last]/@grouplist]/Length[grouplist]];

This is a private function that we use to remove the Sdelta after using it for canonicalization:

RemoveSdelta[expr_]:=expr/.Sdelta[_][inds___]:>With[{n=Length[{inds}]/2},Inner[delta,Take[{inds},n],Take[{inds},-n],Times]];

9.4. Formatting

Tensor formatting. The old formatting mechanism is recovered using here "ScriptBox" instead of "GridBox".

$TensorBoxes="GridBox";

xTensorBox[Projected[tensor_,projs_List],inds_List]:=MakeTensorBoxes[$TensorBoxes][PrintAs[tensor],IndexArray[$TensorBoxes][inds,projs]];

xTensorBox[tensor_,inds_List]:=MakeTensorBoxes[$TensorBoxes][PrintAs[tensor],IndexArray[$TensorBoxes][inds]];

MakeTensorBoxes["ScriptBox"]=MakeTensorScriptBoxes;
MakeTensorBoxes["GridBox"]=MakeTensorGridBoxes;

IndexArray["ScriptBox"]=SSSBinds;
IndexArray["GridBox"]=IndexGrid;

1) This is the old formatting for tensors, based on SubsuperscriptBox.

MakeTensorScriptBoxes[stem_String,{downstring_String,upstring_String}]:=SubsuperscriptBox[stem,downstring,upstring];

Note that SSSBinds only accepts lists of indices with head List, and not IndexList. This is because it is much more natural within the Fold construct. This function is also used in the construction of Projected tensors and derivatives with multi-indices.

SSSBinds[inds_List]:=Fold[AddIndex,{"",""},inds];

A generalization for projected indices:

SSSBinds[inds_List,projs_List]:=Fold[AddIndex[#1,#2[[1]],Null,#2[[2]]]&,{"",""},Transpose[{inds,projs}]];

BeginExamples[]

xATP`SSSBinds[{-A,B,C}]

EndExamples[]

2) And this is our new formatting, base on the more flexible GridBox. In particular note how many parameters we can play with, including a global fontsize parameter for all indices. Both the tensor and the index grid are constructed with GridBox.

We need this exception because GridBox complains with empty grids.

MakeTensorGridBoxes[stem_,{}]:=stem;

MakeTensorGridBoxes[stem_,indexgrid_List]:=GridBox[{{
stem,
StyleBox[
GridBox[
indexgrid,
RowSpacings->0,ColumnSpacings->0.05,GridFrameMargins->{{0,0},{0,0}}
],FontSize->3/4CurrentValue[FontSize]
]
}},
ColumnSpacings->0.05,RowAlignments->Center
];

With or without projectors:

IndexGrid[{},projs_]:={};
IndexGrid[{}]:={};
IndexGrid[inds_List,projs_]:=Reverse@Transpose@Inner[IndexPair[#1,Null,#2]&,inds,projs,List];
IndexGrid[inds_List]:=Reverse@Transpose[IndexPair/@inds];

3) Main drivers:

SetAttributes[HeldxTensorQ,HoldAllComplete];
HeldxTensorQ[expr_]:=xTensorQ[Unevaluated[expr]];

xTensorFormStart[Tensor]:=(
MakeBoxes[tensor_?HeldxTensorQ[inds___],StandardForm]:=Block[{$WarningFrom="Tensor Formatting"},interpretbox[tensor[inds],xTensorBox[tensor,{inds}]]]);
xTensorFormStop[Tensor]:=(MakeBoxes[tensor_?HeldxTensorQ[inds___],StandardForm]=.);
xTensorFormStart[Tensor];

Examples:

BeginExamples[]

DefManifold[M2,2,{A,B,C,D}]

DefTensor[T[-A,B,C],M2]

T[B,A,-C]

ToBoxes[%]

InputForm[%%]

T[A$,-A$,C$101]

T[A$,-A$,C$101]//ScreenDollarIndices

T[B_,A_,-C_]

Cut and paste:

(Subscript[T,   C]^(BA ))

%//InputForm

Note that for patterns (in the second case) the index A is slightly displaced to the right. I don't know why:

(Subscript[T,   C]^(BA ))//ToBoxes

(Subscript[T,   (UnderBar[C])]^((UnderBar[B])(UnderBar[A]) ))//ToBoxes

This is not related to AutoSpacing. It is a problem related to the fact that we have removed the explicit quotes:

InterpretationBox[StyleBox[SubsuperscriptBox["T","\"  \!\(C\+_\)\"","\"\!\(B\+_\)\!\(A\+_\) \""],AutoSpacing->False],(Subscript[T,   (UnderBar[C])]^((UnderBar[B])(UnderBar[A]) )),Editable->False]//DisplayForm

But then we can't have a nice looking cut-and-pasted expression:

(Subscript[T, "  (UnderBar[C])"]^("(UnderBar[B])(UnderBar[A]) "))

We can also try removing the quotes, but then we do not have strings anymore:

\!\(C\+_\)

%/.C->1

InputForm[%]

xTensorFormStop[Tensor]

(Subscript[T,   C]^(AB ))

T[A,B,-C]

xTensorFormStart[Tensor]

T[A,B,-C]

UndefTensor[T]

Remove[A$,C$101]

UndefManifold[M2]

EndExamples[]

9.5. Directional slots

Implement linearity. Note the importance of having Dir at the first level of the tensor expression. If we used the notation -Dir[v[z]] for a covariant d-index that wouldn't be possible.

SeriesDataMap[f_,HoldPattern[SeriesData[var_,orig_,coeffs_List,rest__]]]:=SeriesData[var,orig,Map[f,coeffs],rest];

Improved version, after discussions with Teake in the group :

SeriesDataMap[f_?FirstDerQ,sd:HoldPattern[SeriesData[var_,orig_,coeffs_List,rest__]]]:=If[f[var]==0,SeriesData[var,orig,Map[f,coeffs],rest],f[var] D[sd,var]];

Dir/:(tensor_?xTensorQ)[x___,Dir[v_Plus],y___]:=Map[tensor[x,Dir[#],y]&,v];
Dir/:(tensor_?xTensorQ)[x___,Dir[v_SeriesData],y___]:=SeriesDataMap[tensor[x,Dir[#],y]&,v];
Dir/:(tensor_?xTensorQ)[x___,Dir[scalar_?ScalarQ v_],y___]:=scalar tensor[x,Dir[v],y];
Dir/:(tensor_?xTensorQ)[___,Dir[0],___]:=0;

Note that we validate expr below. We use certain definitions containing Dir expresions with patterns; we need to consider those cases. Given that our definitions only use patterns at the first and second levels of Dir, we only need those two cases.

?ValidateDir

SetAttributes[ValidateDir,HoldFirst];
ValidateDir[x:Dir[_Blank|_Pattern|_PatternTest]]:=x;
ValidateDir[x:Dir[_[___,_Blank|_Pattern|_PatternTest,___]]]:=x;
ValidateDir[x:Dir[0]]:=x;
ValidateDir[x:Dir[expr_]]:=Block[{$WarningFrom="Dir Validation"},
(* Check expression *)
UncatchedValidate[expr];
(* Check free ultraindex *)
UltraindexOf[expr];
(* Return index if everything OK *)
x];
ValidateDir[x_]:=Throw[Message[Validate::invalid,x,"directional index"];ERROR[x]];

BeginExamples[]

DefManifold[M2,2,{A,B,C,D,F,G,Z}]

DefTensor[T[A,B,C],M2]

DefTensor[v[A],M2]
DefTensor[w[A],M2]

T[A,Dir[3v[Z]+w[Z]],B]

T[A,Dir[T[-Z,-B,-C]v[B]w[C]],B]

Catch@xATP`ValidateDir[Dir[3v[-A]+w[A]]]

Catch@xATP`ValidateDir[Dir[3v[A,B]]]

Catch@xATP`ValidateDir[Dir[3v[A]]]

xATP`ValidateDir[Dir[3v[Z]]]

UndefTensor/@{T,v,w};

UndefManifold[M2]

EndExamples[]

This function separates all directional indices:

?SeparateDir

We have not yet generalized this for multiple-indices derivatives:

SeparateDir[expr_]:=expr//.{
tensor:_?xTensorQ[___,dir_Dir,___]:>separateDir[tensor,dir],
covd:_?CovDQ[dir_Dir][_]:>separateDir[covd,dir],
covd:CovD[_,___,_?CovDQ[dir_Dir],dersR___]:>CovD[separateDir[covd,dir],dersR]
};
SeparateDir[expr_,list_List]:=Fold[SeparateDir,expr,list];
SeparateDir[expr_,v_?xTensorQ]:=expr//.{
tensor:_?xTensorQ[___,dir:Dir[_v],___]:>separateDir[tensor,dir],
covd:_?CovDQ[dir:Dir[_v]][_]:>separateDir[covd,dir],
covd:CovD[_,___,_?CovDQ[dir:Dir[_v]],dersR___]:>CovD[separateDir[covd,dir],dersR]
};
SetNumberOfArguments[SeparateDir,{1,2}];
Protect[SeparateDir];
separateDir[expr_,Dir[v_]]:=Module[{ultraindex=UltraindexOf[v],dummy},
dummy=DummyAs[ultraindex];
changeDir[expr,-dummy]ReplaceIndex[v,ultraindex->dummy]];
changeDir[tensor_?xTensorQ[indsL___,_Dir,indsR___],mdummy_]:=tensor[indsL,mdummy,indsR];
changeDir[covd_Symbol[_Dir][expr_],mdummy_]:=covd[mdummy][expr];
changeDir[CovD[expr_,ders___,covd_Symbol[_Dir]],mdummy_]:=CovD[expr,ders,covd[mdummy]];

And this is the inverse function, which contracts expressions into Dir slots:

Options[ContractDir]={OverDerivatives->True};
(* IsIndexOf used without third argument *)
ContractDir[expr_,vector_?xTensorQ,options:OptionsPattern[]]:=expr/.vector[a_?AIndexQ]expr1_:>ContractDir1[vector,OptionValue[OverDerivatives]][expr1 vector[a]]/;IsIndexOf[expr1,-a];
SetNumberOfArguments[ContractDir,2];
Protect[ContractDir];

(* Main *)
(CM:ContractDir1[vector_,od_])[rest_. tensor_?xTensorQ[indsL___,b_,indsR___]vector_[a_]]:=CM[rest tensor[indsL,Dir[vector[a]],indsR]]/;PairQ[a,b];
(CM:ContractDir1[vector_,od_])[rest_.covd_?CovDQ[indsL___,b_,indsR___][expr1_]vector_[a_]]:=CM[rest covd[indsL,Dir[vector[a]],indsR][expr1]]/;PairQ[a,b];
(* First-derivatives *)
(CM:ContractDir1[vector_,od_])[rest_. der_?FirstDerQ[expr_]vector_[a_]]:=
Module[{dv=der[vector[a]],result},
If[(dv===0||od)&&differentexpressionsQ[result=CM[expr vector[a]],{expr,vector[a]}],
CM[rest der[result]]-CM[rest dv expr],
CM[rest vector[a]]der[expr]]
]/;(IsIndexOf[expr,-a]&&Head[expr]=!=vector);
(* Default *)
ContractDir1[vector_,od_][expr_]:=expr;

BeginExamples[]

DefManifold[M2,2,{A,B,C,D,F,G}]

DefTensor[T[A,B,C],M2]
DefTensor[v[A],M2]

{T[A,Dir[v[-A]],C],T[A,Dir[v[A]],C],T[Dir[v[A]],Dir[v[A]]],T[A,Dir[v[A]]]T[B,Dir[v[A]]],Scalar[T[Dir[v[A]]]]^2}//SeparateDir//ScreenDollarIndices

ContractDir[T[A,B,C]v[-A],v]

ContractDir[#,v]&/@%

ContractDir[#,v]&/@%

UndefTensor/@{T,v};

UndefManifold[M2]

EndExamples[]

9.6. Validation

This function validates single tensors.

?ValidateTensor

If a pattern index is found there are no further checks:

Validate::pat="Found pattern index `1` . Cannot validate.";
SetAttributes[ValidateTensor,HoldFirst];
ValidateTensor[x:tensor_[inds___]]:=Catch@Block[{$WarningFrom="Tensor Validation"},Module[{newinds,bundles,rightbundles,metricsQ,ups,rightups,strtensor,valid,anynumberQ},
(*** Recognize tensor name ***)
If[!xTensorQ[tensor],Throw[Message[Validate::unknown,"tensor",tensor];ERROR[x]]];
(*** Discard patterns and validate g-indices ***)
If[PIndexQ[#],Message[Validate::pat,#];Return[x]]&/@IndexList[inds];
If[!GIndexQ[#],Throw[Message[Validate::unknown,"index",#];ERROR[x]]]&/@IndexList[inds];
(*** Validate index-structure. Not possible for a variable rank tensor ***)
anynumberQ=MemberQ[SlotsOfTensor[tensor],AnyIndices[_]];
If[!anynumberQ,
(* Definitions *)
rightbundles=UpIndex/@SlotsOfTensor[tensor];
newinds={inds}/.d_Dir:>ChangeIndex@UltraindexOf[d];
bundles=VBundleOfIndex/@newinds;
rightups=UpIndexQ/@SlotsOfTensor[tensor];
ups=UpIndexQ/@newinds;
metricsQ=MetricEndowedQ/@bundles;
(* Validate number of indices *)
If[Length[bundles]=!=Length[rightbundles],Throw[Message[Validate::error,"Invalid number of indices of tensor "<>ToString[tensor]];ERROR[x]]];
(* Validate indices at slots *)
If[Not@Inner[SubvbundleQ[#1,#2]&,rightbundles,bundles,And],Throw[Message[Validate::error,"Invalid index at slot of tensor "<>ToString[tensor]];ERROR[x]]];
(* Validate up/down character of indices *)
If[Not@Inner[Or,metricsQ,Inner[Equal,ups,rightups,List],And],Throw[Message[Validate::error,"Invalid character of index in tensor "<>ToString[tensor]];ERROR[x]]];
(* Validate EIndices are not repeated *)
Check[CheckRepeated[IndexList[inds]],Throw[Print["Sending error"];ERROR[x]]];
];
(* Else, return tensor *)
x
]]

Examples:

BeginExamples[]

DefManifold[M2,2,{A,B,C,D,F,G}]

DefManifold[S2,2,{a,b,c,d,e,f,g}]

DefTensor[T[A,-B,c],M2]
DefTensor[R[-A,-B],M2]
DefTensor[v[A],M2]

FindAllOfType[T[A,-B,c]R[-A,-C]+G[-D,-C]TT[D,-B,c]+LieD[v[A]][T[A,-B,c]],Tensor]

xATP`ValidateTensor/@%

Catch@xATP`ValidateTensor[T[A,B,c]]

Catch@xATP`ValidateTensor[T[A,b,c]]

Catch[xATP`ValidateTensor[T[A,-B,c,d]]]

xATP`ValidateTensor[T[D,Dir[v[A]],c]]

xATP`ValidateTensor[T[D,Dir[v[C]],c]]

Catch@xATP`ValidateTensor[T[D,Dir[v[-C]],c]]

$Tensors

Catch@xATP`ValidateTensor[v[E]]

Catch@xATP`ValidateTensor[v[A_]]

For some reason, Mathematica forgets the interpretation rule for this from one session to another. Note that the $Line number is not increased! This seems to be a bug:

ERROR[(Subscript[v,  ]^(UnderBar[A]))]//InputForm

Unprotect[v];
v[-A_]:=1
Protect[v];

v[-A]

Catch@xATP`ValidateTensor[v[-A]]

$Tensors

UndefTensor/@$Tensors;

UndefManifold[M2]

UndefManifold[S2]

Remove[TT];

EndExamples[]

9.7. Weights

Tensorial weights can only be defined once a basis has been introduced. Therefore this function could be defined in xCoba. However, several functions in xTensor need to worry about densities, and therefore we prefer to keep the pair {WeightOf, WeightOfTensor} here in xTensor. For instante WeightOfTensor is an option to DefTensor. It would make no sense to define it with context xAct`xCoba`. Determinant for the determinant of the metric is still here, but the general concept of determinant is defined in xCoba.

?WeightOf

The definitions on indexed objects are dangerous because there could be Dir expressions containing densities. Perhaps even in basis objects.

(* One argument *)
WeightOf[_Integer|_Rational|_Real|_Complex]:=0;
WeightOf[_Symbol?ConstantSymbolQ]:=0;
(* Indices assumed not to change weights *)
WeightOf[tensor_?xTensorQ[___]]:=WeightOfTensor[tensor];
(* Derivatives assumed not to change weights *)
WeightOf[_?FirstDerQ[expr_]]:=WeightOf[expr];
WeightOf[ParamD[__][expr_]]:=WeightOf[expr];
WeightOf[expr_Times]:=Plus@@(WeightOf/@List@@expr);
WeightOf[_?ProductQ[exprs___]]:=Plus@@(WeightOf/@{exprs});
WeightOf[expr_Plus]:=Check[JustOne@Union[Expand/@WeightOf/@List@@expr],Throw[Message[WeightOf::error,"Inhomogeneous sum of densities."];ERROR[expr]],Validate::notone];
WeightOf[expr_SeriesData]:=WeightOf[Normal[expr]];
WeightOf[Power[expr_,n_]]:=n WeightOf[expr];
WeightOf[Dagger[expr_]]:=WeightOf[expr];
(* Weight not defined on inertheads and other scalar functions *)
WeightOf[ih_?InertHeadQ[__]]:=Throw[Message[WeightOf::error,"WeightOf is generically undefined on inert heads."]];
WeightOf[sf_?ScalarFunctionQ[x___]]:=If[MemberQ[Attributes[sf],NumericFunction]&&Length[{x}]===1,
If[WeightOf[x]===0,
0,
Throw[Message[WeightOf::error,"A numeric scalar function must have a zero-weight argument."]]
],
Throw[Message[WeightOf::error,"WeightOf is generically undefined on scalar functions."]]
];
WeightOf[Derivative[__Integer][sf_?ScalarFunctionQ][__]]:=Throw[Message[WeightOf::error,"WeightOf is generically undefined on scalar functions."]];
(* Two arguments *)
WeightOf[expr_,Null]:=0;
WeightOf[expr_,basis_]:=Coefficient[WeightOf[expr],basis];
SetNumberOfArguments[WeightOf,{1,2}];
Protect[WeightOf];

BeginExamples[]

WeightOf[Sqrt[hello]]

WeightOf[hello^5]

Remove[hello]

EndExamples[]

QUESTIONs: is it possible to define the weight of the logarithm of a density?

9.8. UpVectors and DownVectors

These are a collection of functions that detect the tensor character of a expression. In the future there must be a function considering all possible cases, with a generalized (to arbitrary expressions) function.

?UpVectorQ

?DownVectorQ

checkoneindex[IndexList[a_],f_]:=f[a];
checkoneindex[IndexList[a_],f_,vb_]:=f[a]&&VBundleOfIndex[a]===vb;
checkoneindex[__]:=False;

UpVectorQ[expr_]:=checkoneindex[FindFreeIndices[expr],UpIndexQ];
UpVectorQ[expr_,vbundle_?VBundleQ]:=checkoneindex[FindFreeIndices[expr],UpIndexQ,vbundle];
DownVectorQ[expr_]:=checkoneindex[FindFreeIndices[expr],DownIndexQ];
DownVectorQ[expr_,vbundle_?VBundleQ]:=checkoneindex[FindFreeIndices[expr],DownIndexQ,vbundle];
SetNumberOfArguments[#,{1,2}]&/@{UpVectorQ,DownVectorQ};
Protect[UpVectorQ,DownVectorQ];

BeginExamples[]

DefManifold[M2,2,{A,B,C}]

DefTensor[r[],M2]

ScalarQ[a r[]]

UndefTensor[r]

UndefManifold[M2]

Remove[a]

EndExamples[]

9.9. TransposeDagger

This function only works on tensors. QUESTION: Do we need anything else?

?TransposeDagger

The name of this function could be misleading because it could suggest that it is a combination of Dagger *and* Transpose, and it is not. Perhaps a better name for it could be TransposeDaggerIndices in the sense of "transpose only the complex indices".

This function works in several steps:

1) Construct pairs in a list. We choose the convention of pairing indices by order, as given by vinds and vdinds. The tf says whether we want equal numbers of indices in VB and its conjugate. In case we don't we simply shorten one of the lists, dropping indices at the end. We do not worry about indices being dummies or not. There is no need of having indices of a pair as neighbours.

(* Separate pairs in a vbundle. Always three arguments *)
TransposeDaggerPairsOneVBundle[inds_IndexList,{vbundle_,vbundledag_},tf_]:=
Module[{rules,
vinds=Select[inds,GIndexQ[#,vbundle]&],
vdinds=Select[inds,GIndexQ[#,vbundledag]&]},

(* Different numbers of indices *)
If[Length[vinds]=!=Length[vdinds],
If[tf,
Throw@Message[TransposeDagger::error3,"Different number of indices of",vbundle,"and its conjugate",vbundledag],
If[Length@vinds>Length@vdinds,
vinds=vinds[[Range@Length@vdinds]],
vdinds=vdinds[[Range@Length@vinds]]
]
]
];

(* Thread over IndexList. Return an IndexList of Pair pairs *)
If[Sort[vinds]===Sort[vdinds],IndexList[],Thread[Pair[vinds,vdinds],IndexList]]
];

2) Separate pairs of different vbundles. We get an IndexList of Pair pairs.

(* Detect reordering pairs. One, two or three arguments *)
TransposeDaggerPairs[x_]:=TransposeDaggerPairs[x,$VBundles];
TransposeDaggerPairs[tensor_?xTensorQ[inds___],vbs_,tf_:True]:=TransposeDaggerPairs[IndexList[inds],vbs,tf];
TransposeDaggerPairs[inds_IndexList,vbundle_?VBundleQ,tf_:True]:=TransposeDaggerPairs[inds,{vbundle},tf];
TransposeDaggerPairs[inds_IndexList,vbundles_List,tf_:True]:=
Apply[Join,TransposeDaggerPairsOneVBundle[inds,#,tf]&/@MakeVBundlePairs[vbundles]];

(* List of pairs of complex conjugated vbundles. Trick: VB always sorted before VB† *)
MakeVBundlePairs[vbundles_List]:=Union@Cases[MakeVBundlePair/@vbundles,{_,_}];
MakeVBundlePair[-vbundle_]:=MakeVBundlePair[vbundle];
MakeVBundlePair[vbundle_]:=Union[{vbundle,Dagger[vbundle]}]

3) Construct rules exchanging indices:

(* Construct rules for index reordering. Always two arguments *)
TransposeDaggerRules[x_,vbundles_List]:=Module[{pairs=TransposeDaggerPairs[x,vbundles],rules},
rules=Apply[Rule,pairs,1];
List@@Join[rules,Reverse/@rules]];

4) Main (public) function:

(* Main *)
TransposeDagger[expr_]:=TransposeDagger[expr,$VBundles];
(* On tensors. Complicated construction to avoid confusing repeated indices *)
TransposeDagger[expr:tensor_?xTensorQ[inds___],vbs_]:=If[DaggerQ[tensor],
tensor@@TransposeDagger[IndexList[inds]],
expr];
TransposeDagger[inds_IndexList,vbs_]:=With[{dummies=DummyAs/@inds},
dummies/.TransposeDaggerRules[dummies,vbs]/.Inner[Rule,dummies,inds,List]
];
(* Error on any other type of expression *)
TransposeDagger[expr_,vbs_]:=Throw[Message[TransposeDagger::notyet,"TransposeDagger on objects other than tensors"];ERROR[TransposeDagger[expr,vbs]]];
SetNumberOfArguments[TransposeDagger,{1,2}];
Protect[TransposeDagger];

9.10. Tensors without DefTensor

Let us make use of the head Tensor in a different way. We supply the information about the tensor as different arguments for the tensor

Unprotect[Tensor];
(* Objects with a head Tensor are tensor heads *)
xTensorQ[Tensor[__]]^:=True;
(* Tensor info *)
PrintAs[Tensor[pa_,__]]^:=pa;
SlotsOfTensor[Tensor[pa_,slots_,__]]^:=slots;
DependenciesOfTensor[Tensor[pa_,slots_,deps_,___]]^:=deps;
(* Tensor symmetry info *)
Tensor[pa_,slots_,deps_,other___?OptionQ]:=Tensor[pa,slots,deps,StrongGenSet[{},GenSet[]],other];
Tensor[pa_,slots_,deps_,sym_GenSet,other___]:=Tensor[pa,slots,deps,SchreierSims[{},sym],other];
SymmetryGroupOfTensor[Tensor[args__][inds___]]^:=SymmetryGroupOfTensor[Tensor[args]];
SymmetryGroupOfTensor[Tensor[pa_,slots_,deps_,sym_,___]]^:=sym;
SymmetryGroupOfTensor[Tensor[pa_,slots_,deps_]]^:=StrongGenSet[{},GenSet[]];
(* Other info. TODO: I'm not sure these defaults are the good ones *)
Dagger[tensor:Tensor[_,_,_,_,other___]]^:=Dagger/.CheckOptions[other]/.Dagger->tensor;
DefInfo[Tensor[_,_,_,_,other___]]^:=DefInfo/.CheckOptions[other]/.DefInfo->{"tensor",""};
HostsOf[Tensor[_,_,_,_,other___]]^:=HostsOf/.CheckOptions[other]/.HostsOf->{};
TensorID[Tensor[_,_,_,_,other___]]^:=TensorID/.CheckOptions[other]/.TensorID->{};
(* Protect again *)
Protect[Tensor];

9.11. Tensors and mappings

9.11.0. Comments

In xTensor we rely on the idea that indices are associated to a unique vbundle, and hence in many cases we use the function VBundleOfIndex to extract vbundle information, instead of looking at the tensor heads. Pullback vbundles have their own indices, constructed from normal indices by prepending the name of the map. Hence in this section we always need to be careful about which indices we are using.

PullBack and PushForward are combined constructions based on two elementary actions: precomposition and contraction with the tangent mappings.  If they appear together in the right combinations then it is better to use PullBackTensor/PushForwardTensor notation, which avoids starred indices, but these elementary operations may appear in isolation as well (mainly dealing with non-diffeomorphic mappings), so we need to analyze them. The standard names for these things are terrible.

Suppose we have a general mapping ϕ : M->N, with tangent map dϕ : TM->ϕ*TN. That means that dϕ has indices dϕ[-a, ϕA]. Take fields v[a] and ω[-a] on M and fields V[A] and Ω[-A] on N.

1) We can construct these objects:

	LinearPush[v, dϕ][ ϕA ] = v[a] dϕ[-a, ϕA]	a vector field along a map on the pullback bundle ϕ*TN over M
	
	Precompose[V, ϕ][ϕA]				a pullback section on the pullback bundle ϕ*TN over M

    If those two objects coincide everywhere on M, then we say that v and V are ϕ-related, but in general it will not happen.

2) Then we can construct:
	
	Precompose[Ω, ϕ][-ϕA]			a pullback section on the pullback bundle ϕ*T*N over M
	
	PullBackTensor[Ω, ϕ][-a] = LinearPush[ Precompose[Ω, ϕ], dϕ ][-a] = dϕ[-a, ϕA] Precompose[Ω, ϕ][-ϕA]
							a covector field on T*M over M

3) Now assume that the mapping ϕ is a diffeomorphism, with inverse iϕ and tangent mapping diϕ[-A, iϕa]. Then we can construct many more objects:

	Precompose[v, iϕ][iϕa]				a pullback section on the pullback bundle iϕ*TM over N

	PushForwardTensor[v, ϕ][A] = Precompose[ LinearPush[v, dϕ], iϕ][A] = Precompose[v, iϕ][iϕa] Precompose[dϕ, iϕ][-iϕa, A]
								= Precompose[v, iϕ][iϕa] Inverse[diϕ][iϕa] = LinearPush[ Precompose[v, iϕ], Inverse[diϕ] ][A]
							a vector field on TN over N

	LinearPush[V, diϕ][ iϕa ] = V[A] diϕ[-A, iϕa]	a vector field along a map on the pullback bundle iϕ*TM over N
	
	PushForwardTensor[V, iϕ][a] = Precompose[ LinearPush[V, diϕ], ϕ ][a] = Precompose[V, ϕ][ϕA] Precompose[diϕ, ϕ][-ϕA, a]
							a vector field on TM over M

	Precompose[ω, iϕ][-iϕa]			a pullback section on the pullback bundle iϕ*T*M over N
	
	PullBackTensor[ω, iϕ][-A] = LinearPush[ Precompose[ω, iϕ], diϕ ][-A] = diϕ[-A, iϕa] Precompose[ω, iϕ][-iϕa]
							a covector field on T*N over N

Then it is interesting to note that, as inverses of linear operators,

	Inverse[ dϕ ] = Precompose[ diϕ, ϕ ]
	
	Inverse[ diϕ ] = Precompose[ dϕ, iϕ ]

Note the index configurations

	dϕ[-a, ϕA]	Precompose[ diϕ, ϕ ][-ϕA, a]		both on M

	diϕ[-A, iϕa]	Precompose[ dϕ, iϕ ][-iϕa, A]		both on N

Finally we address the question of how to write the pushforward and pullback of tensors with mixed indices. Take t[a, -b] on M and T[A, -B] on N. Then we can construct

	PushForwardTensor[t, ϕ][A, -B] = LinearPush[ Precompose[t, iϕ], diϕ][A, -B] = Precompose[t, iϕ][iϕa, -iϕb] Inverse[diϕ][-iϕa, A] diϕ[-B, iϕb]
		= PullBackTensor[t, iϕ][A, -B]
	
	PullBackTensor[T, ϕ][a, -b] = LinearPush[ Precompose[T, ϕ], dϕ ][a, -b] =Precompose[T, ϕ][ϕA, -ϕB] Inverse[dϕ][-ϕA, a] dϕ[-b, ϕB]
		= PushForwardTensor[T, iϕ][a, -b]

Is it true that

	Precompose[ LinearPush[T, Inverse[diϕ]], ϕ ] == LinearPush[ Precompose[T, ϕ], dϕ ]

We still have a problem deciding when to write dϕ or Inverse[dϕ], or even their transposes, in the second argument of Linear. Somehow it seems that we need to put the transformation matrix for covectors and use its inverse for vectors. Is that acceptable?

We need four scenarios:

	Contravariant field along a map: 	LinearPush[t, dϕ][ϕA, ϕB]

	Pullback of a covariant field:		LinearPush[ Precompose[Ω, ϕ], dϕ ][-a, -b]

	Pushforward tensor field:		PushForwardTensor[t, ϕ][A, -B]
						= LinearPush[ Precompose[t, iϕ], diϕ][A, -B] = Precompose[t, iϕ][iϕa, -iϕb] Inverse[diϕ][-iϕa, A] diϕ[-B, iϕb]

	Pullback tensor field:			PullBackTensor[T, ϕ][a, -b]
						= LinearPush[ Precompose[T, ϕ], dϕ ][a, -b] =Precompose[T, ϕ][ϕA, -ϕB] Inverse[dϕ][-ϕA, a] dϕ[-b, ϕB]

I have the impression that we need LinearPush[T, L] to figure out whether it needs L or Inverse[L] (or they transposes). Specifying all of them as additional arguments would be a pain. Perhaps the idea could be that we give one of them and let Linear find the rest. The important thing is that it must be a field with the correct dependencies, which determines uniquely whether we need dϕ or diϕ. That is, Linear should never need to call Precompose. If Inverse is needed we will check if L is invertible, and abort if it is not. For actual computations we will prefer to precompute a Jacobian with ϕ to computing inverses of Jacobians.

Note that in the special case in which ϕ=IdentityMapping[M] then the starred indices coincide with the normal indices, and that is way we can write that the differential of IdentityMapping[M] is the delta.

9.11.1. Precomposition with a map

Given a tensor field T (of any character) on a bundle vb with base N and a map ϕ : M->N, we can precompose T with ϕ, denoted Precompose[T, ϕ]. This will be a “tensor field along a map”, a section of a pullback bundle, and hence it will have “starred” indices. We could leave this as SmallCircle[tensor, phis] but it seems simpler to have a function that distinguishes both types of arguments. Actually the SmallCircle notation is accepted in input, but autoconverts to Precompose:

SmallCircle[tensor_?xTensorQ,phis__?MappingQ]:=Precompose[tensor,SmallCircle[phis]];

Basic downvalues:

Precompose[tensor_,_IdentityMapping]:=tensor;
(* Precompose and SmallCircle are essentially the same function, so we keep the order *)
Precompose[Precompose[tensor_,phi1_],phi2_]:=Precompose[tensor,SmallCircle[phi1,phi2]];

Special tensors:

Precompose[Null,phi_]:=Null; (* Null is returned by MetricOfX functions *)
Precompose[Zero,phi_]:=Zero;
Precompose[delta,phi_]:=delta;

Note that Precompose requires two arguments. If there are several mappings then we compose them with SmallCircle.

(* Essential tensor properties *)
xTensorQ[Precompose[tensor_?xTensorQ,phi_?MappingQ]]^:=True;
SlotsOfTensor[Precompose[tensor_,phi_]]^:=PrecomposeVBundles[SlotsOfTensor[tensor],phi];
DependenciesOfTensor[Precompose[tensor_,phi_]]^:=PrecomposeDependencies[DependenciesOfTensor[tensor],phi];
SymmetryGroupOfTensor[Precompose[tensor_,phi_]]^:=SymmetryGroupOfTensor[tensor];
Dagger[Precompose[tensor_,phi_]]^:=Precompose[Dagger[tensor],Dagger[phi]];
WeightOfTensor[Precompose[tensor_,phi_]]^:=PrecomposeWeight[WeightOfTensor[tensor],phi];

(* Particular case *)
VBundleOfMetric[Precompose[metric_,phi_]]^:=PullBackVBundle[VBundleOfMetric[metric],phi];

The first argument of pullmanifold could be a parameter, but a parameter is never the image of a mapping, and hence nothing bad can happen:

(* List of pullback vbundles. Beware there is also PullBackVBundles, which is different *)
PrecomposeVBundles[vbs_List,phi_]:=With[{im=MappingImage[phi]},
If[SubmanifoldQ[BaseOfVBundle[#],im],PullBackVBundle[#,phi],#]&/@vbs
];
(* Pull back dependencies *)
PrecomposeDependency[dep_,phi_]:=If[SubmanifoldQ[dep,MappingImage[phi]],MappingDomain[phi],dep];
PrecomposeDependencies[deps_List,phi_]:=With[{dom=MappingDomain[phi],im=MappingImage[phi]},
If[SubmanifoldQ[#,im],dom,#]&/@deps
];

Formatting.

PrintAs[Precompose[tensor_,phi_]]^:=PrecomposeString[PrintAs[tensor],phi];

Protect:

SetNumberOfArguments[Precompose,2];
Protect[Precompose];

Definitions for weights. Eventually call PrecomposeBasis in xCoba:

PrecomposeWeight[sum_Plus,phi_]:=PrecomposeWeight[#,phi]&/@sum;
PrecomposeWeight[prod_Times,phi_]:=PrecomposeWeight[#,phi]&/@prod;
PrecomposeWeight[n:(_Integer|_Rational|_Real|_Complex),phi_]:=n;
PrecomposeWeight[basis_?BasisQ,phi_]:=xAct`xCoba`PrecomposeBasis[basis,phi];

9.11.2. PullBackTensor

PullBackTensor[T, ϕ], for T with base N and ϕ : M -> N, represents a tensor field on M, with indices of TM and -TM, and not a pullback section. If T has contravariant indices then this only makes sense for invertible mappings ϕ.

PullBackTensor[tensor_?xTensorQ,_IdentityMapping]:=tensor;
PullBackTensor[delta,phi_?MappingQ]:=delta;

We could have a consistency check between the arguments of PullBackTensor. And we should also check invertibility of ϕ when needing to pull back a contravariant index.

Note that this is not equal to PrecomposeVBundles:

PullBackVBundles[vbs_List,phi_]:=With[{tdom=Tangent[MappingDomain[phi]],tim=Tangent[MappingImage[phi]]},
Which[SameQ[#,tim],tdom,SameQ[#,-tim],-tdom,True,#]&/@vbs
];

xTensorQ[PullBackTensor[tensor_?xTensorQ,phi_?MappingQ]]^:=True;
SlotsOfTensor[PullBackTensor[tensor_?xTensorQ,phi_?MappingQ]]^:=PullBackVBundles[SlotsOfTensor[tensor],phi];(* We could generalize this by using SubmanifoldQ, instead of equality *)
DependenciesOfTensor[PullBackTensor[tensor_?xTensorQ,phi_?MappingQ]]^:=PrecomposeDependencies[DependenciesOfTensor[tensor],phi];
SymmetryGroupOfTensor[PullBackTensor[tensor_?xTensorQ,phi_?MappingQ]]^:=SymmetryGroupOfTensor[tensor];
Dagger[PullBackTensor[tensor_?xTensorQ,phi_?MappingQ]]^:=PullBackTensor[Dagger[tensor],Dagger[phi]];

(* Particular case *)
VBundleOfMetric[PullBackTensor[metric_,phi_]]^:=Tangent[MappingDomain[phi]]/;VBundleOfMetric[metric]===Tangent[MappingImage[phi]];

Formatting.

PrintAs[PullBackTensor[tensor_,phi_]]^:=PullBackString[PrintAs[tensor],phi];

9.11.3. LinearPush

LinearPush[T, dϕ] for ϕ : M->N represents a section of the pullback vbundle ϕ*TN. This is constructed by linear contraction with dϕ, the tangent mapping of ϕ, for contravariant slots of T, and with its inverse for covariant slots of T. Hence this operation is not well defined for covariant slots if the mapping is not locally invertible (both sides? Or is it possible to define it with a one-sided derivative? QUESTION. I guess the one-sided cases is also valid, but probably only for immersions or only for submersions, and I don’t know which one. For the moment I do both and see what happens).

(* TODO: Will the delta have a starred index? *)
LinearPush[tensor_?xTensorQ,delta]:=tensor;

xTensorQ[LinearPush[tensor_?xTensorQ,dphi_?xTensorQ]]^:=True;
SlotsOfTensor[LinearPush[tensor_?xTensorQ,dphi_?xTensorQ]]^:=LinearPushVBundles[SlotsOfTensor[tensor],dphi];
DependenciesOfTensor[LinearPush[tensor_?xTensorQ,dphi_?xTensorQ]]^:=DependenciesOfTensor[tensor];
SymmetryGroupOfTensor[LinearPush[tensor_?xTensorQ,dphi_?xTensorQ]]^:=SymmetryGroupOfTensor[tensor];
Dagger[LinearPush[tensor_?xTensorQ,dphi_?xTensorQ]]^:=LinearPush[Dagger[tensor],Dagger[dphi]];
WeightOfTensor[LinearPush[tensor_?xTensorQ,dphi_?xTensorQ]]^:=Throw@Print["TODO: WeightOfTensor[LinearPush[tensor,dphi]]"];

LinearPush::cova="Cannot push covariant slot `1` with differential `2` because the latter is not invertible.";

TODO: Probably here we only need either left-invertibility or right-invertibility, but I’m not sure which one:

(* List of pullback vbundles, by pushing *)
LinearPushVBundles[vbs_List,dphi_]:=With[{tdom=-SlotsOfTensor[dphi][[1]],ptim=SlotsOfTensor[dphi][[2]]},
If[SameQ[tdom,UpIndex[#]],
If[UpIndexQ[#],ptim,
If[InvertibleQ[dphi],-ptim,
Throw@Message[LinearPush::cova,#,dphi]
]
],
#]&/@vbs
];

Formatting.

PrintAs[LinearPush[tensor_,dphi_]]^:=LinearPushString[PrintAs[tensor],dphi];

9.11.4. PushForwardTensor

PushForwardTensor[tensor_?xTensorQ,_IdentityMapping]:=tensor;

xTensorQ[PushForwardTensor[tensor_?xTensorQ,phi_?MappingQ]]^:=True;
SlotsOfTensor[PushForwardTensor[tensor_?xTensorQ,phi_?MappingQ]]^:=PushVBundles[SlotsOfTensor[tensor],phi];
DependenciesOfTensor[PushForwardTensor[tensor_?xTensorQ,phi_?MappingQ]]^:=DependenciesOfTensor[tensor];
SymmetryGroupOfTensor[PushForwardTensor[tensor_?xTensorQ,phi_?MappingQ]]^:=SymmetryGroupOfTensor[tensor];
Dagger[PushForwardTensor[tensor_?xTensorQ,phi_?MappingQ]]^:=PushForwardTensor[Dagger[tensor],Dagger[phi]];
WeightOfTensor[PushForwardTensor[tensor_?xTensorQ,phi_?MappingQ]]^:=PushForwardBasis[WeightOfTensor[tensor],phi];

(* Change tangent bundle of the domain to tangent bundle of the image *)
PushVBundles[vbs_List,phi_]:=With[{tdom=Tangent[MappingDomain[phi]],tim=Tangent[MappingImage[phi]]},
Which[SameQ[tdom,#],tim,SameQ[-tdom,#],-tim,True,#]&/@vbs
];

PushForwardBasis[basisorweight_,phi_]:=Throw@Print["TODO: PushForwardBasis[basis-or-weight, phi]"];

Formatting.

PrintAs[PushForwardTensor[tensor_,phi_]]^:=PushForwardString[PrintAs[tensor],phi];

9.11.5. The tangent map

I’m not sure whether TangentTensor is the best name. Perhaps it should be DMapping or DMappingTensor.

TangentTensor: for ϕ register dϕ, represented as dϕ. Note that we use ToString instead of PrintAs to construct the output string of the mapping. This is to avoid the confusing d(ϕ^(-1)), which looks like the inverse of dϕ, while we mean the d of (ϕ^(-1)). We prefer to have diϕ.

TangentTensor[phi_Symbol?MappingQ]:=GiveSymbol[TangentTensor,phi];
GiveSymbol[TangentTensor,phi_Symbol?MappingQ]:=SymbolJoin["d",phi];
PrintAsCharacter[TangentTensor]="\[DifferentialD]";
(* Exception to general GiveOutputString to use ToString instead of PrintAs *)
GiveOutputString[TangentTensor,phi_Symbol?MappingQ]:=StringJoin[PrintAsCharacter[TangentTensor],ToString[phi]];

The tangent map of a composition can only be expanded if we know the indices, because otherwise we would need index-free contractions. We do not check that the indices belong to the expected vbundles. That’s the user responsibility:

TangentTensor[SmallCircle[phirest__,phi_]][ind1_,ind2_]:=With[{dummy=DummyIn[PullBackVBundle[Tangent[MappingImage[phi]],phi]]},
TangentTensor[phi][ind1,dummy]Precompose[TangentTensor[SmallCircle[phirest]],phi][-dummy,ind2]
];

9.11.6. Invertibility

InvertibleQ[op_?xTensorQ]:=InvertibleQ[op,Left]&&InvertibleQ[op,Right];
InvertibleQ[op_?xTensorQ,Left|Right]:=False;
InvertibleQ[op_,Left|Right]:=Throw@Message[InvertibleQ::unknown,"2-tensor",op];
SetNumberOfArguments[InvertibleQ,{1,2}];
Protect[InvertibleQ];

9.12. Tensors by blocks

9.12.0. Comments

The main idea is to generalize the CTensor construction to have full tensorial instead of just scalar components. It could be something like

	BlockTensor[ { v[i], w[a] }, { {X[-i], Y[-a]} } ][ μ ]

and that would be a representation of

	v[i] X[-i, μ] + w[a] Y[-a, μ]

From that point of view

	CTensor[ { v1, v2 }, { B } ]

means

	BlockTensor[ { v1, v2 }, { {Basis[{1, -B}], Basis[{2, -B}]} } ]

That is, the basis B represents the list of its vectors, in index-free form. This is quite reasonable. Why in index-free form? Shouldn’t we do that in full indexed form for generality? There would not be any ambiguity because the objects in the list of “projectors” would all have 2 indices. One is either a c-index or an index contracted with the array. The other one would be a free ultraindex, and it must be common to all elements of the list.

This notation naturally suggests to use the outer projectors X, Y, and not the inner projectors P, Q. What could be a good notation in which the latter are natural? What about something like this?

	BlockTensor[ { V[α], W[τ] }, { {P[-α], Q[-τ] } }][ μ ]

We see that we still need some way to communicate v[i] with V[α]. For instance V = Projected[ v, {P} ] and v = Projected[ V, {dualX} ], where I don’t remember the name we were using for dualX. I’m not sure about this use of BlockTensor because the tensors in the array could still be fully general, with no clear meaning of “block” before they are actually projected with the projectors.

Here we are about to find our old problem of how to canonicalize expressions with projected expressions, because it is difficult to do it with the notation Projected[T, {P1, P2, ...}]. Perhaps we need to switch to a “projected indices” notation temporarily to use ToCanonical and then go back. Somehow I have the feeling that what we need is some theory of projected vbundles, or subvbundles, that we were trying to avoid...

9.12.1. Main definitions

xTensorQ[BlockTensor[array_]]^:=True;
SlotsOfTensor[BlockTensor[array_]]^:=With[{slotarray=Map[SlotsOfTensor,array,{ArrayDepth[array]}]},
TODO
];

Formatting:

BlockGridBox[vector_?VectorQ]:=GridBox[List/@vector,RowLines->True,ColumnLines->True];
BlockGridBox[matrix_?MatrixQ]:=GridBox[matrix,RowLines->True,ColumnLines->True];
BlockGridBox[array_?ArrayQ]:=BlockGridBox[Map[BlockGridBox,array,{2}]];

PrintAs[BlockTensor[array_]]^:=RowBox[{"(",BlockGridBox[Map[PrintAs,array,{ArrayDepth[array]}]],")"}];

9.12.2. Special cases

Construct a superdiagonal tensor of a given rank:

DiagonalArray[diagonal_List,rank_,zero_:Zero]:=Normal@SparseArray[Band@ConstantArray[1,rank]->diagonal,ConstantArray[Length[diagonal],rank],zero];

9.12.3. Direct sum indices (an idea, not in the package)

VBundleOfIndex[ind_CirclePlus]^:=VBundleOfIndex/@ind;

Main property. This is problematic because if there are several CirclePlus indices, the resulting arrays may be transposed depending on the order in which the various indices are expanded.

CirclePlus/:tensor_?xTensorQ[il___,ind_CirclePlus,ir___]:=tensor[il,#,ir]&/@List@@ind;

9.13. Projectors

9.13.0. Comments

This is a project in collaboration with Guillaume Faye. We try to incorporate in xTensor a subsystem which allows defining a decomposition of the delta tensor into a sum of (currently two) projectors and then let the system compute everything related to that decomposition. This could have multiple applications. Comments:

1) There is a major problem to solve: the notation for a projected tensor. If P,Q are the projectors, a simple and natural option would be to store the projection in the indices, something like T[ P[a], -Q[b] ]. However there are serious problems with that choice. The most important is that contractions like T[a, b] T[ -P[a], -c ] would be difficult to handle in general. From the point of view of free indices, an expression like T[ P[a] ] + T[ Q[a] ] would be difficult to accept in the current xTensor, because we would be reporting inhomogeneous indices { P[a], Q[a] }. The problem is that P in T[ P[a] ] actually is part of the tensor T[ P[#] ] with index a, and not the tensor T[#] with index P[a]. This change of philosophy would need a major rewriting of xTensor.

For the moment we shall work with explicit projectors, as in P[-a, b] v[-b], instead of trying v[ -P[a] ]. It would not be difficult to develop a ContractProjector function, storing the information as Projected[ v, {P} ][-a].

2) Another issue is whether we want to work with "inner" projectors P[-a, b], Q[-a, b] or with "outer" projectors X[-i, a], etc. In principle we want both things.

3) Canonicalization with the Projected[...][...] notation would be difficult, and hence it would be simpler to switch temporarily to explicit expressions and then contract the projectors again.

4) The programming needs several steps:
	a) The algebra of inner projectors in a vector space.
	b) Metrics and orthogonal projectors.
	c) The algebra of mixing inner and outer projectors in several vector spaces.
	d) Projector fields and their derivatives.
	e) Integrability of projector fields and relation to vbundle splitting.
	f) Canonicalization of expressions with projectors.
Here we handle the algebraic aspects of projection, deferring the analytical aspects to the section on derivatives.

9.13.1. MakeProjectors

We start by defining a set of complementary inner projectors on a vbundle. The vbundle is read from the indices of the tensors. Checking syntax for all tensors in the list of projectors is complicated. Hence, it is simpler to require that all those projectors already exist as tensors, and use this function to set them as projectors. This also allows more freedom in specifying individual properties for the tensors, like dependencies, the PrintAs form, etc. At input time we need to specify the dimensions of the subspaces, and optionally the metric with respect to which they are orthogonal. It is important to note that with projectors in the presence of a metric we must first define the metric and then use MakeProjectors, and not viceversa, because otherwise not all appropriate definitions are loaded.

$Projectors={};

General::nomet="Invalid index configuration of  `1`.";

Options[MakeProjectors]={OrthogonalWithMetric->Null};
MakeProjectors[projectors_,dims_,options:OptionsPattern[]]:=Module[{complementary,heads,vbundle,inds,owm,fm},
{owm}=OptionValue[{OrthogonalWithMetric}];

{heads,vbundle}=CheckMakeProjectors[projectors,dims,owm];
xUpSet[ProjectorQ[#],True]&/@heads;
$Projectors=Join[$Projectors,heads];
If[owm=!=Null,Set[OrthogonalWithMetricQ[#,owm],True]&/@heads];

inds=GetIndicesOfVBundle[vbundle,3];

fm=FirstMetricOfVBundle[vbundle,False];

(* Orthogonal projectors are symmetric *)
If[fm=!=Null&&fm===owm,xUpSet[SymmetryGroupOfTensor[#],Symmetric[{1,2}]]&/@heads];

With[{mu=inds[[1]],nu=inds[[2]],lambda=inds[[3]],metric=fm},

(* Properties of a single projector *)
complementary[head_,head_]:=(
xTagSet[{head,head[mu_,lambda_]head[-lambda_,nu_]},head[mu,nu]];
If[metric===Null,
head[a_Symbol,b_Symbol]:=$Failed/;Message[Validate::nomet,Unevaluated[head[a,b]]];
head[-a_Symbol,-b_Symbol]:=$Failed/;Message[Validate::nomet,Unevaluated[head[-a,-b]]];
head[a_Symbol,-b_Symbol]:=$Failed/;Message[Validate::nomet,Unevaluated[head[a,-b]]];,
xTagSet[{head,head[mu_,-lambda_]head[lambda_,nu_]},head[mu,nu]];
If[metric===owm,
xTagSet[{head,head[lambda_,mu_]head[-lambda_,nu_]},head[mu,nu]];
xTagSet[{head,head[mu_,lambda_]head[nu_,-lambda_]},head[mu,nu]];
xTagSet[{metric,Projected[metric,{head,head}]},head];
]]
);
(* Properties of pairs of projectors *)
complementary[head1_,head2_]:=(
ComplementaryProjectorsQ[head1,head2]=True;
ComplementaryProjectorsQ[head2,head1]=True;
xTagSet[{head1,head1[mu_,lambda_]head2[-lambda_,nu_]},0];
If[fm=!=Null,
xTagSet[{head1,head1[mu_,-lambda_]head2[lambda_,nu_]},0];
If[fm===owm,
xTagSet[{head1,head1[lambda_,mu_]head2[-lambda_,nu_]},0];
xTagSet[{head1,head1[mu_,lambda_]head2[nu_,-lambda_]},0];
xTagSet[{metric,Projected[metric,{head1,head2}]},Zero];
]]
);

Outer[complementary,heads,heads];

(* Set dimensions *)
Inner[xTagSet[{#1,#1[-mu_,mu_]},#2]&,heads,dims,List];
If[metric=!=Null,
Inner[xTagSet[{#1,#1[mu_,-mu_]},#2]&,heads,dims,List]
];

];

];

ComplementaryProjectorsQ[_,_]:=False;
OrthogonalWithMetricQ[_,_]:=False;

CheckMakeProjectors[projectors_,dims_,owm_]:=Module[{heads,vbundle},

(* Check we have a list of at least two elements *)
If[Head[projectors]=!=List,Throw@Message[MakeProjectors::invalid,projectors,"list of projectors"]];
If[Length[projectors]<2,Throw@Message[MakeProjectors::error,"A list of projectors must have at least two elements."]];
(* Check that the heads are tensors *)
heads=Head/@projectors;
If[!xTensorQ[#],Throw@Message[MakeProjectors::invalid,#," is not a tensor."]]&/@heads;
(* Check that the indices belong to the same vbundle. We require down-up objects *)
vbundle=VBundleOfIndex[projectors[[1,2]]];

(* Check we have a list of dimensions of correct length *)
If[Head[dims]=!=List,Throw@Message[MakeProjectors::invalid,dims,"list of dimensions"]];
If[Length[dims]=!=Length[projectors],Throw@Message[MakeProjectors::error,"List of dimensions has wrong length."]];
If[Not@Apply[And,ConstantQ/@dims],Throw@Message[MakeProjectors::invalid,dims,"list of constants"]];
If[Plus@@dims=!=DimOfVBundle[vbundle],Throw@Message[MakeProjectors::error,"Dimensions do not add up to the dimension of the complete vbundle."]];

(* Check metric *)
If[owm=!=Null && !FirstMetricQ[owm,vbundle],Throw@Message[MakeProjectors::invalid,owm,"first metric"]];

(* Return heads and vbundle *)
{heads,vbundle}
];

BeginExamples[]

DefManifold[S2,2,{a,b,c,d,e,f,g}]

DefTensor[ProjP[-a,b],S2,PrintAs->"P"]

DefTensor[ProjQ[-a,b],S2,PrintAs->"Q"]

MakeProjectors[{ProjP[-a,b],ProjQ[-a,b]}]

Outer[Times,{ProjP[-a,b],ProjQ[-a,b]},{ProjP[-b,c],ProjQ[-b,c]}]//MatrixForm

ProjectorQ[ProjP]

UndefTensor/@{ProjP,ProjQ};

UndefManifold[S2]

EndExamples[]

9.13.2. The Projected head

We shall admit tensors of the form Projected[T,{P,Q,delta}][a,b,c]. We need functions ToProjected / FromProjected. It is not convenient to use ContractProjector / SeparateProjector because not every index can be separated; only those of Projected expressions. Properties of the projected head:

1) Projected expressions are tensors:

xTensorQ[Projected[tensor_,projs_]]^:=xTensorQ[tensor];

QUESTION: Perhaps we should map the projectors onto the vbundles of the tensor?

SlotsOfTensor[Projected[tensor_,projs_]]^:=SlotsOfTensor[tensor];

By default, projected heads are printed as the original tensor, because the projected character is represented in the indices.

PrintAs[Projected[tensor_,projs_]]^:=PrintAs[tensor];

2) Full delta projection returns the tensor:

Projected[tensor_,{delta...}][inds___]:=tensor[inds];

Any Zero (by composition of projectors) gives zero:

Projected[_,{___,Zero,___}][___]:=0;

3) The Projected head on delta gives back the projectors.

Projected[delta,{proj_,proj_}][a_,b_]:=proj[a,b];
Projected[delta,{delta,proj_}][a_,b_]:=proj[a,b];
Projected[delta,{proj_,delta}][a_,b_]:=proj[a,b];
Projected[delta,{proj1_,proj2_}][a_,b_]:=0/;ComplementaryProjectorsQ[proj1,proj2];

Thread over sums of projectors:

Projected[tensor_,{projsL___,sum_Plus,projsR___}][inds___]:=Projected[tensor,{projsL,#,projsR}][inds]&/@sum;
Projected[tensor_,{projsL___,sum_SeriesData,projsR___}][inds___]:=SeriesDataMap[Projected[tensor,{projsL,#,projsR}][inds]&,sum];

Projected[tensor_,expr:(_Plus|_?ProjectorQ)][inds___]:=Projected[tensor,expr&/@{inds}][inds];

4) Contractions in the same Projected head. Currently we assume there is just one set of projectors.

(* up-down contraction *)
(expr:Projected[tensor_,projs_][left___,a_,center___,-a_,right___]):=With[{lproj=projs[[Length[{left,a}]]],rproj=projs[[Length[{left,a,center,-a}]]]},
Which[
ComplementaryProjectorsQ[lproj,rproj],0,
lproj===delta,ReleaseHold@ReplacePart[Hold[expr],rproj,{1,0,2,Length[{left,a}]}],
rproj===delta,ReleaseHold@ReplacePart[Hold[expr],lproj,{1,0,2,Length[{left,a,center,-a}]}]
]/;lproj=!=rproj
];
(* down-up contraction *)
(expr:Projected[tensor_,projs_][left___,-a_,center___,a_,right___]):=With[{lproj=projs[[Length[{left,a}]]],rproj=projs[[Length[{left,a,center,-a}]]]},
Which[
ComplementaryProjectorsQ[lproj,rproj],0,
lproj===delta,ReleaseHold@ReplacePart[Hold[expr],rproj,{1,0,2,Length[{left,-a}]}],
rproj===delta,ReleaseHold@ReplacePart[Hold[expr],lproj,{1,0,2,Length[{left,-a,center,a}]}]
]/;lproj=!=rproj
];

5) Contraction of two Projected expressions, again assuming that there is a single set of projectors.

Projected/:(expr1:Projected[tensor1_,projs1_][left1___,a_,___])(expr2:Projected[tensor2_,projs2_][left2___,-a_,___]):=With[{proj1=projs1[[Length[{left1,a}]]],proj2=projs2[[Length[{left2,-a}]]]},
Which[
ComplementaryProjectorsQ[proj1,proj2],0,
proj1===delta,ReleaseHold@ReplacePart[Hold[expr1],proj2,{1,0,2,Length[{left1,a}]}]expr2,
proj2===delta,ReleaseHold@ReplacePart[Hold[expr2],proj1,{1,0,2,Length[{left2,-a}]}]expr1
]/;proj1=!=proj2
];

6) Contractions of products of Projected expressions and projectors. Note once again that this assumes there is only one set of projectors. It is not completely clear that this is an operation which we want to happen automatically.

(* Upper index in the Projected expression *)
Projected/:Projected[tensor_,projs_][left___,a_,right___]projector_?ProjectorQ[-a_,b_]:=With[{proj=projs[[Length[{left,a}]]]},Which[
ComplementaryProjectorsQ[proj,projector],0,
proj===projector,Projected[tensor,projs][left,b,right],
proj===delta,ReplacePart[Projected[tensor,projs][left,b,right],projector,{0,2,Length[{left,a}]}]
]
];
(* Lower index in the Projected expression *)
Projected/:Projected[tensor_,projs_][left___,-b_,right___]projector_?ProjectorQ[-a_,b_]:=With[{proj=projs[[Length[{left,-b}]]]},Which[
ComplementaryProjectorsQ[proj,projector],0,
proj===projector,Projected[tensor,projs][left,-a,right],
proj===delta,ReplacePart[Projected[tensor,projs][left,-a,right],projector,{0,2,Length[{left,-b}]}]
]
];

(* Upper index in the Projected expression *)
Projected/:Projected[tensor_,projs_][left___,a_,right___]projector_?ProjectorQ[b_,-a_]:=With[{proj=projs[[Length[{left,a}]]]},Which[
ComplementaryProjectorsQ[proj,projector],0,
proj===projector,Projected[tensor,projs][left,b,right],
proj===delta,ReplacePart[Projected[tensor,projs][left,b,right],projector,{0,2,Length[{left,a}]}]
]
]/;orthoQ[projector,a];
(* Lower index in the Projected expression *)
Projected/:Projected[tensor_,projs_][left___,-b_,right___]projector_?ProjectorQ[b_,-a_]:=With[{proj=projs[[Length[{left,-b}]]]},Which[
ComplementaryProjectorsQ[proj,projector],0,
proj===projector,Projected[tensor,projs][left,-a,right],
proj===delta,ReplacePart[Projected[tensor,projs][left,-a,right],projector,{0,2,Length[{left,-b}]}]
]
]/;orthoQ[projector,a];

7) Projected automatically introduces Projected in other expressions it is contracted with, if they do not already have the Projected head.

Projected/:(expr1:Projected[tensor1_,projs1_][left1___,a_,right1___])(expr2:tensor2_?xTensorQ[left2___,-a_,right2___]):=expr1 Projected[tensor2,ReplacePart[Table[delta,{Length[expr2]}],projs1[[Length[{left1,a}]]],Length[{left2,-a}]]][left2,-a,right2]/;Head[tensor2]=!=Projected;

8) Composition of two Projected heads:

ComposeProjectors[proj_,proj_]:=proj;
ComposeProjectors[delta,proj_]:=proj;
ComposeProjectors[proj_,delta]:=proj;
ComposeProjectors[proj1_,proj2_]:=Zero/;ComplementaryProjectorsQ[proj1,proj2];
ComposeProjectors[projs1___,ComposeProjectors[projs2__],projs3___]:=ComposeProjectors[projs1,projs2,projs3];

Projected[Projected[tensor_,projs1_],projs2_]:=Projected[tensor,Inner[ComposeProjectors,projs1,projs2,List]];

BeginExamples[]

DefManifold[S2,2,{a,b,c,d,e,f,g}]

DefTensor[ProjP[-a,b],S2,PrintAs->"P"]

DefTensor[ProjQ[-a,b],S2,PrintAs->"Q"]

xATP`MakeProjectors[{ProjP[-a,b],ProjQ[-a,b]}]

DefTensor[T[a,b,c],S2]

xATP`SSSBinds[{a,b,-c},{ProjP,delta,ProjQ}]

Projected[T,{ProjP,delta,ProjQ}][a,b,-c]

Projected[T,{ProjP,delta,ProjQ}][a,b,c]Projected[T,{ProjP,delta,ProjQ}][-a,-d,-e]

Projected[T,{ProjP,delta,ProjQ}][a,b,c]Projected[T,{ProjQ,delta,ProjQ}][-a,-d,-e]

Projected[T,{ProjP,delta,ProjQ}][a,b,c]Projected[T,{delta,delta,ProjQ}][-a,-d,-e]

UndefTensor/@{ProjP,ProjQ,T};

UndefManifold[S2]

EndExamples[]

9.13.3. Project

There are two ways in which this function could be programmed. The first one is through explicit multiplication with projectors. The second one is through the use of Projected. A second issue is what to do with dummy indices.

Project[expr_,proj_]:=Project[expr,proj,IndicesOf[Free]];
Project[expr_,proj_,f_IndicesOf]:=Project[expr,proj,f[expr]];
Project[expr_,proj_,inds_IndexList]:=Fold[Project[#1,proj,#2]&,expr,inds];
Project[expr_Plus,args__]:=Project[#,args]&/@expr;
Project[expr_SeriesData,args__]:=SeriesDataMap[Project[#,args]&,expr];
Project[expr_,proj_?ProjectorQ,ind_?GIndexQ]:=expr/.tensor_?xTensorQ[left___,ind,right___]:>With[{dummy=DummyAs[ind]},tensor[left,dummy,right]proj@@If[UpIndexQ[ind],{-dummy,ind},{ind,-dummy}]]/;VBundleOfIndex[ind]===SlotsOfTensor[proj][[2]];
Project[expr_,projs:{___?ProjectorQ},ind_?GIndexQ]:=expr/.tensor_?xTensorQ[left___,ind,right___]:>With[{dummy=DummyAs[ind]},tensor[left,dummy,right]Through[(Plus@@projs)@@If[UpIndexQ[ind],{-dummy,ind},{ind,-dummy}]]]/;VBundleOfIndex[ind]===Union[SlotsOfTensor/@projs][[1,2]];

SetNumberOfArguments[Project,{1,3}];
Protect[Project];

9.13.4. ContractProjector

0) Main driver:

Options[ContractProjector]={OverDerivatives->False};
ContractProjector[expr_,projs_List,options___]:=Fold[ContractProjector[#1,#2,options]&,expr,projs];
ContractProjector[expr_,proj_Symbol?ProjectorQ,options:OptionsPattern[]]:=ContractProjector0[OptionValue[OverDerivatives],proj][expr];
ContractProjector[expr_,proj_Symbol,options___]:=Throw@Message[ContractProjector::unknown,"projector",proj];
ContractProjector[expr_,options___?OptionQ]:=ContractProjector[expr,$Projectors,options];
SetNumberOfArguments[ContractProjector,{1,Infinity}];
Protect[ContractProjector];

1) Expand products. QUESTION: is this really needed?

ContractProjector0[case__][expr_Times]:=ContractProjector1[case][MathInputExpand[expr]];
ContractProjector0[case__][expr_]:=ContractProjector1[case][expr];

2) First we have some definitions which do not perform any actual contraction, but refer to themselves recursively:

(* Automatic threading *)
ContractProjector1[case__][expr_Plus]:=ContractProjector0[case]/@expr;
ContractProjector1[case__][expr_SeriesData]:=SeriesDataMap[ContractProjector0[case],expr];
ContractProjector1[case__][list_List]:=ContractProjector0[case]/@list;
ContractProjector1[case__][eq_Equal]:=ContractProjector0[case]/@eq;

3) Contractions with tensors. If the projector is orthogonal with respect to the first metric then we do not have to worry about index positions. However, if the projector is not orthogonal then we need to ensure that Projected acts on the original tensor. Generalize to PairQ to have contractions under all types of indices.

orthoQ[proj_,ind_]:=OrthogonalWithMetricQ[proj,FirstMetricOfVBundle[VBundleOfIndex[ind],False]];
originalQ[tensor_,slot_]:=SignedVBundleOfIndex[tensor[[slot]]]===SlotsOfTensor[Head[tensor]][[slot]];

(* Original projectors: Orthogonal projectors or original tensors *)
(CP:ContractProjector1[od_,proj_])[rest_. proj_[a_,b_] T:(tensor_?xTensorQ[left___,-b_,right___])]:=CP[rest Projected[tensor,ReplacePart[Table[delta,{Length[T]}],proj,Length[{left,-b}]]][left,a,right]]/;orthoQ[proj,b]||originalQ[T,Length[{left,-b}]];
(CP:ContractProjector1[od_,proj_])[rest_. proj_[-a_,b_] T:(tensor_?xTensorQ[left___,a_,right___])]:=CP[rest Projected[tensor,ReplacePart[Table[delta,{Length[T]}],proj,Length[{left,a}]]][left,b,right]]/;orthoQ[proj,a]||originalQ[T,Length[{left,a}]];

(* Non-original projectors: Orthogonal projectors or not original tensors *)
(CP:ContractProjector1[od_,proj_])[rest_. proj_[b_,a_] T:(tensor_?xTensorQ[left___,-b_,right___])]:=CP[rest Projected[tensor,ReplacePart[Table[delta,{Length[T]}],proj,Length[{left,-b}]]][left,a,right]]/;orthoQ[proj,b]|| !originalQ[T,Length[{left,-b}]];
(CP:ContractProjector1[od_,proj_])[rest_. proj_[b_,-a_] T:(tensor_?xTensorQ[left___,a_,right___])]:=CP[rest Projected[tensor,ReplacePart[Table[delta,{Length[T]}],proj,Length[{left,a}]]][left,b,right]]/;orthoQ[proj,a]||!originalQ[T,Length[{left,a}]];

There are two more cases to solve, in which it is not clear what to do: non-orthogonal projects with a contraction between either an original tensor and a non-original projector or viceversa a non-original tensor with an original projector. The idea is that if there is a metric between the original tensor and the original projector then the notation Projected[T,{P}] cannot accommodate the situation.

Fall back definition, used when none of the above holds :

ContractProjector1[_,_][expr_]:=expr;

9.13.5. FromProjected

This is the opposite action to ContractProjector. We want to extract projector from Projected expressions, and hence changing the character of the index on the tensor. We need to introduce a new index, which could be an abstract index or a basis index for a given basis. The syntax is complicated because we need three pieces of information on top of the expression: SeparateMetric[metric, basis][expr, indices]

FromProjected[expr_]:=expr/.Projected[tensor_,projs_List][inds___]:>BreakProjected[tensor,projs][inds];

BreakProjected[tensor_,projs_][inds___]:=
Times[Times@@#1,tensor@@#2]&@@Transpose[ArrangeProjector/@Transpose[{projs,{inds},DummyAs/@{inds}}]];
ArrangeProjector[{proj_,ind_Symbol,dummy_}]:={proj[-dummy,ind],dummy};
ArrangeProjector[{proj_,-ind_Symbol,dummy_}]:={proj[-ind,-dummy],dummy};

SetNumberOfArguments[FromProjected,1];
Protect[FromProjected];

9.13.1. SetSplitTensors. Old, but still functional

Now that we can decompose a vbundle on subvbundles, we introduce the "split-tensors" relating them. We shall use special tensors called "split-tensors", with an index in the "ambient" vbundle and another index in the subvbundle. In order to reuse the same split-tensors in different projections, the tensors must have been defined before. We do not name the whole set, and work (currently) with a single one. A split-tensor is called upspt if its index on the projected subvbundle is an upper index, and subspt if it is a lower index.

(* Main function *)
SetSplitTensors[vbundle_,spts_List]:=Module[{structure=checksplittensors[vbundle,spts],upspts,downspts,projs},
upspts=Cases[structure,{_Symbol,_}];
downspts=Cases[structure,{-_Symbol,_}];

(* Construct relations among projectors *)
projs=Diagonal@Outer[defproj[vbundle],upspts,downspts,1];

(* Construct relations among ambient projectors *)
Outer[defproj2[vbundle],projs,projs];

];
(* Same subspace *)
defproj[vbundle_][{vb_,upspt_},{-vb_,downspt_}]:=With[{vbundleQ=VBundleIndexQ[vbundle],vbQ=VBundleIndexQ[vb],proj=GiveSymbol[Projector,upspt,downspt]},
Module[{mu,nu},

(* Define inner projector *)
{mu,nu}=GetIndicesOfVBundle[vbundle,2];
DefTensor[proj[-mu,nu],BaseOfVBundle[vbundle]];

(* Products of split-tensors *)
TagSet[downspt,downspt[-b_,mu_]upspt[-mu_?vbundleQ,a_],delta[-b,a]];
TagSet[upspt,upspt[-mu_,a_]downspt[-a_?vbQ,nu_],proj[-mu,nu]];

(* Store split-tensors and projectors in a private function *)
VBundleProjector[vbundle,vb,xAct`xTensor`Down]=downspt;
VBundleProjector[vbundle,vb,xAct`xTensor`Up]=upspt;
VBundleProjector[vbundle,vb,Inner]=proj;

(* Return inner projector *)
proj
]
];
VBundleProjector[vb_,vb_,Inner]:=delta;
VBundleProjector[vbundle_,vb_,_]:=Throw@Message[SplitTensor::error,"Unknown projector from "<>ToString[vbundle]<>" to "<>ToString[vb]<>"."];
(* Different subspaces *)
defproj[vbundle_][{_,upspt_},{-_,downspt_}]:=With[{vbundleQ=VBundleIndexQ[vbundle]},
TagSet[downspt,downspt[-b_,mu_]upspt[-mu_?vbundleQ,a_],0]
];
(* Ambient projectors: same subspace *)
defproj2[vbundle_][proj_,proj_]:=With[{vbundleQ=VBundleIndexQ[vbundle]},
TagSet[proj,proj[-mu_,lambda_]proj[-lambda_?vbundleQ,nu_],proj[-mu,nu]]];
(* Ambient projectors: different subspace *)
defproj2[vbundle_][proj1_,proj2_]:=With[{vbundleQ=VBundleIndexQ[vbundle]},
TagSet[proj1,proj1[-mu_,lambda_]proj2[-lambda_?vbundleQ,nu_],0];
TagSet[proj2,proj2[-mu_,lambda_]proj1[-lambda_?vbundleQ,nu_],0];
];

The name of the inner projector associated to the up-split-tensor Y and the down-split-tensor X is given by:

GiveSymbol[Projector,Y_,X_]:=SymbolJoin[Y,X];

This checks that the given list of split-tensors is consistent, and compatible with the splitting, previously defined, of the ambient vbundle.

checksplittensor[vbundle_][spt_[-a_Symbol,b_Symbol]]:=With[{vba=VBundleOfIndex[a],vbb=VBundleOfIndex[b]},
Which[
!xTensorQ[spt],Throw@Message[DefSplitTensors::unknown,"tensor",spt],
vba===vbundle&&SubvbundleQ[vbundle,vbb],{vbb,spt},
vbb===vbundle&&SubvbundleQ[vbundle,vba],{-vba,spt},
True,Throw@Message[DefSplitTensors::invalid,"split-tensor",spt[-a,b]]
]
];
checksplittensor[_][spt_]:=Throw@Message[DefSplitTensors::invalid,spt,"split-tensor"];
checksplittensors[vbundle_,spts_List]:=Module[{subvbs,structure},
If[!VBundleQ[vbundle],Throw@Message[DefProjection::unknown,"vbundle",vbundle]];
If[(subvbs=SplittingsOfVBundle[vbundle])==={},Throw@Message[DefProjection::error,"VBundle has not yet been decomposed."],
subvbs=Last[subvbs]
];
structure=checksplittensor[vbundle]/@spts;
If[Sort[First/@structure]=!=Sort@Join[subvbs,-subvbs],Throw@Message[DefProjection::error,"Invalid subvbundles."]];
structure
];

9.13.2. SplitTensor. Old, but still functional

Now we decompose tensors. There are two ways of decomposing a tensor: with projectors and without projectors. This function will handle both cases at the same time. In the latter case we shall use delta's, though this will require further definitions on delta.

SplitTensor[tensor_?xTensorQ[]]:=tensor[];
SplitTensor[tensor_?xTensorQ[indices__]]:=Total[Outer[SplitTensor1[tensor],Sequence@@(SplitTensorIndex[#,VBundleOfIndex[#]]&/@{indices}),1],3];
SplitTensor1[tensor_][trios__List]:=Times[ProjectTensor[tensor,#2]@@#1,Sequence@@#3]&@@Transpose[{trios}];

SplitTensorIndex[a_,Labels]:={{a,LI,1}};
SplitTensorIndex[a_,vbundle_]:=With[{vbs=SplittingsOfVBundle[vbundle]},If[vbs==={},{{a,delta,1}},vbs=Last[vbs];projectindex[a,vbundle,#]&/@vbs]];
projectindex[a_Symbol,vbundle_,vb_]:=With[{dummy=DummyIn[vb]},{dummy,VBundleProjector[vbundle,vb,xAct`xTensor`Up],VBundleProjector[vbundle,vb,xAct`xTensor`Down][-dummy,a]}];
projectindex[-a_Symbol,vbundle_,vb_]:=With[{dummy=DummyIn[vb]},{-dummy,VBundleProjector[vbundle,vb,xAct`xTensor`Down],VBundleProjector[vbundle,vb,xAct`xTensor`Up][-a,dummy]}];

Finally we have to specify how to denote parts of tensors:

ProjectTensor[tensor_,projs_List][inds__]:=With[{symbol=SymbolJoin[tensor,Sequence@@projs]},If[!xTensorQ[symbol],
DefTensor[symbol[inds],DependenciesOf[tensor],PrintAs:>StringJoin["\!\((",PrintAs[tensor],"\_",StringJoin@@(PrintAs/@projs),")\)"]]
];
symbol[inds]
];

7.1.10. (Moved) Rigging

For sum vbundles we can add an additional structure called a rigging. This is a system of projectors from the total vbundle onto the subvbundles. For a rigging Rig we define three structures: the projectors URig[-a, mu] and DRig[a, -mu], and then the object Rig[ LI[subvb], mu, -nu ]. I think we really need to work with these three structures, and not just one, as Schouten suggests, because if we move up and down the indices of URig and DRig with a metric, I don't see why they should coincide.

DefRigging[Null,_]:=Null;
DefRigging[rigging_Symbol,vbundle_]:=With[{
base=BaseOfVBundle[vbundle],
Uname=SymbolJoin["U",rigging],
Dname=SymbolJoin["D",rigging]},
Module[{i1,i2,i3},
{i1,i2,i3}=GetIndicesOfVBundle[vbundle,3];
DefTensor[Uname[-i1,i2],base,Master->vbundle];
DefTensor[Dname[i1,-i2],base,Master->vbundle];
DefTensor[rigging[LI[vbundle],i1,-i2],base,Master->vbundle];
TagSetDelayed[Uname,Uname[-i1_,i3_]Dname[i2_,-i3_],If[VBundleOfIndex[i1]===VBundleOfIndex[i2],delta[-i1,i2],0]];
TagSetDelayed[Uname,Uname[-i3_,i1_]Dname[i3_,-i2_],rigging[LI[VBundleOfIndex[i3]],i1,-i2]];
TagSetDelayed[rigging,rigging[LI[vb1_],i1_,-i3_]rigging[LI[vb2_],i3_,-i2_],If[vb1===vb2,rigging[LI[vb1],i1,-i2],0]];
]];

10. Rules

(****************************** 10.Rules ******************************)

{TimeUsed[],SessionTime[],TimeUsed[]/SessionTime[]}

10.0. Comments

If[$ReadingVerbose,Print["Reading section 10: Rules."],Null,Null]

We can only construct rules with very simple LHSs: they are either a single object or a product of objects. Previously, rules were always rules among tensors with abstract indices. In version 0.8 MakeRule has been generalized to work with component indices. However I'm not sure it is safe. There are two problems:
	- Moving indices up and down could conflict with the use of derivatives which are not associated to the first-metric. We shall use careQ as a warning for the user.
	- The use of basis-indices is an additional problem.
We cannot handle patterns for tensors on the LHS. That is, we cannot have something like tensor_?xTensorQ[a,b] on the LHS (actually neither on the RHS).

QUESTION: An important unsolved issue is the generation of the complex conjugated rules.

Cyril has pointed out that by having a Hold attribute we might be creating a rule for a LHS that already evaluates to zero. That is both inefficient an dangerous because we might end up replacing zeros by something else.

10.1. PermuteIndices

This function permutes indices (not slots!) in a generic expression. The permutation is given in numeric form and the numbers refer to positions in the list of indices (and not slots!). Note that we need to supply the list of indices we are referring to, for safety reasons and to avoid using FindIndices. The responsibility in this case is all in ReplaceIndex:

?PermuteIndices

(* Identity *)
PermuteIndices[expr_,indices_IndexList,ID]:=expr;
PermuteIndices[expr_,indices_IndexList,_[]]:=expr;
PermuteIndices[expr_,IndexList[],_]:=expr;
(* Linear combination of permutations *)
PermuteIndices[expr_,indices_IndexList,perm_Plus]:=PermuteIndices[expr,indices,#]&/@perm;
PermuteIndices[expr_,indices_IndexList,k_ perm_?PermQ]:=k PermuteIndices[expr,indices,perm];
(* Generic permutation *)
PermuteIndices[expr_,indices_IndexList,perm_?PermQ]:=Module[{
iperm=InversePerm[perm],
points=Complement[Range@PermDeg@perm,StablePoints@perm]},
ReplaceIndex[expr,Inner[Rule,indices[[points]],indices[[OnPoints[points,iperm]]],List]]];

BeginExamples[]

DefManifold[M2,2,{A,B,C,D,F,G}]

DefTensor[RR[-A,-B,-C,-D],M2]

DefTensor[TT[-A,-B,-C,-D],M2]

RR[A,B,C,D]TT[-F,-A,-B,-C]

PermuteIndices[%,IndexList[A,-A,-C,D],xAct`xPerm`Cycles[{1,2},{3,4}]]

xAct`xCoba`BasisColor[polar]^=RGBColor[1,0,0];

expr=RR[{A,polar},{B,polar},{C,polar},{D,polar}]TT[-F,-A,-B,-C]

PermuteIndices[expr,IndexList[{A,polar},-A,-C,{D,polar}],xAct`xPerm`Cycles[{1,2},{3,4}]]

expr=RR[{1,polar},{B,polar},{C,polar},{2,polar}]TT[-F,-A,-B,-C]

Note how we read it: the first index goes to the position of the second index, the second goes to the position of the third, etc:

PermuteIndices[expr,IndexList[{1,polar},-A,-C],xAct`xPerm`Cycles[{1,2,3}]]

PermuteIndices[expr,IndexList[{1,polar},-A,-C],xAct`xPerm`Cycles[{1,3,2}]]

PermuteIndices[expr,IndexList[{1,polar},-A,-C],-1/3xAct`xPerm`Cycles[{1,3,2}]+3xAct`xPerm`Cycles[{1,2,3}]]

UndefTensor/@{RR,TT};

UndefManifold[M2]

Remove[polar,expr]

EndExamples[]

10.2. Symmetry equivalents

SymmetryEquivalentsOfTensor gives the list of tensors which are equivalent to the tensor given modulo its slot-symmetries, and taking the quotient by a subgroup of the symmetry.

The function symperms gives a GS for the symmetric group of indices syminds within the bigger set inds.

symperms[inds_IndexList,syminds_IndexList]:=Last@SGSofsym@Symmetric@Flatten[symperms1[inds,Union@syminds]];
symperms1[inds_,IndexList[]]:={};
symperms1[inds_,IndexList[a_,other___]]:=With[{pos=IndexPosition[inds,a]},Prepend[symperms1[ReplacePart[inds,Null,pos],IndexList[other]],pos]];

BeginExamples[]

xATP`symperms[IndexList[a,b,c,d],IndexList[]]

xATP`symperms[IndexList[a,b,c,d],IndexList[a]]

xATP`symperms[IndexList[a,b,c,d],IndexList[a,b]]

xATP`symperms[IndexList[a,b,c,d],IndexList[b,d]]

xATP`symperms[IndexList[a,b,c,d],IndexList[a,b,c]]

xATP`symperms[IndexList[a,b,c,d],IndexList[a,b,c,d]]

It works even for repeated or missing indices:

xATP`symperms[IndexList[a,b,c,d],IndexList[a,a]]

xATP`symperms[IndexList[a,b,c,d,a],IndexList[a,a]]

xATP`symperms[IndexList[a,b,c,d,a],IndexList[a,a,d]]

xATP`symperms[IndexList[a,b,c,d],IndexList[e,f]]

xATP`symperms[IndexList[a],IndexList[b]]

xATP`symperms[IndexList[],IndexList[a,b]]

Remove[a,b,c,d,e,f]

EndExamples[]

biggroup contains all elements of the group of symmetry of the tensor; smallgroup is a subgroup of biggroup. The variable result contains a list of coset-representatives of the quotient biggroup / smallgroup. This computation is done using brute force. There is a Transversal function in xPerm, but it only computes transversals in the full symmetric group.

?SymmetryEquivalentsOfTensor

(* Corner case added, as suggested by Thomas *)
SymmetryPerms[GenSet[],inds_IndexList,subsets___IndexList]:={ID};
SymmetryPerms[GS_,inds_IndexList,subsets___IndexList]:=Module[{g,biggroup,smallgroup,coset,result={}},
biggroup=Dimino[TranslatePerm[GS,xAct`xPerm`Cycles]];
smallgroup=Dimino[GenSet@@Union[symperms[inds,#]&/@{subsets}]];
If[Length[smallgroup]>1,
While[Length[biggroup]>0,
g=First@biggroup;
AppendTo[result,g];
coset=PermProduct[#,g]&/@smallgroup;
biggroup=DeleteCases[biggroup,Alternatives@@Join[coset,PermProduct[-ID,#]&/@coset]]
],
result=List@@biggroup];
result];

SymmetryEquivalentsOfTensor[head_?xTensorQ[inds__],subsets___IndexList]:=PermuteIndices[head[inds],IndexList[inds],#]&/@SymmetryPerms[SymmetryGroupOfTensor[head[inds]],IndexList[inds],subsets];

The case of products is particularly interesting. Given a prod[t1, t2, ..., tn], with each tensor ti having a grade in the given product prod, and this product having a general commutativity sign (say “Anticommutative”), how do we find the sign of any arbitrary reordering of the tensors in that product? Of course, if the tensors have indices, then those symmetries will also have to be taken into account, but that seems easier, given the technology we already have.

permute1[prod_,comm_][{s_,grades_},perm:System`Cycles[{{n1_,n2_}}]]:={s CommutativitySignGrade[prod,comm][grades[[n1]],grades[[n2]]],System`Permute[grades,perm]};
gradeSigns[grades_List,prod_]:=With[{n=Length[grades],comm=CommutativityOfProduct[prod]},
Module[{group,perms,lists,signs},
perms=Permutations[Range[n]];
Switch[comm,
"Commutative",
	signs=ConstantArray[1,n!],
"Anticommutative",
	signs=Signature/@perms,
_,
	group=PermutationGroup[System`Cycles[{#}]&/@Subsequences[Range[n],{2}]];
	lists=Extract[group[[1]],List/@Abs[GroupElementToWord[group,#]]]&/@perms;
	signs=Part[Fold[permute1[prod,comm],{1,grades},#]&/@lists,All,1];
];
Thread[perms->signs]
]
];

permuteSymmetries[Times[s1_Integer,prodT_],rule_]:=Times[s1,permuteSymmetries[prodT,rule]];
permuteSymmetries[prodT_,Rule[perm_,s_]]:=Times[s,System`Permute[prodT,perm]];
SymmetryEquivalentsOf[prod_?ProductQ[tensors___]]:=Module[{permsigns,outer},
(* Compute the signs derived from permuting objects with grades *)
permsigns=gradeSigns[Grade[#,prod]&/@{tensors},prod];
(* Compute all symmetry equivalents by the internal symmetries of the factors *)
outer=Flatten@Outer[prod,Apply[Sequence,SymmetryEquivalentsOf/@{tensors}]];
(* Combine both results *)
Flatten@Outer[permuteSymmetries,outer,permsigns,1]
]/;prod=!=Times;

SymmetryEquivalentsOf[expr_,subsets___IndexList]:=With[{inds=FindIndices[expr]},PermuteIndices[expr,inds,#]&/@SymmetryPerms[Last@SymmetryOf[expr],inds,subsets]];

SymmetryEquivalentsOfTensor[head_?xTensorQ[inds__],subsets___IndexList]:=Module[{g,biggroup,smallgroup,result={},coset},
biggroup=Dimino[SymmetryGroupOfTensor[head[inds]][[2]]];
smallgroup=Dimino[GenSet@@Union[symperms[IndexList[inds],#]&/@{subsets}]];
If[Length[smallgroup]>1,
While[Length[biggroup]>0,
g=First@biggroup;
AppendTo[result,g];
coset=PermProduct[#,g]&/@smallgroup;
biggroup=DeleteCases[biggroup,Alternatives@@Join[coset,PermProduct[-ID,#]&/@coset]]
],
result=List@@biggroup];
PermuteIndices[head[inds],IndexList[inds],#]&/@result]

It would be very simple to generalize this function to arbitrary expressions (change SymmetryGroupOfTensor to SymmetryOf and compute indices with FindIndices), but right now we only use this function in MakeRule, and there we only need it for tensors.

Examples:

BeginExamples[]

DefManifold[M2,2,{A,B,C,D,F,G}]

DefTensor[T[A,-B,-C],M2,Antisymmetric[{-B,-C}]]

xATP`SymmetryEquivalentsOfTensor[T[A,-B,-C],IndexList[A,-C]]

UndefTensor[T]

DefTensor[T[-A,-B,-C,-D],M2,RiemannSymmetric[{1,2,3,4}]]

xATP`SymmetryEquivalentsOfTensor[T[-A,-B,-C,-D]]

xATP`SymmetryEquivalentsOfTensor[T[-A,-B,-C,-D],IndexList[]]

xATP`SymmetryEquivalentsOfTensor[T[-A,-B,-C,-D],IndexList[-B]]

xATP`SymmetryEquivalentsOfTensor[T[-A,-B,-C,-D],IndexList[-A,-B]]

xATP`SymmetryEquivalentsOfTensor[T[-A,-B,-C,-D],IndexList[-A,-B],IndexList[-C,-D]]

xATP`SymmetryEquivalentsOfTensor[T[-A,-B,-C,-D],IndexList[-A,-B,-C]]

xATP`SymmetryEquivalentsOfTensor[T[-A,-B,-C,-D],IndexList[-A,-B,-C,-D]]

There is no check on the up/down character:

xATP`SymmetryEquivalentsOfTensor[T[-A,-B,A,-D],IndexList[]]

xATP`SymmetryEquivalentsOfTensor[T[-A,-B,A,-D],IndexList[A,-A]]

xATP`SymmetryEquivalentsOfTensor[T[-A,A,B,-D],IndexList[A,-A]]

xATP`SymmetryEquivalentsOfTensor[T[-A,-B,-C,-D],IndexList[-A,-C]]

UndefTensor[T]

DefTensor[T[-A,-B,-C,-D,-F],M2,Antisymmetric[{1,2,3,4,5}]]

xATP`SymmetryEquivalentsOfTensor[T[-A,-B,-C,-D,-F],IndexList[-A,-B,-F]]

Length[%]

5!/3!

xATP`SymmetryEquivalentsOfTensor[T[-A,-B,-C,-D,-F],IndexList[-A,-B],IndexList[-F,-D]]

Length[%]

5!/2!/2!

UndefTensor[T]

UndefManifold[M2]

EndExamples[]

10.3. (Index) Set, Rule, SetDelayed and RuleDelayed

10.3.0. Comments

Here we define functions that take care of the low level definition of rules and settings. There are two issues to worry about:
	- Consistency of indices between the LHS and RHS of the expressions.
	- Automatic change of dummies on the RHS, to avoid dummy conflicts, introducing a Module construct, as recommended by Mathematica.

10.3.1. Hold attributes

BeginExamples[]

Before starting note that all values associated to a given symbol are internally defined using DelayedRule and HoldPattern:

yyy=zzz;
xxx=yyy;

OwnValues[xxx]

xxx=.
xxx:=yyy

OwnValues[xxx]

xxx=.
yyy=.
xxx[_]=yyy;

DownValues[xxx]

xxx=.
yyy[xxx]^=zzz;

UpValues[xxx]

Remove[xxx,yyy,zzz]

EndExamples[]

We shall follow that rule defining everything using delayed constructs. This is also very useful to arrange the replacement of dummy indices.

Note also that Set and SetDelayed hold their first argument:

Attributes[Set]

Attributes[SetDelayed]

but Rule and RuleDelayed do not hold their first argument:

Attributes[Rule]

Attributes[RuleDelayed]

That's why we must use HoldPattern:

Attributes[HoldPattern]

Note finally:

Attributes[Block]

Attributes[Module]

Attributes[With]

Attributes[RuleDelayed]

10.3.2. Three basic problems with tensor rules

BeginExamples[]

DefManifold[M2,2,{A,B,C,D,F,G}]

Let us try to define rules among tensors from scratch. We shall use the example rule v^A goes to T^AB w_B.

DefTensor[v[A],M2]
DefTensor[T[A,B],M2]
DefTensor[w[-A],M2]

First try:

rule1=v[A_]:>T[A,B]w[-B];

v[B]/.rule1

First problem: indices are repeated. Following Mathematica we use a Module construct. Second try:

rule2=v[A_]:>Module[{B},T[A,B]w[-B]];

v[B]/.rule2

Dummy patterns on the left and dummies on the right must be different to avoid this problem:

rule3=v[A_,-A_]:>Module[{A,B},T[A,-A,-B]w[B]];

v[C,-C]/.rule3

v[B,-B]/.rule3

UndefTensor/@{v,T,w};

UndefManifold[M2]

Remove[rule1,rule2,rule3]

EndExamples[]

---------------  Legacy code follows. Those two problems have been avoided simply by disallowing symbols having several different types. -----------------

Second problem: the same symbol can represent a tensor and an index. Let us replace v and w by A:

DefTensor[A[A],M2]

rule4=A[A_]:>Module[{B},T[A,B]A[-B]];

A[B]/.rule4

That means that patterns cannot share symbols with anything else. We solve it using the function ReplacePatterns:

rule5=ReplacePatterns[A[A_]:>Module[{B},T[A,B]A[-B]]]

A[B]/.rule5

A[B]A[-B]/.rule5

Third problem: tensors and indices can share a symbol on the RHS:

rule6=ReplacePatterns[v[B_]:>Module[{A},A[B,A,-A]]]

v[C]/.rule6

We solve it using the function ReplaceDummiesInModule:

rule7=ReplaceDummiesInModule[ReplacePatterns[v[B_]:>Module[{A},A[B,A,-A]]]]

v[C]/.rule7

UndefTensor[A]

--------------------  Legacy code ends. ----------------------

By elimination of the possibility of an index and an object sharing a symbol, we do not have to worry about problems 2 and 3. In particular, and this is very important, we do not have to introduce dollar-patterns.

10.3.3. New functions

Note that the four functions in this subsubsection work in very similar ways. Essentially we construct a temporal Module expression with the right rhs but an empty list of indices, and then replace the empty list with the list of dummies (the head must be changed from IndexList to List). We need to ensure that there are no pattern dummies on the LHS with the same name as dummies in the list of indices of the Module.

We need these short functions to detect conflicting dummies (those which are present both in the LHS and the RHS of the rules, and are patterns on the LHS), replacing them on the RHS. Note that we return the RHS wrapped in Hold to avoid evaluation.

SetAttributes[ConflictingDummies,{HoldAll,SequenceHold}];
(* PINDEX *)
ConflictingDummies[lhs_,rhs_]:=Intersection[PatternToIndex/@Select[FindDummyIndices[lhs],PIndexQ],FindDummyIndices[rhs]];
SetAttributes[ReplaceConflictingDummies,{HoldFirst,SequenceHold}];
ReplaceConflictingDummies[{lhs_,rhs_}]:=ReleaseHold@ReplacePart[Hold[ReplaceConflictingDummies[rhs,ConflictingDummies[lhs,rhs]]],ReplaceIsolated[Hold[rhs]],{1,1},1];
ReplaceConflictingDummies[rhs_,IndexList[]]:=Hold[rhs];
ReplaceConflictingDummies[rhs_,cdummies_IndexList]:=ReplaceIndex[rhs,DuplicateRule@Inner[Rule,cdummies,DummyAs/@cdummies,List],Hold];

We also need to replace those indices on the rhs being isolated. Those are all indices in directions (Dir-indices, the direction of a Lie derivative and the vectors of Lie brackets) and scalars. Currently we act on those scalars inside Scalar, but not those in the arguments of scalar-functions.

SetAttributes[{ReplaceIsolated,replall},HoldFirst];
ReplaceIsolated[expr_]:=MapOnIsolated[expr,replall];
replall[expr_]:=Module[{inds=FindFreeAndDummyIndices[expr],frees,dummies},
frees=Rule[#,DummyAs[#]]&/@First[inds];
dummies=DuplicateRule/@(Rule[#,DummyAs[#]]&/@Last[inds]);
ReplaceIndex[expr,List@@Join[frees,dummies]]];

Once we have both sides of the equation in a safe state, then we construct a Module with the rhs and the list of new dummies. Note that we never evaluate the rhs expression. As pointed out by Thomas, we need to move into the Module list only abstract indices.

DropIndexBasis[{index_,basis_}]:=index;
DropIndexBasis[index_]:=index;
ConstructModule[Hold[rhs_]]:=ReplacePart[Hold[Module[{},rhs]],DropIndexBasis/@(List@@FindDummyIndices[rhs]),{1,1}];

Note finally that there are two calls to FindDummyIndices[rhs], but they are different. The first one happens in ConflictingDummies and gives the indices before replacement. The second one is in the final ConstructModule and gives the list of indices after being replaced. We could avoid the second one, but the code is safer this way.

BeginExamples[]

DefManifold[M2,2,{A,B,C,D,F,G}]

DefTensor[T[A],M2]

DefTensor[V[A],M2]

Unprotect[T];
T[A_]:=V[A]
Protect[T];

ReplaceIndex[T[A],A->B]

ReplaceIndex[T[A],A->B,Hold]

xATP`ConflictingDummies[T[A_Symbol,-A_Symbol,B_Symbol],V[A,C]V[-A,-C]V[B]]

xATP`ReplaceConflictingDummies[{T[A_Symbol,-A_Symbol,B_Symbol],V[A,C]V[-A,-C]V[B]}]

xATP`ConstructModule[%]

UndefTensor/@{T,V};

UndefManifold[M2]

EndExamples[]

IndexSetDelayed holds both LHS and RHS. Both go directly into the SetDelayed expression. We simply need to replace the RHS with the corresponding module:

SetAttributes[IndexSetDelayed,{HoldAll,SequenceHold}];
IndexSetDelayed[lhs_,rhs_]:=ReleaseHold@ReplacePart[Hold[SetDelayed[lhs,rhs]],ConstructModule[ReplaceConflictingDummies[{lhs,rhs}]],{1,2},{1}]

IndexSet is identical to IndexSetDelayed, but the RHS is initially evaluated and returned:

SetAttributes[IndexSet,{HoldFirst,SequenceHold}];
IndexSet[lhs_,rhs_]:=(IndexSetDelayed[lhs,rhs];rhs);

IndexRuleDelayed evaluates rhs at evaluation time. In the case that new dummies appear during the evaluation of the RHS, we shall assume that the objects being evaluated will worry about the new indices.

SetAttributes[IndexRuleDelayed,{HoldRest,SequenceHold}];
IndexRuleDelayed[lhs_,rhs_]:=ReleaseHold@ReplacePart[Hold[RuleDelayed[HoldPattern[lhs],rhs]],ConstructModule[ReplaceConflictingDummies[{lhs,rhs}]],{1,2},{1}];

IndexRule is identical to IndexRuleDelayed but evaluates its arguments initially:

SetAttributes[IndexRule,SequenceHold];
IndexRule[lhs_,rhs_]:=IndexRuleDelayed[lhs,rhs];

Graphical shortcuts:

DoubleRightTee=IndexSet;
RightTeeArrow=IndexRule;

Precedences of DoubleRightTee and RightTeeArrow are too high. QUESTION: I do not know how to change this. Changing the output of the function Precedence does not work. Study the package Notation.

Precedence/@{Unevaluated[DoubleRightTee],IndexSet,Set}

Precedence/@{Unevaluated[RightTeeArrow],IndexRule,Rule}

Recall these precedences, and in particular note that Postfix has precedence 80 in Math4 or 70 in Math5, just above that of Set. In Math4:

({{{70.`,"Set","SetDelayed","UpSet","UpSetDelayed"}}, {{80.`,"Postfix"}}, {{90.`,"Function"}}, {{100.`,"AddTo","DivideBy","SubtractFrom","TimesBy"}}, {{110.`,"ReplaceAll","ReplaceRepeated"}}, {{120.`,"Rule","RuleDelayed"}}, {{130.`,"Condition"}}, {{140.`,"Optional"}}, {{160.`,"Alternatives"}}, {{170.`,"Repeated","RepeatedNull"}}})

Now the symbols of equality and rules represent IndexSet, etc. Note that it is done only for StandarForm. Not used now:

MakeExpression[RowBox[{x_,"=",y_}],StandardForm]:=MakeExpression[RowBox[{"IndexSet","[",x,",",y,"]"}],StandardForm]
MakeExpression[RowBox[{x_,":=",y_}],StandardForm]:=MakeExpression[RowBox[{"IndexSetDelayed","[",x,",",y,"]"}],StandardForm]
MakeExpression[RowBox[{x_,"->"|"->",y_}],StandardForm]:=MakeExpression[RowBox[{"IndexRule","[",x,",",y,"]"}],StandardForm]
MakeExpression[RowBox[{x_,":>"|":>",y_}],StandardForm]:=MakeExpression[RowBox[{"IndexRuleDelayed","[",x,",",y,"]"}],StandardForm]

10.3.4. Examples

BeginExamples[]

DefManifold[M2,2,{A,B,C,D,F,G}]

Examples:

DefTensor[v[A],M2]
DefTensor[w[A],M2]
DefTensor[T[A,B],M2]
DefTensor[R[A],M2]

Unprotect[v,w]

w[-B_]:=Module[{C},R[-B,-C,C]]

IndexRule[v[A_],T[A,B]w[-B]]

InputForm[%]

v[B]/.%

%//ScreenDollarIndices

IndexRuleDelayed[v[A_],T[A,B]w[-B]]

InputForm[%]

v[B]/.%

%//ScreenDollarIndices

IndexSet[v[A_],T[A,B]w[-B]]

v[A]v[-A]//ScreenDollarIndices

IndexSetDelayed[v[A_],T[A,B]w[-B]]

v[A]v[-A]//ScreenDollarIndices

?v

Conflicting dummies are repeated on the rhs:

IndexRule[v[A_,-A_],T[A,-A,-B]w[B]]

IndexSet[v[A_,-A_],T[A,-A,-B]w[B]]

v[B,-B]

%//ScreenDollarIndices

UndefTensor/@{v,w,T,R};

More examples:

DefTensor[T[A,B],M2]
DefTensor[w[A],M2]
DefTensor[v[A],M2]
DefTensor[R[A],M2]

IndexSet:

Unprotect[w]

w[A_]⊨T[A,B]R[-B]

?w

If we define it again the rule gets replaced (even though it is exactly the same rule)

w[A_]⊨T[A,B]R[-B]

?w

w[A]

w[B]

Unprotect[v];

v[A_]⊨T[A,B]w[-B]

?v

v[A]//ScreenDollarIndices

aa⊨b

?aa

Clear[aa]

IndexRule:

w[A_]=.

w[A_]↦T[A,B]w[-B]

aa↦b

IndexSetDelayed:

IndexSetDelayed[v[A_],T[A,B]w[-B]]

?v

v[B]//ScreenDollarIndices

IndexRuleDelayed:

IndexRuleDelayed[v[A_],T[A,B]w[-B]]

v[A]/.%//ScreenDollarIndices

$Tensors

UndefTensor/@{T,w,v,R};

UndefManifold[M2]

Remove[aa,b]

EndExamples[]

10.4. MakeRule

10.4.0. Comments

Given a rule of the form {LHS, RHS} we proceed as follows:
	0. We assume that there are no pattern-indices (neither indices nor heads), and this is checked.
	    There can be dollar-indices. If they are to be patterns they will be replaced. Only pattern-indices are
	    changed. On the RHS only free pattern-indices are changed, but not all dollar-indices for example.
	1.- Analysis of LHS:
		* indsLHS: all indices on the LHS. There can be up/down indices and dollars, but all ABSTRACT indices.
		   Both members of pairs.
		* indsRHS: all indices on the RHS. Idem.
		* freesLHS: free indices on the LHS. There can be up/down indices and dollars.
		* freesRHS: free indices on the RHS. Idem.
		* symtensorsLHS: all tensors in the LHS whose symmetry is not trivial.
	2.- Options:
		* UseSymmetries: If True several rules will be generated, considering all possible equivalent
		    configurations of indices. MakeRule is threaded over all possibilities using MakeRule1. Perhaps
		    many rules are redundant.
		* MetricOn: All, None or a list of indices on which we expect to be able to use a metric. There
		    are two possibilities. If the index is free then on the LHS we accept both up/down indices and
		    on the RHS we introduce an explicit metric tensor. If the index is a dummy on the LHS then we
		    duplicate the rule with both up/down and down/up possibilities. The dummy can be identified
		    both as A or -A.
		* TestIndices: (currently Boolean)

In principle a rule involves certain indices in certain positions. If we want to have a rule that considers both up/down free cases we need to replace a_Symbol?VB`Q by a_?VB`pmQ on the LHS and then we need to add a metric g[a, a$] on the RHS. For dummies we need to introduce a PairQ pair, or either, duplicate the rule.

MakeRule::terms="There is more than one term on the LHS of rule.";
MakeRule::inhom="Inhomogeneous indices in rule: `1`, `2`.";
MakeRule::pats="Patterns are not accepted on the `1` hand side of rule.";

Recall the slots {index, free, metric, testindex, pattern, name}. There are four Booleans and hence five cases. We asumme at this point that index and name have the same up/down character:

10.4.1. Construction of patterns and manipulation of metrics

1) Recall that given a rule between indices, DuplicateRule gives two rules with the second one being the the same rule for the opposite-character indices. This is only prepared for abstract indices because we change the name of a basis index using a rule for the corresponding abstract index:

??DuplicateRule

BeginExamples[]

xATP`DuplicateRule[a->-b]

EndExamples[]

2) The function FormatIndexRule gives the form of the g-index in the final rule, depending on a number of options. Note that we use pattern and patternTest instead of Pattern and PatternTest to avoid Mathematica complaining about having patterns on the rhs of rules. Perhaps it would be possible to do this more elegantly using PatternIndex, but I'm not sure that is possible. The tests use the functions vbundle`Q and vbundle`pmQ and so they are valid only for abstract indices.

(* A non-pattern index is just kept (possibly changing name) *)
FormatIndexRule[{index_Symbol,_,_,_,False,name_Symbol}]:=DuplicateRule[index->name];
(* Non-tested pattern *)
FormatIndexRule[{index_Symbol,_,_,False,True,name_Symbol}]:=DuplicateRule[index->pattern[name,Blank[Symbol]]];
(* Tested pattern. Free. Metric. DuplicateRule not needed *)
FormatIndexRule[{index_Symbol,True,True,True,True,name_Symbol}]:=index->patternTest[pattern[name,Blank[]],Evaluate@VBundleIndexPMQ[VBundleOfIndex@index]];
(* Tested pattern. Dummy, or free+nometric *)
FormatIndexRule[{index_Symbol,_,_,True,True,name_Symbol}]:=DuplicateRule[index->patternTest[pattern[name,Blank[Symbol]],VBundleIndexQ[VBundleOfIndex@index]]];

(* We always get up -> up rules *)
FormatIndexRule[{-index_,f_,m_,t_,p_,-name_Symbol}]:=FormatIndexRule[{index,f,m,t,p,name}];
(* Blocked indices get name 0. Throw error *)
FormatIndexRule[{0,other__}]:=Throw@Message[MakeRule::nouse,"FormatIndexRule","a blocked index"];
(* Basis indices converted to basis indices *)
FormatIndexRule[{index_,other__}]:=FormatIndexRule[{IndexName[index],other}];

The rules have been saved in the same order of definition.

BeginExamples[]

DefManifold[M2,2,{A,B,C,D,F,G}]

DefTensor[T[A,B,C],M2]
DefTensor[v[A],M2]

DefTensor[metricg[-A,-B],M2,Symmetric[{1,2}],PrintAs->"g"];

xUpSet[MetricsOfVBundle[TangentM2],{metricg}]

Unprotect[metricg];
metricg[A_Symbol,-B_Symbol]:=delta[A,-B]
metricg[-A_Symbol,B_Symbol]:=delta[-A,B]
Protect[metricg];

PINDEX.

{xATP`FormatIndexRule[{-A,True,True,True,True,-B}]}/.{xATP`patternTest->PatternTest,xATP`pattern->Pattern}//InputForm

{xATP`FormatIndexRule[{-A,False,True,True,True,-B}]}/.{xATP`patternTest->PatternTest,xATP`pattern->Pattern}//InputForm

{xATP`FormatIndexRule[{{-A,-Polar},True,True,True,True,-B}]}/.{xATP`patternTest->PatternTest,xATP`pattern->Pattern}//InputForm

{xATP`FormatIndexRule[{{-A,-Polar},False,True,True,True,-B}]}/.{xATP`patternTest->PatternTest,xATP`pattern->Pattern}//InputForm

Remove[Polar];

EndExamples[]

3) Duplication of rules for a free index. It is very important to see that the second argument (index) must have the correct up/down character. The metric factors that are added are always g[up, up] or g[down, down]. This function could be problematic on the LHS if there are indices which cannot be moved due to the action of non-firstmetric derivatives. That is, we are being careful on the RHS, but not on the LHS! The responsibility is here left to the user. The LHS and RHS of the rule are not held, though note that in those two cases in which the index is replaced in LHS and RHS, the expressions are evaluated only after replacement, and not before.

HoldTimes[Hold[0],Hold[expr2_]]:=Hold[0];
HoldTimes[Hold[expr1_],Hold[expr2_]]:=Hold[Times[expr1,expr2]];
HoldTimes[Hold[expr1_],1]:=Hold[expr1];
HoldTimes[Hold[expr1_],expr2_]:=Hold[Times[expr1, expr2]];
(* SPINOR. free and dummy do not always coincide in character; hence use Hold *)
putmetric[expr_Hold,metric_,{free_,dummy_}]:=HoldTimes[expr,If[UpIndexQ[dummy],Hold[metric[free,dummy]],Hold[metric[dummy,free]]]];

The If in putmetric cares about index positioning for antisymmetric metrics (spinor theory). It is irrelevant for symmetric metrics.

duplicateRuleforfree[HoldPattern[LHS_Hold->RHS_Hold],index_]:={LHS->RHS,ReplaceIndex[LHS,index->-index]-> With[{dummy=DummyAs[index]},putmetric[ReplaceIndex[RHS,index->dummy],FirstMetricOfVBundle[VBundleOfIndex[index],True],{-index,-dummy}]]};
duplicateRuleforfree[list_List,index_]:=Flatten[duplicateRuleforfree[#,index]&/@list]

BeginExamples[]

xATP`duplicateRuleforfree[Hold[T[F,-F,-A$,C$,D] v[-C$]]->Hold[v[-C$] v[C$] v[-A$,D]],D]//InputForm

xATP`duplicateRuleforfree[Hold[T[F,-F,-A$,C$,-D] v[-C$]]->Hold[v[-C$] v[C$] v[-A$,-D]],-D]//InputForm

EndExamples[]

4) The function duplicateRulefordummy changes an up-down pair of dummies by the corresponding down-up pair. The change on the LHS could produce undesired evaluations, or even wrong expressions if we have non-firstmetric derivatives. David has detected a problem when the LHS is a metric because under the index shift it is converted into a delta. Much time later... Cyril has found again the same problem.

duplicateRulefordummy[HoldPattern[LHS_Hold->RHS_Hold],index_]:=With[{sign=SymmetryOfMetric@FirstMetricOfVBundle[VBundleOfIndex[index],True]},{LHS->RHS,ReplaceIndex[LHS,{index->-index,-index->index}]->HoldTimes[RHS,sign]}];
duplicateRulefordummy[list_List,index_]:=Flatten[duplicateRulefordummy[#,index]&/@list]

BeginExamples[]

xUpSet[xATP`SymmetryOfMetric[metricg],1];

xATP`duplicateRulefordummy[{Hold[T[A,-A]]->Hold[T[A]v[-A]]},A]//InputForm

EndExamples[]

5) Here we introduce metric factors with one up-index and then another index that can be up or down. This can be problematic because an up-down or down-up metric factor will be automatically transformed into a delta factor! We avoid that by temporarily wrapping the metric with Hold. Its content must be constructed using With:

changeRuleforfreepmQ[HoldPattern[LHS_Hold->RHS_Hold],index_]:=ReplaceIndex[LHS,index->UpIndex[index]]->With[{dummy=DummyAs[index]},putmetric[ReplaceIndex[RHS,index->dummy],FirstMetricOfVBundle[VBundleOfIndex[index],True],{UpIndex[index],-dummy}]];
changeRuleforfreepmQ[list_List,index_]:=Flatten[changeRuleforfreepmQ[#,index]&/@list];

BeginExamples[]

xATP`changeRuleforfreepmQ[Hold[T[F,-F,-A$,C$,D] v[-C$]]->Hold[v[-C$] v[C$] v[-A$,D]],D]//InputForm

xATP`changeRuleforfreepmQ[Hold[T[F,-F,-A$,C$,-D] v[-C$]]->Hold[v[-C$] v[C$] v[-A$,-D]],-D]//InputForm

UndefTensor/@$Tensors

UndefManifold[M2]

EndExamples[]

10.4.2. MakeRule

This is probably the most complicated function in xTensor, at least after ToCanonical. Currently we do not use IndexList in this function: it is immediately removed from the output of the FindIndices functions and later reintroduced to fit the input format of TakeEPairs and SymmetryEquivalentsOfTensor. The function works in two steps: first (part B) we manipulate the indices of the LHS and RHS of the rule, creating a number of replacement rules for the indices; then (part C) we apply those replacement rules to the indices and construct the final rules. The former seems pretty safe, but not the latter. Essentially we should ensure that the expressions are never evaluated.

Problems:
	- Though the function has attribute HoldFirst, this is not kept during the construction of the rule. For instance, there are several functions which evaluate the LHS, like  ReplaceDummies, ListOfTerms. The list symtensorsLHS is also evaluated after construction. Problems:
		- Checks LHS === 0 and RHS===0
		- Check ListOfTerms[LHS] > 1
		- The ouptut of FindAllOfType gives tensors which are evaluated. This propagates through symtensorsLHS
	- The rhs can be very complicated, but the lhs cannot be complicated because the same trick of multiplying metric factors doesn't work on the lhs. For example if we have a partial derivative on the lhs then it is not possible to move indices inside.
	- There are three important things which are difficult to implement here: daggers, basis-indices and non-metric derivatives.

Options[MakeRule]={
PatternIndices->All,
TestIndices->True,
MetricOn->None,
UseSymmetries->True,
Verbose->False,
ContractMetrics->False
};
SetAttributes[MakeRule,HoldFirst];
MakeRule[{LHS_,RHS_,conditions___},options:OptionsPattern[]]:=With[{HeldLHS=Hold[LHS],HeldRHS=Hold[RHS]},
Module[{
(* Unblocked indices *)
indsLHS=List@@TakeEIndices[FindIndices[HeldLHS]],
freesLHS=List@@TakeEIndices[FindFreeIndices[HeldLHS]],
indsRHS=List@@TakeEIndices[FindIndices[HeldRHS]],
freesRHS=List@@TakeEIndices[FindFreeIndices[HeldRHS]],
patindsLHS,ti,mo,us,verb,contr,
indsLHSinfo,
oldinds,newinds,pmQinds,pairs,
dupfreemetric,
rulesLHS,
symtensorsLHS,
newHeldLHS=ReplaceIsolated[HeldLHS],newLHSs,
newHeldRHS=ReplaceDummies[HeldRHS],newRHSs,
rules,conds},

(* Options *)
{patindsLHS,ti,mo,us,verb,contr}=OptionValue[{PatternIndices,TestIndices,MetricOn,UseSymmetries,Verbose,ContractMetrics}];

(**** A. Checks ****)
If[Or@@(PIndexQ/@indsLHS),Throw@Message[MakeRule::pats,"left"]];
If[Or@@(PIndexQ/@indsRHS),Throw@Message[MakeRule::pats,"right"]];
If[LHS===0,Throw[Message[MakeRule::error,"LHS of rule evaluates to zero."]]];
If[(Sort@freesLHS)=!=(Sort@freesRHS)&&RHS=!=0,Throw@Message[MakeRule::inhom,freesLHS,freesRHS]];
If[Length@ListOfTerms[LHS]>1,Throw@Message[MakeRule::terms]];

(**** B. Construct indsLHSinfo ****)
(* 0. Convert LHS inds to names *)
indsLHS=IndexName/@indsLHS;
freesLHS=IndexName/@freesLHS;

(* 1. Name of index in input rule *)
indsLHSinfo=Partition[indsLHS,1];

(* 2. Free character *)
indsLHSinfo=Append[#,MemberQ[freesLHS,First@#]]&/@indsLHSinfo;

(* 3. MetricOn. up/down character in mo is corrected *)
mo=Switch[mo,
None,{},
All,indsLHS,
_List,Intersection[mo~Join~(ChangeIndex/@mo),indsLHS],
_,Throw@Message[MakeRule::unknown,"indices",mo]
];
indsLHSinfo=Append[#,MemberQ[mo,First@#]&&MetricEndowedQ@VBundleOfIndex@First@#]&/@indsLHSinfo;
(* Warning if there are non-metric derivatives on the LHS *)
If[mo=!={}&&careQ[Identify[LHS]],Print["** MakeRule: Potential problems moving indices on the LHS."]];

(* 4. TestIndices *)
indsLHSinfo=Append[#,ti]&/@indsLHSinfo;

(* 5. Pattern character in final rule. up/down character in patindsLHS is corrected *)
patindsLHS=Switch[patindsLHS,
None,{},
All,indsLHS,
_List,Intersection[patindsLHS~Join~(ChangeIndex/@patindsLHS),indsLHS],
_,Throw@Message[MakeRule::unknown,"indices",patindsLHS]
];
indsLHSinfo=Append[#,MemberQ[patindsLHS,First@#]]&/@indsLHSinfo;

(* 6. Name in final rule. Currently we do not change names *)
indsLHSinfo=Append[#,First@#]&/@indsLHSinfo;
If[verb,Print["indsLHSinfo: ",indsLHSinfo]];

(* 7. Final rules for LHS indices *)
rulesLHS=(FormatIndexRule/@indsLHSinfo)/.{patternTest->PatternTest,pattern->Pattern};
If[verb,Print["rulesLHS: ",rulesLHS]];

(**** C. Construct newLHSs and newRHS ****)
(* 1. MetricOn *)
(* Indices that give pmQ patterns (always converted to upindices) *)
pmQinds=Cases[indsLHSinfo,{index_,True,True,True,True,_}:>index];
(* Pairs of contracted indices. They do not need duplication by symmetry *)
pairs=Partition[List@@TakeEPairs[IndexList@@Cases[indsLHSinfo,{index_,False,True,_,_,_}:>index]],2];
(* Free indices that give duplicatefree rules *)
dupfreemetric=Complement[Cases[indsLHSinfo,{index_,True,True,_,_,_}:>index],pmQinds];
If[verb,Print["dupfreemetric: ",dupfreemetric]];

(* 2. UseSymmetries *)
(* Create a list of equivalents to symtensorsLHS due to the symmetries of tensors, with metric pairs eliminated because they will give duplicated rules below *)
symtensorsLHS=Cases[FindAllOfType[HeldLHS,Tensor],tensor_/;OrderOfGroup[SymmetryGroupOfTensor[tensor]]=!=1];
If[!us||symtensorsLHS==={},
newLHSs={newHeldLHS},
If[verb,
Print["symtensorsLHS: ",symtensorsLHS];
Print["freesLHS: ",freesLHS];
Print["pairs: ",pairs]
];
Module[{groups,newtensors,tmp,equivalents},
groups=Join[{IndexList@@freesLHS},Apply[IndexList,pairs,{1}]];
newtensors=SymmetryEquivalentsOfTensor[#,Sequence@@groups]&/@symtensorsLHS;
If[verb,Print["newtensors: ",newtensors]];
equivalents=Flatten[Outer[tmp,Sequence@@newtensors]]/.tmp->List;
If[verb,Print["equivalents: ",equivalents]];
(* The strange Rule[#2,#1]& construction below is needed because Inner is asymmetric when the lists have different depths *)
newLHSs=newHeldLHS/.Inner[Rule[#2,#1]&,equivalents,symtensorsLHS,List]//.HoldPattern[der_?FirstDerQ[-expr_]]:>-der[expr]
]
];
If[verb,Print["newLHSs: ",newLHSs]];
(* Repeat RHS as many times *)
newRHSs=newHeldRHS&/@newLHSs;
If[verb,Print["newRHSs: ",newRHSs]];

(* 3. Construct rules *)
rules=Inner[Rule,newLHSs,newRHSs,List];
If[verb,Print["rules before duplication: ",InputForm[rules]]];
rules=Fold[changeRuleforfreepmQ,rules,pmQinds];
If[verb,Print["rules after changRuleforfreepmQ: ",InputForm[rules]]];
rules=Fold[duplicateRuleforfree,rules,dupfreemetric];
If[verb,Print["rules after duplicateRuleforfree: ",InputForm[rules]]];
pairs=Union[UpIndex/@Flatten[pairs,1]];
rules=Fold[duplicateRulefordummy,rules,pairs];
If[verb,Print["rules after duplication: ",InputForm[rules]]];
If[contr,rules=rules/.Rule[lhs_Hold,Hold[rhs_]]:>Rule[lhs,With[{contrrhs=ContractMetric[rhs]},Hold[contrrhs]]];
If[verb,Print["rules after metric contraction: ",rules]]];
rules=rules/.Rule[lhs_Hold,rhs_Hold]:>FlattenTimes[Rule[lhs,rhs]];
If[verb,Print["rules after arranging minus signs: ",rules]];

(* 4. Replace indices *)
rules=rules/.Rule[lhs_Hold,rhs_Hold]:>Rule[ReplaceIndex[lhs,rulesLHS],rhs];
If[verb,Print["rules after pattern: ",rules]];

(* 5. Add Module on the RHS *)
rules=rules/.Rule->IndexRule;

(* 6. Add conditions *)
conds=Hold[conditions];
If[verb,Print["Conditions: ",conds]];
rules=(addconditions[#,conds]&/@rules)/.Hold[cond_]:>cond;

(* 7. Return rules *)
rules
]
]

Because the lhs is held, we need to flatten the possible -1's that could have been generated by the symmetry-equivalent tensors:

FlattenTimes[Rule[Hold[Times[-1,x_]],Hold[rhs_]]]:=Rule[Hold[x],Hold[-rhs]];
FlattenTimes[Rule[Hold[Times[x___,Times[-1,y__],z___]],Hold[rhs_]]]:=FlattenTimes[Rule[Hold[Times[x,y,z]],Hold[-rhs]]];
FlattenTimes[Rule[lhs_Hold,rhs_Hold]]:=Rule[lhs,rhs];

addconditions[rule_RuleDelayed,conds_]:=If[conds===Hold[],rule,rule/.RuleDelayed[lhs_,rhs_]:>RuleDelayed[lhs,Condition[rhs,conds]]]

Construct a table of data with the indices and their properties:

ConstructLHSinfo[indsLHS_List,freesLHS_List,{mo_,ti_,patindsLHS_}]:=
Module[{LHSinfo,tmp},

(* 1. Name of index in input rule *)
LHSinfo=Partition[indsLHS,1];

(* 2. Free character *)
LHSinfo=Append[#,MemberQ[freesLHS,First@#]]&/@LHSinfo;

(* 3. MetricOn. up/down character in mo is corrected *)
tmp=Switch[mo,
None,{},
All,indsLHS,
_List,Intersection[mo~Join~(ChangeIndex/@mo),indsLHS],
_,Throw@Message[MakeRule::unknown,"indices",mo]
];
LHSinfo=Append[#,MemberQ[tmp,First@#]&&MetricEndowedQ@VBundleOfIndex@First@#]&/@LHSinfo;

(* 4. TestIndices *)
LHSinfo=Append[#,ti]&/@LHSinfo;

(* 5. Pattern character in final rule. up/down character in patindsLHS is corrected *)
tmp=Switch[patindsLHS,
None,{},
All,indsLHS,
_List,Intersection[patindsLHS~Join~(ChangeIndex/@patindsLHS),indsLHS],
_,Throw@Message[MakeRule::unknown,"indices",patindsLHS]
];
LHSinfo=Append[#,MemberQ[tmp,First@#]]&/@LHSinfo;

(* 6. Name in final rule. Currently we do not change names *)
LHSinfo=Append[#,First@#]&/@LHSinfo;

(* 7. Return LHSinfo *)
LHSinfo
];

The new function:

Options[MakeRule]={PatternIndices->All,TestIndices->True,MetricOn->None,UseSymmetries->True,Verbose->False,ContractMetrics->False,Evaluate->False};
SetAttributes[MakeRule,HoldFirst];
MakeRule[{LHS_,RHS_,conditions___},options:OptionsPattern[]]:=
With[{HeldLHS=ReplaceIsolated[Hold[LHS]],HeldRHS=ReplaceDummies[Hold[RHS]]},
Module[{
(* Contractible indices *)
indsLHS=List@@TakeEIndices[FindIndices[LHS]],
freesLHS=List@@TakeEIndices[FindFreeIndices[LHS]],
indsRHS=List@@TakeEIndices[FindIndices[RHS]],
freesRHS=List@@TakeEIndices[FindFreeIndices[RHS]],
isolated=ExtractIsolated[HeldLHS,Hold],
patindsLHS,ti,mo,us,verb,contr,ev,
dupfreemetric,pmQinds,pairs,rulesLHS,
symtensorsLHS,
newLHSs,
rules,conds},

(* Options *)
{patindsLHS,ti,mo,us,verb,contr,ev}=OptionValue[{PatternIndices,TestIndices,MetricOn,UseSymmetries,Verbose,ContractMetrics,Evaluate}];

(**** A. Checks ****)
If[Or@@(PIndexQ/@indsLHS),Throw@Message[MakeRule::pats,"left"]];
If[Or@@(PIndexQ/@indsRHS),Throw@Message[MakeRule::pats,"right"]];
If[LHS===0,Throw@Message[MakeRule::error,"LHS of rule evaluates to zero."]];
If[(Sort@freesLHS)=!=(Sort@freesRHS)&&RHS=!=0,Throw@Message[MakeRule::inhom,freesLHS,freesRHS]];
If[Length@ListOfTerms[LHS]>1,Throw@Message[MakeRule::terms]];
If[mo=!=None&&careQ[Identify[LHS]],Print["** MakeRule: Potential problems moving indices on the LHS."]];

(**** B. Construct and interpret LHSinfo ****)
With[{
LHSinfo=ConstructLHSinfo[IndexName/@indsLHS,IndexName/@freesLHS,{mo,ti,patindsLHS}]},
If[verb,Print["LHSinfo: ",LHSinfo]];
(* Index replacement rules *)
rulesLHS=(FormatIndexRule/@LHSinfo)/.{patternTest->PatternTest,pattern->Pattern};
If[verb,Print["rulesLHS: ",rulesLHS]];
(* Indices that give pmQ patterns (always converted to upindices) *)
pmQinds=Cases[LHSinfo,{index_,True,True,True,True,_}->index];
(* Pairs of contracted indices. They do not need duplication by symmetry *)
pairs=Partition[List@@TakeEPairs[IndexList@@Cases[LHSinfo,{index_,False,True,_,_,_}->index]],2];
(* Free indices that give duplicatefree rules *)
dupfreemetric=Complement[Cases[LHSinfo,{index_,True,True,_,_,_}->index],pmQinds];
];

(**** C. Symmetries on the LHS ****)
(* Detect non-isolated tensors with symmetries *)
symtensorsLHS=Cases[Complement[FindAllOfType[HeldLHS,Tensor],FindAllOfType[isolated,Tensor]],tensor_/;OrderOfGroup[SymmetryGroupOfTensor[tensor]]=!=1];
If[verb,Print["symtensorsLHS: ",symtensorsLHS]];
If[!us||symtensorsLHS==={},
newLHSs={HeldLHS},
(* Create a list of equivalents to symtensorsLHS due to the symmetries of tensors, with metric pairs eliminated because they will give duplicated rules below *)
Module[{groups,newtensors,tmp,equivalents},
groups=Join[{IndexList@@freesLHS},Apply[IndexList,pairs,{1}]];
newtensors=SymmetryEquivalentsOfTensor[#,Sequence@@groups]&/@symtensorsLHS;
If[verb,Print["newtensors: ",newtensors]];
equivalents=Flatten[Outer[tmp,Sequence@@newtensors]]/.tmp->List;
If[verb,Print["equivalents: ",equivalents]];
(* The strange Rule[#2,#1]& construction below is needed because Inner is asymmetric when the lists have different depths *)
newLHSs=HeldLHS/.Inner[Rule[#2,#1]&,equivalents,symtensorsLHS,List]//.HoldPattern[der_?FirstDerQ[-expr_]]->-der[expr];
]
];
If[verb,Print["newLHS after symmetry handling: ",newLHSs]];
(* Isolated expressions are handled through a recursive call to MakeRule *)
Module[{isolated2,isorules},
If[verb,Print["isolated: ",isolated]];
If[isolated=!={},
Block[{FlattenTimes=Identity},
isolated2=Transpose[Flatten[Apply[Outer[IndexList,##]&,patternisolated[#,options]&/@isolated]]/.IndexList->List]
];
If[verb,Print["isolated2: ",isolated2]];
isorules=Inner[makerule,isolated,isolated2,List];
If[verb,Print["isorules: ",isorules]];
newLHSs=Flatten[newLHSs/.isorules];
]
];
If[verb,Print["newLHSs after handling of isolated expressions: ",newLHSs]];

(**** D. Construct rules ****)
(* 1. Duplication *)
rules=Inner[Rule,newLHSs,HeldRHS&/@newLHSs,List];
(* Optional evaluation at this point only *)
If[ev,rules=Map[Evaluate,rules,{3}]];
If[verb,Print["Initial rules: ",InputForm[rules]]];
rules=rules/.Rule[lhs_Hold,rhs_Hold]:>FlattenTimes[Rule[lhs,rhs]];
If[verb,Print["rules after arranging minus signs: ",rules]];
rules=Fold[changeRuleforfreepmQ,rules,pmQinds];
If[verb,Print["rules after changRuleforfreepmQ: ",InputForm[rules]]];
rules=Fold[duplicateRuleforfree,rules,dupfreemetric];
If[verb,Print["rules after duplicateRuleforfree: ",InputForm[rules]]];
pairs=Union[UpIndex/@Flatten[pairs,1]];
rules=Fold[duplicateRulefordummy,rules,pairs];
If[verb,Print["rules after duplication: ",InputForm[rules]]];
If[contr,rules=rules/.Rule[lhs_Hold,Hold[rhs_]]:>Rule[lhs,With[{contrrhs=ContractMetric[rhs]},Hold[contrrhs]]];
If[verb,Print["rules after metric contraction: ",rules]]];

(* 2. Replace indices *)
rules=rules/.Rule[lhs_Hold,rhs_Hold]:>Rule[ReplaceIndex[lhs,rulesLHS],rhs];
If[verb,Print["rules after introducing patterns: ",rules]];

(* 3. Add Module on the RHS *)
rules=rules/.Rule->IndexRule;

(* 4. Add conditions *)
conds=Hold[conditions];
If[verb,Print["Conditions: ",conds]];
rules=(addconditions[#,conds]&/@rules)/.Hold[cond_]->cond;

(* 5. Return rules *)
rules
]
];

patternisolated[Hold[expr_],options___]:=First/@MakeRule[{expr,expr},options];
makerule[Hold[lhs_],rhs_HoldPattern]:=ReplacePart[RuleDelayed[HoldPattern[lhs],rhs],rhs,2,1];

10.4.3. Examples 1

Check cases:

BeginExamples[]

DefManifold[M2,2,{A,B,C,D,F,G}]

DefTensor[T[],M2]

DefTensor[v[],M2]

DefTensor[metricg[-A,-B],M2,Symmetric[{1,2}],PrintAs->"g"];

xUpSet[MetricsOfVBundle[TangentM2],{metricg}]

Unprotect[metricg];
metricg[A_Symbol,-B_Symbol]:=delta[A,-B]
metricg[-A_Symbol,B_Symbol]:=delta[-A,B]
Protect[metricg];

1) Nothing to do:

MakeRule[{a,b}]

MakeRule[{T[F,-F,-A$,C$,-D]v[-C$],v[-A$,-D]v[C$]v[-C$]},MetricOn->None,PatternIndices->None,UseSymmetries->False]//InputForm

2) Not patterns. Metric indices. Free:

MakeRule[{T[F,-F,-A$,C$,D]v[-C$],v[-A$,D]v[C$]v[-C$]},MetricOn->{D},PatternIndices->None,UseSymmetries->False]//InputForm

MakeRule[{T[F,-F,-A$,C$,-D]v[-C$],v[-A$,-D]v[C$]v[-C$]},MetricOn->{-D},PatternIndices->None,UseSymmetries->False]//InputForm

MakeRule[{T[F,-F,-A$,C$,-D]v[-C$],v[-A$,-D]v[C$]v[-C$]},MetricOn->{D},PatternIndices->None,UseSymmetries->False]//InputForm

MakeRule[{T[F,-F,A$,C$,-D]v[-C$],v[A$,-D]v[C$]v[-C$]},MetricOn->{-A$},PatternIndices->None,UseSymmetries->False]//InputForm

3) Not patterns. Metric indices. Dummy:

MakeRule[{T[F,-F,-A$,C$,-D]v[-C$],v[-A$,-D]v[C$]v[-C$]},MetricOn->{F},PatternIndices->None,UseSymmetries->False]//InputForm

MakeRule[{T[F,-F,-A$,C$,-D]v[-C$],v[-A$,-D]v[C$]v[-C$]},MetricOn->{-F},PatternIndices->None,UseSymmetries->False]//InputForm

4) Patterns. Not metric indices. Free. No test:

MakeRule[{T[F,-F,-A$,C$,D]v[-C$],v[-A$,D]v[C$]v[-C$]},MetricOn->{},PatternIndices->{D},UseSymmetries->False,TestIndices->False]//InputForm

MakeRule[{T[F,-F,-A$,C$,-D]v[-C$],v[-A$,-D]v[C$]v[-C$]},MetricOn->{},PatternIndices->{-D},UseSymmetries->False,TestIndices->False]//InputForm

MakeRule[{T[F,-F,A$,C$,-D]v[-C$],v[A$,-D]v[C$]v[-C$]},MetricOn->{},PatternIndices->{A$},UseSymmetries->False,TestIndices->False]//InputForm

5) Patterns. Not metric indices. Free. Test:

MakeRule[{T[F,-F,-A$,C$,-D]v[-C$],v[-A$,-D]v[C$]v[-C$]},MetricOn->{},PatternIndices->{D},UseSymmetries->False,TestIndices->True]//InputForm

MakeRule[{T[F,-F,A$,C$,-D]v[-C$],v[A$,-D]v[C$]v[-C$]},MetricOn->{},PatternIndices->{-A$},UseSymmetries->False,TestIndices->True]//InputForm

6) Patterns. Not metric indices. Dummy. No test:

MakeRule[{T[F,-F,-A$,C$,-D]v[-C$],v[-A$,-D]v[C$]v[-C$]},MetricOn->{},PatternIndices->{F},UseSymmetries->False,TestIndices->False]//InputForm

7) Patterns. Not metric indices. Dummy. Test:

MakeRule[{T[F,-F,-A$,C$,-D]v[-C$],v[-A$,-D]v[C$]v[-C$]},MetricOn->{},PatternIndices->{-F},UseSymmetries->False,TestIndices->True]//InputForm

8) Patterns. Metric indices. Free. No test:

MakeRule[{T[F,-F,-A$,C$,-D]v[-C$],v[-A$,-D]v[C$]v[-C$]},MetricOn->{-D},PatternIndices->{-D},UseSymmetries->False,TestIndices->False]//InputForm

9) Patterns. Metric indices. Free. Test:

MakeRule[{T[F,-F,-A$,C$,-D]v[-C$],v[-A$,-D]v[C$]v[-C$]},MetricOn->{-D},PatternIndices->{-D},UseSymmetries->False]//InputForm

MakeRule[{T[F,-F,-A$,C$,D]v[-C$],v[-A$,D]v[C$]v[-C$]},MetricOn->{D},PatternIndices->{D},UseSymmetries->False]//InputForm

10) Patterns. Metric indices. Dummy. No test:

MakeRule[{T[F,-F,-A$,C$,-D]v[-C$],v[-A$,-D]v[C$]v[-C$]},MetricOn->{F},PatternIndices->{F},UseSymmetries->False,TestIndices->False]//InputForm

MakeRule[{T[F,-F,-A$,C$,-D]v[-C$],v[-A$,-D]v[C$]v[-C$]},MetricOn->{-F},PatternIndices->{-F},UseSymmetries->False,TestIndices->False]//InputForm

11) Patterns. Metric indices. Dummy. Test:

MakeRule[{T[F,-F,-A$,C$,-D]v[-C$],v[-A$,-D]v[C$]v[-C$]},MetricOn->{F},PatternIndices->{F},UseSymmetries->False,TestIndices->True]//InputForm

MakeRule[{T[F,-F,-A$,C$,-D]v[-C$],v[-A$,-D]v[C$]v[-C$]},MetricOn->{-F},PatternIndices->{-F},UseSymmetries->False,TestIndices->True]//InputForm

12) Patterns. Metric indices. Free. Test:

MakeRule[{T[-F,-A$,C$,-D]v[-C$],v[-F,-A$,-D]v[C$]v[-C$]},MetricOn->{-F},PatternIndices->{-F},UseSymmetries->False,TestIndices->True]//InputForm

MakeRule[{T[-F,-A$,C$,-D]v[-C$],v[-F,-A$,-D]v[C$]v[-C$]},MetricOn->{-F},PatternIndices->{-F},UseSymmetries->False,TestIndices->True,Verbose->True]//InputForm

13) Conditions:

MakeRule[{v[A,-A,B,-B],v[B,-B],UpIndexQ[A]&&DownIndexQ[-B]&&PairQ[A,-B]},TestIndices->False]

InputForm[%]

UndefTensor/@{T,v,metricg};

UndefManifold[M2]

EndExamples[]

10.4.4. Examples 2. Symmetries

BeginExamples[]

DefManifold[M2,2,{A,B,C,D,F,G}]

DefTensor[T[-A],M2]

DefTensor[S[-A,-B],M2,Symmetric[{-A,-B}]]

DefTensor[V[-A],M2]

DefTensor[Rie[-A,-B,-C,-D],M2,RiemannSymmetric[{1,2,3,4}]]

DefTensor[Ric[-A,-B],M2,Symmetric[{1,2}]]

DefTensor[RS[],M2]

DefTensor[Anti[-A,-B,-C,-D,-F],M2,Antisymmetric[{1,2,3,4,5}]]

DefTensor[metricg[-A,-B],M2,PrintAs->"g"]

Simplest case:

MakeRule[{S[-A,-B]S[B,C]T[-C],T[-A]},UseSymmetries->False]

%//InputForm

Note the minus sign in front:

MakeRule[{-S[-A,-B]S[B,C]T[-C],T[-A]},UseSymmetries->False,TestIndices->False]

%//InputForm

MakeRule[{S[-A,-B]S[B,C]T[-C],T[-A]},TestIndices->False]

%//InputForm

xUpSet[MetricsOfVBundle[TangentM2],{}];

rule=MakeRule[{S[-A,-B]S[B,C]T[-C],T[-A]},MetricOn->All]

xUpSet[MetricsOfVBundle[TangentM2],{metricg}];

xUpSet[xATP`SymmetryOfMetric[metricg],1];

rule=MakeRule[{S[-A,-B]S[B,C]T[-C],T[-A]},MetricOn->All]

ScreenDollarIndices[rule]

S[B,A]S[-C,-B]T[C]/.rule//ScreenDollarIndices

rule=MakeRule[{Rie[-A,-B,-C,-D]T[B]V[D],T[-A]V[-C]},MetricOn->{B,D}];

Rie[-A,-B,-C,-D]{T[B]V[D],T[B]V[C],V[A]T[D],T[C]V[A],V[B]T[D]}/.rule

Rie[-A,B,-C,-D]T[-B]V[D]/.rule

Rie[-A,-B,C,D]T[A]V[-D]/.rule

rule=MakeRule[{Rie[A,-B,C,-D]T[B]V[D],T[A]V[C]},MetricOn->{B,D}];

Rie[-A,-B,C,D]T[B]V[-D]/.rule

rule=MakeRule[{S[-A,-B]T[B],T[-A]T[B]T[-B]},MetricOn->All];

S[B,A]T[-B]/.rule//ScreenDollarIndices

S[-A,-C]T[C]/.rule//ScreenDollarIndices

S[B,A]T[-B]S[-A,-C]T[C]/.rule//ScreenDollarIndices

S[B,A]T[-B]S[-A,-C]T[C]//.rule//ScreenDollarIndices

Catch@MakeRule[{T[-B,B,-C]+T[D,-D,-C],T[-C,B,-B]},MetricOn->{B,C,A}]

Catch@MakeRule[{T[-A,-B,-D,C]T[B,D,-C],T[-A]},MetricOn->False]

MakeRule[{T[-A,-B,-D,C]T[B,D,-C],T[-A]},MetricOn->None]

MakeRule[{T[-A,-B,-D,C]T[B,D,-C],T[-A]},MetricOn->{}]

rule=MakeRule[{T[-A,-B,-D,C]T[B,D,-C],T[-A]},MetricOn->{D}]

%//InputForm

T[-A,-B,-D,C]T[B,D,-C]/.rule

T[-A,B,-D,C]T[-B,D,-C]/.rule

rule=MakeRule[{T[-A,-B,-D,C]T[B,D,-C],T[-A]},MetricOn->{D,C},PatternIndices->{A,B,D}]

rule=MakeRule[{T[-A,-B,-D,C]T[B,D,-C],T[-A]},MetricOn->All,PatternIndices->{A,B,D}]

%//ScreenDollarIndices

%//InputForm

T[-A,-B,-D,C]T[B,D,-C]/.rule

T[-A,B,-D,C]T[-B,D,-C]/.rule

T[-A,B,-D,-C]T[-B,D,C]/.rule

T[A,B,-D,-C]T[-B,D,C]/.rule

Note that here we do not need to use MetricOn on index b because the symmetries of the Riemann tensor automatically account for that. There is no danger, however, in using MetricOn->All: we will just get every rule twice.

MakeRule[{Rie[-A,-B,-C,B],Ric[-A,-C]},TestIndices->False,MetricOn->None]

MakeRule[{Ric[-A,A],RS[]}]

rule=MakeRule[{Rie[-A,-B,-C,B],Ric[-A,-C]},MetricOn->{A,C}]

Length[rule]

Rie[-A,-B,A,C]/.rule//ScreenDollarIndices

xUpSet[MetricsOfVBundle[M2],{}];

UndefTensor/@$Tensors

UndefManifold[M2]

Remove[rule]

EndExamples[]

10.4.5. Examples 3. Basis indices

BeginExamples[]

Options[MakeRule]

xAct`xCoba`BasisColor[polar]^=RGBColor[0,1,0];

DefManifold[M2,2,{A,B,C,D,F,G}]

DefTensor[S[A,B,C],M2]

DefTensor[V[A],M2]

rule2=IndexRule[S[{A_,polar},{-B_,polar},C_],V[{A,polar}]V[{-B,polar}]V[C]]

rule2//InputForm

S[{C,polar},{-C,polar},F]/.rule2

MakeRule[{S[{A,polar},{B,polar}],V[{A,polar}]V[{B,polar}]}]

UndefTensor[V]

UndefTensor[S]

UndefManifold[M2]

Remove[polar,rule2]

EndExamples[]

10.4.6. ToRule

The design of MakeRule is not very good. Its use of List in the first argument and its Hold attribute make users of xAct to create their own drivers to it, like Alfonso’s function

ApplyRuleN[expr_]:=MakeRule[Evaluate[List@@expr]];

We introduce the function ToRule, a driver for MakeRule:

Options[ToRule]=Options[MakeRule];
ToRule[expr:(_Equal|_Rule|_RuleDelayed),options___]:=With[{list=List@@expr},MakeRule[list,options]];
ToRule[{}]:={};
ToRule[list:{(_Equal|_Rule|_RuleDelayed|_List)..},options___]:=Join@@(ToRule[#,options]&/@list);
ToRule[{lhs_,rhs_,cond___},options___]:=MakeRule[{lhs,rhs,cond},options];

10.5. AutomaticRules

This function gives the minimum depth of symbol in expr. If the depth is 0 we can define a downvalue for symbol. If it is 1, we define an upvalue. If it is more than 1, then a generic rule is defined. Note that we need to eliminate HoldPattern from the expressions.

minimumdepth[expr_,symbol_]:=Min[Length/@Cases[Position[expr/.HoldPattern->Identity,symbol],{1,x___,0}->{x}]]

Clear[AutomaticRules]

?AutomaticRules

?$Rules

QUESTION: The function minimumdepth is evaluating the symbol. Can we avoid this?

SetAttributes[AutomaticRules,HoldFirst];
Options[AutomaticRules]={Verbose->True};
AutomaticRules[symbol_Symbol,rules_List,options:OptionsPattern[]]:=Module[{pos=minimumdepth[#,symbol]&/@rules,
upvs,downvs,othervs,
verbose=OptionValue[Verbose]},
(* Select downvalues and upvalues *)
upvs=Flatten[Position[pos,1]];
downvs=Flatten[Position[pos,0]];
othervs=Complement[Range[Length[rules]],upvs,downvs];
If[Length[downvs]>0,AppendTo[DownValues[symbol],#]&/@rules[[downvs]];
If[verbose,Print["   Rules ",Shallow[downvs]," have been declared as DownValues for ",symbol,"."]]];
If[Length[upvs]>0,AppendTo[UpValues[symbol],#]&/@rules[[upvs]];If[verbose,Print["   Rules ",Shallow[upvs]," have been declared as UpValues for ",symbol,"."]]];
If[Length[othervs]>0,AppendTo[$Rules,#]&/@rules[[othervs]];If[verbose,Print["   Rules ",Shallow[othervs]," have been declared as generic Rules."]]]; 
];

SetNumberOfArguments[AutomaticRules,{2,Infinity}];
Protect[AutomaticRules,Verbose];

BeginExamples[]

DefManifold[M2,2,{A,B,C,D,F,G}]

DefTensor[T[],M2]

DefTensor[S[],M2]

Unprotect[T];
AutomaticRules[T,{T[B,D]T[A,-B]:>T[A,D],T[B,D]:>S[B,D],F[F[T[B,D]]]:>S[B,D]}]
Protect[T];

T[B,D]

T[B,D]T[A,-B]

Note that the downvalue for T is replaced in the upvalue before registering it. Use HoldPattern to avoid these kind of things:

??T

xUpSet[MetricsOfVBundle[TangentM2],{}]

UndefTensor/@$Tensors;

UndefManifold[M2]

EndExamples[]

11. Covariant and parameter derivatives

(*********************** 11.Covariant derivatives *********************)

{TimeUsed[],SessionTime[],TimeUsed[]/SessionTime[]}

11.0. Comments

11.0.1. Notations

If[$ReadingVerbose,Print["Reading section 11: Covariant derivatives."],Null,Null]

It is difficult to choose the notation for covariant derivatives. There are four main possibilities, with advantages and disadvantages, depending on what you want to stress:
	1) The operator character of the derivative: cd[-a][ v[b] ]
	2) The fact that the result is another abstract tensor field: TensorDerivative[v, cd][b, -a]
	3) The indexed representation of the covariant derivatives: v[b, cd[-a]]
	4) More symmetric roles played between vectors and derivatives: TensorD[v[b], cd[-a]]
The notation for a derivative f'[x] in Mathematica is actually Derivative[1][f][x], which reflects quite properly the operator character of the derivative, while keeping the function structure head[args] at the same time. That is very similar to the TensorDerivative option above, and right now it is my preferred choice. However, my original choice was cd[-a][ expr ]:
	- The main advantage is that cd[-a][ T[-b,-c] ] behaves properly under the rule T[-b,-c] -> A[-b,-c] + C[-b,-c], while the other notation need to include the derivatives in the rule, or use a pure-tensor language.
	- The main disadvantage is that it is not possible to associate a rule containing second derivatives to the object being differentiated. Another disadvantage is the larger number of brackets to use, but you get easily used to that.
Currently xTensor supports both  options 1) and 2). Options 2 is not supported (it was for some time long ago), because it is rather ambiguous when the index of cd is a basis index, and option 4 is automatically converted into notation 2), imitating Mathematica’s pair D/Derivative.

Covariant derivatives are operators. As pointed out by Eduardo the most general kind of derivative is that of the form
			covd[ v[a] ][ expr ]
where covd is tensorial in its first argument, that is
			covd[ f[] v[a] ][ expr ] = f[] covd[ v[a] ][ expr ] .
We have the notation
			covd[ Dir[v[a]] ][ expr ]
Using abstract indices, this can be represented as
			v[a] covd[-a][ expr ] .
Only if the manifold is parallelizable we can choose a basis of vector fields and define the usual covariant derivative
			covd[ -{a, B} ][ expr ]
where now -{a, B} is the index in the collection B of basis vectors. We shall assume that this is always the case. As pointed out by Penrose and Rindler, it is physically reasonable to assume that spacetime manifolds are parallelizable. Anyway, the only obstruction could be of global origin, and xTensor only does local computations.

11.0.2. Gauge connections

Starting version 0.9 of xTensor we have introduced general vector bundles, that is, bundles different from the tangent bundles that we were using in previous versions 0.7 and 0.8. This is not a big change in sections 1-10, but it is a big change concerning covariant derivatives. The main reason is the fact that now there are two curvatures associated to each covd, as well as two types of Christoffels (but still just one type of Torsion tensor). In this issue we closely follow the paper by Asthekar et al, General Relativity and Gravitation 14 (1982), 411. I thank Alfonso Garcia-Parrado for much help and guidance in  implementing this change.

Main ideas of the change:
	1. We shall distinguish the symbols Christoffel and AChristoffel, the former with the typical use it always had, and the latter with identical use on the fiber space.
	2. In parallel, we shall distinguish the symbols Riemann and FRiemann, respectively.
	3. There is still just Torsion on the tangent manifold, but not on other types of fibers.
	4. Covariant derivatives are defined on the base manifolds, but they can act either in the tangent manifold, or in a more general fiber, or in both, and this must be explicitly stated at definition time of the derivative. It is possible to have several connections, acting on both the tangent and the inner vbundles, whose restriction to the tangent bundle coincide.
	5. In order to avoid duplicity of code we need to develop some algorithms being able to use either Christoffel or AChristoffel, and either Riemann or FRiemann, as arguments. Many operations will use them with either one of them or both.
	6. We shall use PD as the origin of the affine space of derivatives. By definition, PD has no curvature (neither Riemann or FRiemann) nor torsion. Effectively PD fakes the presence of a coordinate chart in xTensor, avoiding loading xCoba, but for actual computations with charts the full power of xCoba is needed.

11.0.3. Manifold and vbundles of a connection

Connections are always associated to a manifold M in the sense that every field having M as dependency will have (by default) non-zero derivative under that connection. Then, independently, they can act on the indices of different vector bundles (all having M as base manifold). Therefore we will associate two upvalues to any connection: ManifoldOfCovD and VBundlesOfCovD. To avoid defining values for the PD derivative the input can be both CD or CD[-a], such that PD[-a] will provide the vbundle information through its index.

VBundlesOfCovD[covd_[__]]:=VBundlesOfCovD[covd];
ManifoldOfCovD[covd_[__]]:=ManifoldOfCovD[covd];
SetNumberOfArguments[VBundlesOfCovD,1];
SetNumberOfArguments[ManifoldOfCovD,1];
Protect[VBundlesOfCovD,ManifoldOfCovD];

This private function can be constructed from both of those two, and I choose VBundlesOfCovD to ensure that we keep the convention of having the tangent vbundle as first member of the list:

TangentBundleOfCovD[covd_]:=First@VBundlesOfCovD[covd];

QUESTION: In order to incorporate additional dependencies and parameters there is also DependenciesOfCovD. It is not clear that the relation between ManifoldOfCovD and DependenciesOfCovD is correct. We should perhaps do as with tensors and define the former in terms of the latter.

QUESTION: An interesting question is the following: there are "direct-sum derivatives" in which the derivatives acting on different tangent vbundles Bi add up to form the derivative of the direct-sum vbundle BS of those (tangent) subvbundles Bi. On the other hand we have the generalized "fiber" derivatives which, even though they always have an index on a tangent bundle B, they also act on objects having indices on inner vbundles F having B as tangent bundle of their base manifold. They are clearly two independent problems, but the question is whether it is possible to implement both simultaneously (currently not done, I think ;). A related practical question is whether it is possible to use some parts of the code in solving both issues. In some sense, it is the question of teaching a derivative that, even if its index belongs to some vbundle, there are other vbundles on whose indices it must act as well.

Choice of index positions. As usual, we follow Wald's book as much as possible, though I must admit I don't understand why the Riemann tensor has the upper index at the end, but the Christoffel tensor has the upper index at the beginning:
	Riemann[-a, -b, -c, d]
	Christoffel[a, -b, -c]. Note that for non-symmetric covariant derivatives (not considered in Wald), the "derivative" index will be the middle index.

A problematic issue in xTensor is that of induced derivatives, which is very important in General Relativity. All definitions must take this case into account.

Configuration global variables concerning derivatives:
    	$CheckZeroDerivativeVerbose

11.0.4. Pullback connection

In xTensor 1.1.0 we introduce tensor fields along a map and other “mapped” objects, in particular connections. This requires a careful analysis of what VBundle properties are of purely vectorial-algebraic nature and hence only depend on the properties of the fiber (say dimension) and which properties are of differential nature and involve also the vbundle base. Clearly everything related to covariant differentiation is of the later type. The most important functions to think about are:

(Suppose CD has been defined with base N and we have a mapping ϕ : M -> N.)

- ManifoldOfCovD. PullBackCovD[ CD, ϕ ] has now base M, instead of N.

- VBundlesOfCovD. PullBackCovD[ CD, ϕ ] has now vbundles {PullBackVBundle[ TangentN, ϕ ], ... }

- BaseOfVBundle. PullBackVBundle[ TangentN, ϕ ] has now base M, instead of N.

The main question is: do we load the map on the names of the modified objects (say the vbundles) or do we create an additional property MappingOfCovD?

Note that, unlike tensors, we are not planning to allow the definition of a mapped connection in DefCovD. The elementary connections must all belong to elementary vbundles and then be mapped with mappings. Tensors, however, can be declared along a map at definition time.

11.0.5. The Leibnitz operator

This is a simple way of coding up the long lists of terms associated to the changes of derivatives. The name comes from the fact that this is an "algebraic derivative", in the sense that Leibnitz[A B][-a,b] = Leibnitz[A][-a,b]B+A Leibnitz[B][-a,b].

Leibnitz[expr_][-a_,b_]:=With[{frees=FindFreeIndices[expr],vbQ=VBundleIndexQ[VBundleOfIndex[a]]},Plus@@Map[(delta[-a,#]ReplaceIndex[expr,#->b])&,Select[frees,vbQ]]-Plus@@Map[(delta[-#,b]ReplaceIndex[expr,-#->-a])&,Select[ChangeIndex/@frees,vbQ]]
];
Protect[Leibnitz];

11.1. Christoffel tensors

11.1.0. Comments

A Christoffel tensor depends on two derivatives. This is a complication in xTensor's scheme because it doesn't follow the normal rule Riemanncovd, for example. We need Christoffel tensors of the form Christoffelcd1cd2 but that means n(n-1)/2 tensors if there are n derivatives.

We shall do the following: there is a command Christoffel[cd1,cd2][i1, i2, i3] which constructs Christoffelcd1cd2[i1, i2, i3]. This command must check whether that tensor already exists or not, and if it doesn't then it has to be defined. There exists a similar command AChristoffel[cd1, cd2][i1, i2, i3] for the covariant derivatives on inner fiber bundles, which is actually a call to Christoffel, which is able to handle both cases, because the information required is stored in the indices provided. That means in particular that Christoffel[cd1, cd2] does not evaluate, what is another exception with respect to Riemann[cd] and the like.

Then we define commands which change the objects associated to a covd: ChangeCovD, ChangeTorsion and ChangeCurvature. We also need BreakChristoffel.

Simultaneous problems to take into account:
	- The two-ders dependencies of Christoffels.
	- Some formulas involve derivatives and therefore are different for basis-indices.
	- There can be derivatives belonging to different manifolds. I'm not sure we can allow Christoffel tensor between a manifold and one of its submanifolds. Currently I forbid that. QUESTION.
	- Again, the problem of induced derivatives.

We shall list all Christoffels, including the AChristoffel objects, with the private global variable

$Christoffels={};

The format for each element of that list is {christoffelname, {christoffeltype, cd1, cd2}, vbundles}, where christoffeltype is one of Christoffel or AChristoffel, and vbundles is a list with either a tangent bundle (all indices of the christoffel belong to that bundle) or a tangent bundle and other inner bundles.

To alleviate the problem of naming two derivatives we shall define an ordinary derivative PD defined on all manifolds, and which will be used as default in many cases. It is a fiducial derivative with no torsion and no curvature. This is effectively a trick to work with **a single** chart without having to load xCoba.

Covariant derivatives are associated to full vbundles, and not only to manifolds, because we need to know the indices they act upon. The structure of indices will be the following: In AChristoffel[A,-b,-C] the indices A, -C belong to the generic vector bundle, while -b belongs to the tangent bundle of the manifold.

11.1.1. CovD compatibility

It is not possible to use any two derivatives to construct a Christoffel tensor. We define the following function to check whether two derivatives can be related via Christoffel tensors or not: Two derivatives are compatible iff:
	- one of them (or both) is PD, or
	- both act on the same base manifold and
		- one of them (or both) does not act on any internal vector bundle, or
		- both act on the same internal vector bundle.

In this function VBundlesOfCovD is assumed to return a list with at least one element, but no upper limit, though currently we only work with up to three bundles. Note also that there is no reference to the indices of the derivatives. That means that for "direct-sum derivatives" we will be comparing the large vbundles.

(* Main driver *)
CompatibleCovDsQ[covd_,covd_?CovDQ]:=True;
CompatibleCovDsQ[PD,covd_?CovDQ]:=True;
CompatibleCovDsQ[covd_?CovDQ,PD]:=True;
CompatibleCovDsQ[covd1_?CovDQ,covd2_?CovDQ]:=compareCovDs[VBundlesOfCovD[covd1],VBundlesOfCovD[covd2],False];
CompatibleCovDsQ[covd1_,covd2_?CovDQ]:=Throw@Message[Christoffel::unknown,"covariant derivative",covd1];
CompatibleCovDsQ[covd1_,covd2_]:=Throw@Message[Christoffel::unknown,"covariant derivative",covd2];
(* Actual decision. The third argument throws an error if the covds are incompatible *)
compareCovDs[{tb_},{tb_},_]:=True;
compareCovDs[{tb_,__},{tb_},_]:=True;
compareCovDs[{tb_},{tb_,__},_]:=True;
compareCovDs[{tb_,vb1__},{tb_,vb2__},mess_]:=compareCovDserror[Complement[{vb1},{vb2}]==={}||Complement[{vb2},{vb1}]==={},mess];
compareCovDs[{tb1_,___},{tb2_,___},mess_]:=If[mess,Message[Christoffel::base,tb1,tb2];Zero,False];
compareCovDserror[True,_]:=True;
compareCovDserror[False,mess_]:=If[mess,Throw@Message[Christoffel::error,"Incompatible vector bundles."],False];

Christoffel::base="Connections have different base manifolds `1` and `2`. Assuming their Christoffel vanishes.";

In the general case in which there are inner vbundles {vb1__} and {vb2__} on the same base manifold the compatibility condition is that one of them is a subset of the other. That is, either both derivatives act on the same vbundles or one extends the other.

Nov 2012: it has been discussed in the group whether the Christoffel between two connections with different base manifold should be Zero. I find that a bit dangerous because we might end up converting derivatives on one manifold into derivatives of the other manifold with zero Christoffels. Now when mess=True we accept that case, with the message Christtofel::base. This only happens when using Christoffel directly. The ChangeX functions will use CompatibleCovDsQ, with mess=False, because it is impossible to change between derivatives of different base manifolds. With mess=True the function compareCovDs can only return True, Zero (with the ::base message) or throw an ::error message, but never False.

Note that this function is perfectly symmetric in its two covd arguments.

There is the important issue now of dependencies of derivatives. Compability only checks for the same base manifold, but not for dependencies. In principle this is taken care of by the Christoffel relating the derivatives, which will have the union of the dependencies. It could happen for instance that two derivatives depend on time but their Christoffel difference doesn't. There is no way we can handle that and the user must add this information by hand.

11.1.2. ChangeCovD

?ChangeCovD

This function changes the derivative of an object by other derivative of the same object plus (A)Christoffel tensors. If a metric has not been defined then covariant derivative operators can only have a down-index . We do not check that here. Do it with Validate. There is a third argument expressing the new derivative to be used (default is PD). Remember the essential rule for index positioning in the Christoffel: the derivative index always in the middle position. This function works with any kind of index (i.e., including basis-indices), even though the dummies introduced are always abstract-indices.

We break its implementation in three steps: the user driver, a recursive function and the actual change:

1) User driver. Translate to changeCovD, which specifies two heads to add: the first one on the new derivative object; the second one on the added Christoffel objects. This is because this function is used in the process of canonicalization of derivatives, in which we need to mark temporarily the changed derivatives. Note that we check that the first given covd is actually a derivative, and throw an error if it is not. We do not check the second one because I haven't found the correct way of mixing Optional and PatternTest. We also check that derivatives covd and covd2 are compatible; if they are not we simply return the input, without any message being sent (this is because this will be a frequent case when threading over $CovDs below).

ChangeCovD[expr_,All,covd2_:PD]:=ChangeCovD[expr,$CovDs,covd2];
ChangeCovD[expr_,None,covd2_:PD]:=ChangeCovD[expr,{},covd2];
ChangeCovD[expr_,covd_?CovDQ,covd_]:=expr;
ChangeCovD[expr_,covd_?CovDQ,covd2_:PD]:=If[CompatibleCovDsQ[covd,covd2],changeCovD[expr,covd,covd2],expr];
ChangeCovD[expr_,list_List,covd2_:PD]:=Fold[ChangeCovD[#1,#2,covd2]&,expr,list];
ChangeCovD[expr_,x_,_:PD]:=Throw@Message[ChangeCovD::unknown,"covariant derivative",x];
ChangeCovD[expr_]:=ChangeCovD[expr,$CovDs];
SetNumberOfArguments[ChangeCovD,{1,3}];
Protect[ChangeCovD];

2) Internal recursion, keeping the same covd, covd2 pair. Now we check the second derivative. The derivative PD is problematic in this function as covd because it is not clear how we should choose the checking function tbpmQ.

If the derivatives are compatible then we know that they share the same tangent bundle, and hence we can get it from any of them. Even though the covd-covd case has been already handled by the first definition for ChangeCovD above, we include it here because there are functions below calling changeCovD directly. Note that we use the IndexOnQ function to check the vbundle of the indices. This is really only needed when covd is PD because we do not want to change all PD's in an expression: we want to change only those belonging to the same tangent vbundle of covd2. Any type of index is allowed, and so we use IndexOnQ instead of the tb`Q function.

(* Defaults for the fourth and fifth arguments *)
changeCovD[expr_,covd_,covd2_]:=changeCovD[expr,covd,covd2,Identity1,Identity];
changeCovD[expr_,covd_,covd_,_,_]:=expr;
(* CovDTODO *)
changeCovD[expr_,covd_,covd2_?CovDQ,tmpcovdhead_,tmpchrhead_]:=With[{
tb=TangentBundleOfCovD[If[covd===PD,covd2,covd]]},expr/.HoldPattern[covd[ind_?(IndexOnQ[#,tb]&)][expr1_]]:>makechangeCovD[changeCovD[expr1,covd,covd2,tmpcovdhead,tmpchrhead],covd,covd2,ind,tmpcovdhead,tmpchrhead]
];
changeCovD[expr_,_,x_,_,_]:=Throw[Message[ChangeCovD::unknown,"covariant derivative",x];ERROR[expr]];

A trivial head:

Identity1[a_,b___]:=a;

3) Actual change. Now we need to worry about the possibility of having several types of "differentiated" indices, corresponding to the different elements of VBundlesOfCovD (there is no check on the length of this list). The symbol CHR is not local to this function. It is used to transfer the responsibility for Christoffel construction and Christoffel index check to the command Christoffel. Again, covd and covd2 cannot be simultaneously PD, and this time we do not need a special definition because makechangeCovD is only called from changeCovD. The roles of covd and covd2 are clearly not symmetric in this function; however, it must always be possible to reverse the action of this function by simply reversing the ordering of covd and covd2:

xTensorQ[CHR]^=True;

(* Convert covd[ind][expr] into covd2[ind][expr]+stuff. CovDTODO *)
makechangeCovD[expr_,covd_,covd2_,ind_,tmpcovdhead_,tmpchrhead_]:=With[{vbundles=Apply[Union,VBundlesOfCovD/@DeleteCases[{covd,covd2},PD]]},
tmpcovdhead[covd2[ind][expr],covd]+
(Plus@@Map[addChristoffel[expr,ind],selecton[Select[FindFreeIndices[expr],AIndexQ],vbundles]]-addChristoffelDensity[expr,covd,ind,tmpchrhead]+addChristoffelDensity[expr,covd2,ind,tmpchrhead]/.CHR[indices__]:>tmpchrhead[Christoffel[covd,covd2][indices]])
];

Note that we select only abstract indices because those are the only indices producing Christoffel terms.

This small function returns an IndexList of pairs of indices: the first in each pair is an index in the original list belonging to one of the vbundles; the second is a dummy in that vbundle. Note that we are using IndexOnQ and hence we accept indices in subvbundles of vbundle, even though the dummy always belongs to the full vbundle. QUESTION. Is this always what we want?

selecton[indices_IndexList,vbundles_List]:=Apply[Union,selecton[indices,#]&/@vbundles];
selecton[indices_IndexList,vbundle_?VBundleQ]:={#,DummyIn[vbundle]}&/@Select[indices,IndexOnQ[#,vbundle]&];

Now we can create the Christoffel term. Note the use of the global variable CHR, to be later transformed into Christoffel with both derivatives. Indices are always introduced with the configuration {up, ?, down}, where the middle index is simply given with its original character.

addChristoffel[expr_,ind_][{oldind_?upQ,dummy_}]:=CHR[oldind,ind,-dummy]ReplaceIndex[expr,oldind->dummy];
addChristoffel[expr_,ind_][{oldind_?downQ,dummy_}]:=-CHR[dummy,ind,oldind]ReplaceIndex[expr,oldind->-dummy];
addChristoffelDensity[expr_,covd_?WeightedCovDQ,ind_,tmpchrhead_]:=With[{basis=WeightedWithBasis[covd],dummy=DummyIn@VBundleOfIndex[ind]},WeightOf[expr,basis]tmpchrhead[Christoffel[covd,xAct`xCoba`PDOfBasis[basis]][dummy,ind,-dummy]]expr];
addChristoffelDensity[_,_,_,_]:=0;

QUESTION: Why do we use a specific Christoffel in the density term instead of usins CHR as well?

Backwards compatibility:

?CovDToChristoffel

CovDToChristoffel=ChangeCovD;
Protect[CovDToChristoffel];

11.1.3. Christoffel

This function is defined with indices to check that they are correct with respect to the derivatives cd1, cd2. That also allows manipulating AChristoffel and Christoffel with the same code. This is an exception with respect to Riemann[cd] and similar constructs.

1) This is the user driver, that must be used to ensure that Christoffels are correctly dealt with. Those Christoffels having PD as one of the derivatives are abbreviated to ChristoffelCD, without PD appearing explicitly in the name.

?Christoffel

(* One argument *)
Christoffel[covd_][i1_,i2_,i3_]:=Christoffel[covd,PD][i1,i2,i3];
(* Check of Dagger for indices. Assume both i1, i3 have same dagger-character *)
Christoffel[covd1_,covd2_][i1_?DaggerIndexQ,i2_,i3_]:=Dagger[Christoffel[covd1,covd2][DaggerIndex[i1],i2,DaggerIndex[i3]]];
(* Three special cases *)
Christoffel[covd_?CovDQ,covd_][i1_,i2_,i3_]:=0;
Christoffel[covd_?CovDQ,PD][i1_,i2_,i3_]:=makeChristoffel[{covd,PD}][i1,i2,i3];
Christoffel[PD,covd_?CovDQ][i1_,i2_,i3_]:=-makeChristoffel[{covd,PD}][i1,i2,i3];
(* General case *)
Christoffel[covd1_?CovDQ,covd2_?CovDQ][i1_,i2_,i3_]:=Order[covd1,covd2]makeChristoffel[Sort[{covd1,covd2}]][i1,i2,i3];
(* Errors *)
Christoffel[_?CovDQ,covd_][i1_,i2_,i3_]:=Throw[Message[Christoffel::unknown,"covariant derivative",covd]];
Christoffel[covd_,_][i1_,i2_,i3_]:=Throw[Message[Christoffel::unknown,"covariant derivative",covd]];
SetNumberOfArguments[Christoffel,{1,2}];
Protect[Christoffel];

The head AChristoffel acting on two pairs of brackets is inmediately converted into Christoffel, to avoid repeating the whole code of Christoffel:

AChristoffel[covd1_,covd2_:PD][i1_,i2_,i3_]:=Christoffel[covd1,covd2][i1,i2,i3];
SetNumberOfArguments[AChristoffel,{1,2}];
Protect[AChristoffel];

We could add another head called AChristoffelDagger or similar to allow for the construction of the complex conjugate Christoffel. Instead, we prefer to force the use of the construction Dagger[Christoffel[_,_][_,_,_]], which is clearer with respect to the indices to use. Hence if Christoffel detects a Dagger index then it changes itself to that form, as we have seen.

2) Now we check that the derivatives and the indices are compatible, and at the same time (if everything is OK) decide whether to use Christoffel or AChristoffel. In this function covd is never PD. The derivatives are already sorted.

(* (A)Christoffel with covd and PD. No compatibility check needed. The tensor has already been defined *)
makeChristoffel[{covd_,PD}][i1_,i2_,i3_]:=Module[{chrtype,tbundle,vbundle},
{chrtype,tbundle,vbundle}=checkChristoffelIndices[VBundlesOfCovD[covd],VBundleOfIndex/@IndexList[i1,i2,i3]];
GiveSymbol[chrtype,covd][i1,i2,i3]
];

Now covd1 and covd2 are both different from PD, and are already sorted. Note that the call to compareCovDs is equivalent to a call to CompatibleCovDsQ, but now with the verbose switch on which will send a message if the tbundles of covd1, covd2 differ (and return Zero) or throw an error if they are the same but the inner vbundles are incompatible:

makeChristoffel[{covd1_,covd2_}][i1_,i2_,i3_]:=Module[{chrtype,chrname,vbundles1=VBundlesOfCovD[covd1],vbundles2=VBundlesOfCovD[covd2],tbundle,vbundle},
If[compareCovDs[vbundles1,vbundles2,True]===Zero,
0,
{chrtype,tbundle,vbundle}=checkChristoffelIndices[DeleteDuplicates@Flatten[{vbundles1,vbundles2}],VBundleOfIndex/@IndexList[i1,i2,i3]];
chrname=GiveSymbol[chrtype,covd1,covd2];
If[!xTensorQ[chrname],defChristoffel[chrname,{tbundle,vbundle},{chrtype,covd1,covd2}]];
chrname[i1,i2,i3]
]
];

3) Checking function. Note that the IndexList contains vbundles and not indices. The input has the vbundles of the covds being related, and then the vbundles of the three indices of the Christoffel tensor. The derivatives have already been tested for compatibility, and hence the list vbundles contains a single tangent vbundle, and it is at the first place in the list (perhaps repeated at a later place as well).

Christoffel::ind="Index `1` of (A)Christoffel is not compatible with derivative.";
Christoffel::inds13="Indices 1 and 3 of (A)Christoffel must belong to the same vbundle.";
checkChristoffelIndices[vbundles_List,IndexList[vb1_,vb2_,vb3_]]:=With[{
tb=First[vbundles],
svb1=Cases[vbundles,vb_/;SubvbundleQ[vb,vb1]],
svb2=Cases[vbundles,vb_/;SubvbundleQ[vb,vb2]],
svb3=Cases[vbundles,vb_/;SubvbundleQ[vb,vb3]]
},
Which[
svb2=!={tb},Throw[Message[Christoffel::ind,2]],
svb1==={},Throw[Message[Christoffel::ind,1]],
svb3==={},Throw[Message[Christoffel::ind,3]],
svb1=!=svb3,Throw@Message[Christoffel::inds13],
svb1===svb2,{Christoffel,tb,tb},
True,{AChristoffel,tb,First[svb1]}]
];

4) Define the Christoffel tensor if it does not exist yet. None of covd1 or covd2 in this function is ever PD. We assume that {covd1,covd2} are already sorted. There is no need to store complex conjugates of the Christoffel tensors, due to the i1_?DaggerIndexQ construction above. We create indices here instead of taking the previous {i1, i2, i3} because there is no guarantee that the latter are abstract. Note that tb and vb could coincide and that is why we need to extract excessive indices from both.

defChristoffel[chrname_,{tb_,vb_},{chrtype_,covd1_,covd2_},options___]:=
Module[{inds,vbinds=GetIndicesOfVBundle[vb,3],tbinds=GetIndicesOfVBundle[tb,2]},
inds=Sequence[vbinds[[1]],-tbinds[[2]],-vbinds[[3]]];
DefTensor[chrname[inds],Union[{tb,vb},DependenciesOfCovD[covd1],DependenciesOfCovD[covd2]],If[tb===vb&&Torsion[covd1][inds]===Torsion[covd2][inds],Symmetric[{2,3}],GenSet[]],PrintAs:>GiveOutputString[chrtype,covd1,covd2],TensorID->{chrtype,covd1,covd2},Dagger:>If[DaggerIndexQ@IndexList[inds],Complex,Real],options];
AppendTo[$Christoffels,{chrname,{chrtype,covd1,covd2},DeleteDuplicates[{tb,vb}]}];
];

11.1.4. BreakChristoffel

This function separates Christoffel tensors using an intermeadiate derivative, which is PD by default. Internal part:

?BreakChristoffel

Public function. Note that we cannot use Fold; we must use all breakChristoffel rules simultaneously. It is ugly to have a second argument accepting both covariant derivatives and christoffel tensors, but I guess it is late to change that.

BreakChristoffel[expr_]:=BreakChristoffel[expr,PD];
BreakChristoffel[expr_,covd_?CovDQ]:=expr/.Map[makeChristoffelRule[covd],$Christoffels];
BreakChristoffel[expr_,chr_?xTensorQ,covd_:PD]:=expr/.makeChristoffelRule[covd][Flatten[Cases[$Christoffels,{chr,_,_}],1]];
SetNumberOfArguments[BreakChristoffel,{1,3}];
Protect[BreakChristoffel];

Private functions. The derivative in the first bracket of makeChristoffelRule is the intermediate derivative.

makeChristoffelRule[PD][{chrname_,{_,covd1_,covd2_},_}]:=chrname[inds__]:>breakChristoffel[covd1,covd2,PD][inds];
makeChristoffelRule[covd_][{chrname_,{_,covd1_,covd2_},_}]:=If[CompatibleCovDsQ[covd,covd1]&&CompatibleCovDsQ[covd,covd2],
chrname[inds__]:>breakChristoffel[covd1,covd2,covd][inds],
{}];
makeChristoffelRule[_][{}]:={};

Finally (note that Christoffel will change itself into AChristoffel if needed, and the Dagger head will be used when needed as well):

breakChristoffel[covd1_,covd2_,covd_][inds__]:=Christoffel[covd1,covd][inds]-Christoffel[covd2,covd][inds];

11.1.5. ChangeTorsion

?ChangeTorsion

Public part:

ChangeTorsion[expr_,covd1_Symbol?TorsionQ,covd2_:PD]:=expr/.makeChangeTorsionRule[covd2][covd1];
ChangeTorsion[expr_,list_List,covd2_:PD]:=Fold[ChangeTorsion[#1,#2,covd2]&,expr,list];
ChangeTorsion[expr_,_,_:PD]:=expr;
ChangeTorsion[expr_]:=ChangeTorsion[expr,$CovDs];
SetNumberOfArguments[ChangeTorsion,{1,3}];
Protect[ChangeTorsion];

This function changes the torsion tensor of a derivative to the torsion tensor of another derivative, with a couple of Christoffel tensors in between. If the second derivative is torsionless then only the Christoffel appear. Note that these rules are valid for all kinds of indices and therefore we do not need checks of index types. Recall that HeadOfTensor returns either a tensor symbol or MultiplyTensor[k, symbol] or Zero.

changeTorsion[covd1_,covd2_][a_,b_,c_]:=With[{chr=HeadOfTensor[Christoffel[covd1,covd2][a,b,c],{a,b,c}]},Torsion[covd2][a,b,c]+$TorsionSign(chr[a,b,c]-chr[a,c,b])];
makeChangeTorsionRule[covd2_][covd1_]:=If[TorsionQ[covd1]&&CompatibleCovDsQ[covd1,covd2],Torsion[covd1][inds__]:>changeTorsion[covd1,covd2][inds],{}];

Backwards compatibility:

?TorsionToChristoffel

TorsionToChristoffel=ChangeTorsion;
Protect[TorsionToChristoffel];

11.1.6. ChangeCurvature

?ChangeCurvature

1) User function. Note that we require that the first derivative has curvature (either on the tangent bundle or on the internal vector bundle):

ChangeCurvature[expr_,covd_,covd_]:=expr;
ChangeCurvature[expr_,covd1_Symbol?CurvatureQ,covd2_:PD]:=If[CompatibleCovDsQ[covd1,covd2],expr/.makeChangeCurvatureRules[covd2,metricsof[covd1]][covd1],expr];
ChangeCurvature[expr_,list_List,covd2_:PD]:=Fold[ChangeCurvature[#1,#2,covd2]&,expr,list];
ChangeCurvature[expr_,_,_:PD]:=expr;
ChangeCurvature[expr_]:=ChangeCurvature[expr,$CovDs];
SetNumberOfArguments[ChangeCurvature,{1,3}];
Protect[ChangeCurvature];

Only compatible pairs of derivatives go through makeChangeCurvatureRules.

2) Intermediate function. It detects the metrics of the vbundles of a covd (this is to move the indices up and down, and not to construct Riemanns or Christoffels from the metrics). If there is no metric there we simply use delta. Note that the order of metrics has nothing to do with the order of indices:

(* Return the first-metric, or delta if there is none *)
metricof[vb_]:=FirstMetricOfVBundle[vb,False]/.Null->delta;
(* List of metrics. We assume VBundlesOfCovD return 1, 2 or 3 vbundles *)
metricsof[covd_Symbol]:=metricsof[VBundlesOfCovD[covd]];
metricsof[{tb_}]:={metricof[tb],delta,delta};
metricsof[{tb_,vb_}]:={metricof[tb],metricof[vb],delta};
metricsof[{tb_,vb_,vbdag_}]:={metricof[tb],metricof[vb],metricof[vbdag]};

3) The rules actually involve using Riemann, Ricci, RicciScalar (if covd1 has a metric) and FRiemann. Recall we are changing the curvature tensors of covd1 into those of covd2. We have checked before that covd1 has curvature of some type and hence covd1 here cannot be PD. Change Sept 2011: In makeChangeRicciRule we now use delta instead of MetricOfCovD[covd1] because what we need is to raise and lower indices, even if covd1 is not a first metric. Thanks to Stephen Green and Leo Stein for their help in fixing this.

makeChangeCurvatureRules[covd2_,metrics_][covd1_]:=With[{vbundles=VBundlesOfCovD[covd1]},
Join[
If[CurvatureQ[covd1,First[vbundles]],
Flatten[{
makeChangeRiemannRule[covd2,metrics,Riemann][covd1],
makeChangeRicciRule[covd2,delta][covd1],
makeChangeRicciScalarRule[covd2,MetricOfCovD[covd1]][covd1]}
],{}],
If[Length[vbundles]>1&&CurvatureQ[covd1,Last[vbundles]],Flatten[{makeChangeRiemannRule[covd2,metrics,FRiemann][covd1]}],{}]]]

4a) Change of Riemann or FRiemann. Note that in all these formulas we need Riemann, and not RiemannDown. We separate two cases:
	1) if all indices are abstract and have the right positions then use the formula directly. Note that there is no check of vbundles
	2) in all other cases multiply by metric or delta factors. This includes the cases with basis indices. Note that the metric is that of the vbundle and not necessarily that of the covariant derivative.

(* CovDTODO *)
(* With no need of a metric. riemann can be either Riemann or FRiemann *)
changeRiemann[covd1_,covd2_,{_,_,_},riemann_][-c_Symbol,-d_Symbol,-b_Symbol,a_Symbol]:=With[{chr=HeadOfTensor[Christoffel[covd1,covd2][a,-c,-b],{a,-c,-b}]},Module[{e=DummyAs[a]},
riemann[covd2][-c,-d,-b,a]+$RiemannSign(-covd2[-c][chr[a,-d,-b]]+covd2[-d][chr[a,-c,-b]]-chr[a,-c,-e]chr[e,-d,-b]+chr[a,-d,-e]chr[e,-c,-b]+If[riemann===Riemann,-$TorsionSign Torsion[covd2][e,-c,-d]chr[a,-e,-b],0])]];
(* All other cases *)
changeRiemann[covd1_,covd2_,{tmetric_,vmetric_,vdagmetric_},riemann_][c_,d_,b_,a_]:=With[{vbundle=VBundleOfIndex[a],tbundle=VBundleOfIndex[c],vdmetric=If[HasDaggerCharacterQ[riemann],vdagmetric,vmetric]},Module[{c1=DummyIn[tbundle],d1=DummyIn[tbundle],b1=DummyIn[vbundle],a1=DummyIn[vbundle]},tmetric[c,c1]tmetric[d,d1]vdmetric[b,b1]vdmetric[a,-a1]changeRiemann[covd1,covd2,{delta,delta,delta},riemann][-c1,-d1,-b1,a1]]];
(* Construct rule *)
makeChangeRiemannRule[covd2_,{tmetric_,vmetric_,vdagmetric_},riemann_][covd1_]:=With[{riemann1=riemann[covd1]},HoldPattern[riemann1[c_,d_,b_,a_]]:>changeRiemann[covd1,covd2,{tmetric,vmetric,vdagmetric},riemann][c,d,b,a]];

4b) Change of Ricci, in terms of change of Riemann (always Riemann, never FRiemann and never RiemannDown). We have already checked that covd1 has curvature on the tangent manifold:

changeRicci[covd1_,covd2_,_][-c_Symbol,-b_Symbol]:=Module[{a=DummyAs[c]},$RicciSign changeRiemann[covd1,covd2,{delta,delta,delta},Riemann][-c,-a,-b,a]];
changeRicci[covd1_,covd2_,tmetric_][c_,b_]:=With[{vbundle=VBundleOfIndex[c]},Module[{c1=DummyIn[vbundle],b1=DummyIn[vbundle]},tmetric[c,c1]tmetric[b,b1]changeRicci[covd1,covd2,HELLO][-c1,-b1]]];
makeChangeRicciRule[covd2_,metric_][covd1_]:=With[{ricci=Ricci[covd1]},HoldPattern[ricci[inds__]]:>changeRicci[covd1,covd2,metric][inds]];

4c) Change of RicciScalar, in terms of change of Ricci. Note that the metric to use is the metric of covd1 and not necessarily the (first-) metric of the manifold. If covd1 does not have an associated metric then metricofcovd1 is Null and we simply return {}.

changeRicciScalar[covd1_,covd2_,metricofcovd1_][]:=Module[{a=DummyIn[TangentBundleOfCovD[covd1]],b=DummyIn[TangentBundleOfCovD[covd1]]},Scalar[Inv[metricofcovd1][a,b]changeRicci[covd1,covd2,HELLO][-a,-b]]];
makeChangeRicciScalarRule[covd2_,Null][covd1_]:={};
makeChangeRicciScalarRule[covd2_,metricofcovd1_][covd1_]:=With[{ricciscalar=RicciScalar[covd1]},HoldPattern[ricciscalar[]]:>changeRicciScalar[covd1,covd2,metricofcovd1][]];

Note that there are no rules for Einstein, TFRicci or Weyl.

5) Backwards compatibility:

?RiemannToChristoffel

RiemannToChristoffel=ChangeCurvature;
Protect[RiemannToChristoffel];

11.1.7. CommuteCovDs

With this function we commute two instances of the same covariant derivative. Note that we introduce both Riemann tensors and Torsion tensors as required. The use of the indices a, b is a bit confusing: they must appear in CommuteCovDs as they would appear in the original expression in "Postfix" notation. By the way, indices a, b are clearly always indices of a tangent bundle, though they can be indices of types A, B, C or D, and they can have any character.

(* CovDTODO *)
CommuteCovDs[expr_,covd_,{a_,b_}]:=expr/.HoldPattern[covd[b][covd[a][expr1_]]]:>makeCommuteCovDs[expr1,covd,{a,b}];

All nontrivial commutations of derivatives in xTensor are controlled by this function. Here, only CommuteCovDs (which is public) is used outside this subsection. We assume that all required checks on the indices have already been performed. Note that only free *abstract* indices add curvature tensors.

(* CovDTODO *)
SetAttributes[makeCommuteCovDs,HoldFirst];
makeCommuteCovDs[expr_,covd_,{a_,b_}]:=covd[a][covd[b][expr]]+addCurvature[expr,covd,{a,b},Select[FindFreeIndices[expr],AIndexQ],VBundlesOfCovD[covd]]+addTorsion[expr,covd,{a,b}]+addOther[expr,covd,{a,b}];

This should go before protection of Riemann,  Curvature and Torsion. We can interpret that vbundle is the vector bundle of the upper index in the torsion and curvature tensors. The antisymmetric pair of indices always belongs to the tangent bundle of the manifold of the covd.

SetAttributes[{addCurvature,addCurvature1,addTorsion,addOther,addOther1},HoldFirst];

1) Add Curvature. Use Riemann or FRiemann, but never RiemannDown.

addCurvature[args__,{}]:=0;
addCurvature[args__,{tb_}]:=addCurvature1[args,tb,Riemann];
addCurvature[args__,{tb_,vb_}]:=addCurvature1[args,tb,Riemann]+addCurvature1[args,vb,FRiemann];
addCurvature[args__,{tb_,vb_,vbdag_}]:=addCurvature1[args,tb,Riemann]+addCurvature1[args,vb,FRiemann]+addCurvature1[args,vbdag,FRiemann];
addCurvature1[expr_,covd_,{a_,b_},frees_,vb_,riemann_]:=$RiemannSign With[{dummy=DummyIn[vb],vbQ=VBundleIndexQ[vb],curv=If[HasDaggerCharacterQ[vb],Dagger,Identity][riemann[covd]]},
Plus@@Map[(curv[a,b,-dummy,#]ReplaceIndex[expr,#->dummy])&,Select[frees,vbQ]]-Plus@@Map[(curv[a,b,-#,dummy]ReplaceIndex[expr,-#->-dummy])&,Select[ChangeIndex/@frees,vbQ]]];

We are assuming that Riemann and FRiemann use the same convention for $RiemannSign.

2) Add Torsion:

addTorsion[expr_,covd_,{a_,b_}]:=$TorsionSign With[{dummy=DummyIn[VBundleOfIndex[a]]},Torsion[covd][dummy,a,b]covd[-dummy][expr]];

Addition of curvature and torsion is perfectly compatible with the induced derivatives because we always handle "spatial" objects.

3) This part is in charge of adding terms corresponding to b,c,d indices and metric-raised indices:

addOther[expr_,covd_,{a_,b_}]:=With[{proj=If[InducedCovDQ[covd],MetricOfCovD[covd],delta]},addOther1[expr,{covd,proj},{a,b}]-addOther1[expr,{covd,proj},{b,a}]];
addOther1[expr_,{covd_,proj_},{-_Symbol,_}]:=0;
(* CovDTODO *)
addOther1[expr_,{covd_,proj_},{a_,b_}]:=With[{vb=TangentBundleOfCovD[covd]},Module[{dummy=DummyIn[vb]},covd[b][proj[a,dummy]]covd[-dummy][expr]]];

4) QUESTION: Do we have to worry about densities here?

11.1.8. Implode and Explode

We introduce the new concept of "implosion": given the covariant derivative of a tensor we define a new tensor which represents that covariant derivative with the indices of the tensor having their original characters. The character of the added indices is always taken to be covariant. The opposite process will be called "explosion".

$MultiIndexCovDs={};
$ImplodeInfoQ=False;

In order to reactivate the Info messages from Implode use $ImplodeInfoQ=True.

First we worry about the names for the new tensors. The structure of the tensor is stored in its TensorID field.

Covariant derivatives. Note that we assume that the indices are abstract indices and hence they do not add new nontrivial dependencies. Before 1.1.0 we were using DependenciesOf[cd[inds]], which produces a list containing AnyDependencies. Now we use only DependenciesOfCovD[cd], which is better behaved.

niceindices[list_List]:=Replace[list,screenrules[UpIndex/@IndexList@@list],1];

ImplodedName[PD[inds__],manifold_,tensor_?xTensorQ]:=If[Length@ManifoldsOfTensor[tensor]===1,SymbolJoin[PD,tensor],SymbolJoin[PD,manifold,tensor]];
ImplodedName[cd_Symbol?CovDQ[__],manifold_,tensor_?xTensorQ]:=SymbolJoin[cd,tensor];

CovDTensor[cd_Symbol[inds__],manifold_,tensor_Symbol[tinds___],ltinds_Integer]:=CovDTensor1[cd[inds],manifold,tensor[tinds],niceindices@Join[DummyAs/@{tinds},DownIndex/@DummyAs/@{inds}],Union[DependenciesOfTensor[tensor],DependenciesOfCovD[cd]]];
CovDTensor1[cd_Symbol[inds__],manifold_,tensor_Symbol[tinds___],{indices___},dependencies_List]:=With[{cdtensor=ImplodedName[cd[inds],manifold,tensor],linds=Length[{inds}],vector=If[InducedCovDQ[cd],Last@InducedFrom@MetricOfCovD[cd],Null]},
If[!xTensorQ[cdtensor],
DefTensor[cdtensor[indices],dependencies,CovDTensorSym[cd[inds],Length[{inds}],tensor[tinds],Length[{tinds}]],PrintAs:>StringJoin[Last[SymbolOfCovD[cd]],PrintAs[tensor]],Dagger:>If[DaggerQ[tensor],Complex,Real],TensorID:>{CovD,cd,linds,tensor},DefInfo:>If[$ImplodeInfoQ,{"tensor",""},False],Master->tensor,ForceSymmetries:>SameQ[cd,PD]];
If[DaggerQ[tensor],With[{dag=Dagger[cdtensor]},TensorID[dag]^={CovD,cd,linds,Dagger[tensor]}]];
If[cd=!=PD &&!MemberQ[FixedPointList[MasterOf,cdtensor],cd],
xUpAppendTo[VisitorsOf[cd],cdtensor];
xUpAppendTo[HostsOf[cdtensor],cd];
];
];
If[vector=!=Null&&OrthogonalToVector[vector][tensor],xUpSet[OrthogonalToVector[vector][cdtensor],True]];
(* Remember associated tensor *)
(* CovDTensor[cd[__],manifold,tensor[___],Length[{tinds}]]=cdtensor; *)
cdtensor];

QUESTION: Do we need to store the manifold of the covd in the TensorID information?

Here we construct the symmetry of the new tensor. This is valid even for variable-rank tensors, because the function CovDTensor has a third argument storing the number of indices of the internal tensor. The difficult part in CovDTensorSym is introducing the additional symmetries coming from commutation of derivatives. We introduce those additional symmetries only if the derivative is torsionless, and has no curvature or we are dealing with a double derivative of a scalar. We do not worry about metrics here because this is treated somewhere else further down.

CovDTensorSym[cd_[inds__],linds_,tensor_[tinds___],ltinds_]:=Module[{SGS=JoinSGS[SymmetryGroupOfTensor[tensor[tinds]],DisplaceSlots[SymmetryGroupOfCovD[cd[inds]],ltinds]]},
If[MatchQ[TensorID[tensor],{CovD,cd,linds,__}]&& Not@TorsionQ[cd]&&(Not@CurvatureQ[cd]||Length[DeleteCases[{tinds},_LI|-_LI]]===1),
SGS=JoinSGSoverlap[SGS,StrongGenSet[{ltinds-linds+1},GenSet[Inner[List,ltinds+Range[-linds+1,0],ltinds+Range[1,linds],xAct`xPerm`Cycles]]]]
];
SGS];

QUESTION: How can we handle imaginay and Hermitian tensors?

Parametric derivatives:

ParamDTensor[ParamD[ps__],tensor_Symbol]:=ParamDTensor[ParamD[ps],tensor,niceindices[DummyIn/@SlotsOfTensor[tensor]],DependenciesOfTensor[tensor]];
ParamDTensor[ParamD[ps__],tensor_Symbol,{indices___},dependencies_List]:=With[{pdtensor=SymbolJoin["ParamD",ps,tensor]},
If[!xTensorQ[pdtensor],
DefTensor[pdtensor[indices],dependencies,SymmetryGroupOfTensor[tensor],PrintAs:>StringJoin["ParamD",PrintAs[ps],PrintAs[tensor]],Dagger:>If[DaggerQ[tensor],Complex,Real],TensorID:>{ParamD,ps,tensor},DefInfo:>If[$ImplodeInfoQ,{"tensor",""}]]
];
ParamDTensor[ParamD[ps],tensor]=pdtensor;
pdtensor];

OverDotTensor[OverDot,tensor_Symbol]:=OverDotTensor[OverDot,tensor,niceindices[DummyIn/@SlotsOfTensor[tensor]],DependenciesOfTensor[tensor]];
OverDotTensor[OverDot,tensor_Symbol,{indices___},dependencies_List]:=With[{pdtensor=SymbolJoin["OverDot",tensor]},
If[!xTensorQ[pdtensor],
DefTensor[pdtensor[indices],dependencies,SymmetryGroupOfTensor[tensor],PrintAs:>StringJoin["OverDot",PrintAs[tensor]],Dagger:>If[DaggerQ[tensor],Complex,Real],TensorID:>{OverDot,tensor},DefInfo:>If[$ImplodeInfoQ,{"tensor",""}]]
];
OverDotTensor[OverDot,tensor]=pdtensor;
pdtensor];

Lie derivatives:

LieDTensor[LieD[v_Symbol[a_]],tensor_Symbol]:=LieDTensor[LieD[v[a]],tensor,niceindices[DummyIn/@SlotsOfTensor[tensor]],Union[DependenciesOfTensor[tensor],DependenciesOfTensor[v]]];
LieDTensor[LieD[v_],tensor_]:=Throw@Message[Implode::invalid,v,"contravariant vector field"];
LieDTensor[LieD[v_Symbol[_]],tensor_Symbol,{indices___},dependencies_List]:=With[{lietensor=SymbolJoin["LieD",v,tensor]},
If[!xTensorQ[lietensor],
DefTensor[lietensor[indices],dependencies,SymmetryGroupOfTensor[tensor],PrintAs:>StringJoin["ℒ",PrintAs[v],PrintAs[tensor]],Dagger:>If[DaggerQ[tensor],Complex,Real],TensorID:>{LieD,v,tensor},DefInfo:>If[$ImplodeInfoQ,{"tensor",""}]]
];
LieDTensor[LieD[v],tensor]=lietensor;
lietensor];

Fake xCoba functions if xCoba is not loaded:

If[!MemberQ[$Packages,"xAct`xCoba`"],
xAct`xCoba`SeparateBasis[][expr_]:=expr;
xAct`xCoba`ContractBasis[expr_]:=expr;
];

Implosion:

Implode[expr_]:=Implode[expr,{$CovDs,$MultiIndexCovDs,ParamD,OverDot,LieD}];
Implode[expr_,list_List]:=Fold[Implode,expr,list];
(* CovDTODO *)
Implode[expr_,covd_Symbol?CovDQ]:=expr//.(covd[inds__][tensor_?xTensorQ[indices___]]:>xAct`xCoba`ContractBasis@ContractMetric[covd[inds][SeparateMetric[][xAct`xCoba`SeparateBasis[][tensor[indices]]]]/.covd[inds1__][tensor1_?xTensorQ[indices1___]]:>CovDTensor[covd[inds1],ManifoldOfCovD[covd[inds1]],tensor1[indices1],Length[{indices1}]][indices1,inds1]]);
Implode[expr_,ParamD]:=expr//.(ParamD[ps__][tensor_?xTensorQ[inds___]]:>xAct`xCoba`ContractBasis@ContractMetric[ParamD[ps][SeparateMetric[][xAct`xCoba`SeparateBasis[][tensor[inds]]]]/.ParamD[ps1__][tensor1_?xTensorQ[inds1___]]:>ParamDTensor[ParamD[ps1],tensor1][inds1]]);
Implode[expr_,OverDot]:=expr//.(OverDot[tensor_?xTensorQ[inds___]]:>xAct`xCoba`ContractBasis@ContractMetric[OverDot[SeparateMetric[][xAct`xCoba`SeparateBasis[][tensor[inds]]]]/.OverDot[tensor1_?xTensorQ[inds1___]]:>OverDotTensor[OverDot,tensor1][inds1]]);
Implode[expr_,LieD]:=expr//.(LieD[v_][tensor_?xTensorQ[inds___]]:>xAct`xCoba`ContractBasis@ContractMetric[LieD[v][SeparateMetric[][xAct`xCoba`SeparateBasis[][tensor[inds]]]]/.LieD[v][tensor1_?xTensorQ[inds1___]]:>LieDTensor[LieD[v],tensor1][inds1]]);
SetNumberOfArguments[Implode,{1,2}];
Protect[Implode];

Explosion:

ImplodedQ[{}]:=False;
ImplodedQ[delta]:=False;
ImplodedQ[tensor_?xTensorQ[___]]:=ImplodedQ[tensor];
ImplodedQ[tensor_?xTensorQ]:=ImplodedQ[tensor]=ImplodedQ[TensorID[tensor]];
ImplodedQ[{CovD,__}]:=True;
ImplodedQ[{ParamD,__}]:=True;
ImplodedQ[{OverDot,__}]:=True;
ImplodedQ[{LieD,__}]:=True;
ImplodedQ[_]:=False;
Explode[expr_]:=Explode[expr,Select[Head/@FindAllOfType[expr,Tensor],ImplodedQ]];
Explode[expr_,list_List]:=Fold[Explode,expr,list];
Explode[expr_,tensor_?xTensorQ]:=expr/.tensor[inds___]:>ExplodeTensor[tensor[inds]];
SetNumberOfArguments[Explode,{1,2}];
Protect[Explode];

ExplodeTensor[tensor_Symbol[inds___]]:=ExplodeTensor[tensor[inds],TensorID[tensor]];
ExplodeTensor[tensor_Symbol[inds___],{CovD,covd_,linds_Integer,intensor_}]:=SeparateMetric[][xAct`xCoba`SeparateBasis[][tensor[inds]]]/.tensor[inds1___]:>(covd@@Take[{inds1},-linds])[intensor@@Drop[{inds1},-linds]];
ExplodeTensor[tensor_Symbol[inds___],{ParamD,ps__,intensor_}]:=SeparateMetric[][xAct`xCoba`SeparateBasis[][tensor[inds]]]/.tensor[inds1___]:>ParamD[ps][intensor[inds1]];
ExplodeTensor[tensor_Symbol[inds___],{OverDot,intensor_}]:=SeparateMetric[][xAct`xCoba`SeparateBasis[][tensor[inds]]]/.tensor[inds1___]:>OverDot[intensor[inds1]];
ExplodeTensor[tensor_Symbol[inds___],{LieD,v_,intensor_}]:=SeparateMetric[][xAct`xCoba`SeparateBasis[][tensor[inds]]]/.tensor[inds1___]:>LieD[v[UpIndex@DummyIn[First@SlotsOfTensor[v]]]][intensor[inds1]];
ExplodeTensor[tensor_Symbol[inds___],_]:=tensor[inds];

11.2. Definition

11.2.0. Comments

We define covariant derivative operators (connections), as defined by Wald, but generalized to work on generic vector bundles, and not only tangent vector bundles.

- We do not check that indices and derivatives are in correspondence. We assume that this has been already done by the validation routines.
- At definition time, if the derivative is to be associated to a metric, we check whether that metric exists or not. This is not intended to be a feature to be used by the user to define derivatives associated to previously defined metrics. The derivative associated to a metric will be defined below when the metric is defined.

11.2.1. Generic properties of a derivative

Comments:
  - The argument of a covariant derivative is always assumed to be fully evaluated or at least fully evaluatable. QUESTION: Can we use Hold/HoldForm?
  - The covariant derivatives are always threaded over Plus, even if all arguments are incorrect.
  - Linearity with respect to constants (constant-symbols or numeric objects) is implemented as a two step process: first we use the Leibnitz rule; then we find that the covariant derivative of a constant is 0.
  - Note that even though Power is a scalar function, it has its own rule because the rule for scalar functions only considers those functions with a single argument and Power has two.
  - There are quite a few checks (NumericQ, ConstantSymbolQ, check, xTensorQ, ScalarFunctionQ), what certainly introduces delays... QUESTION: Can we improve this?
  - Currently, this function only works for tensors. Eventually, it needs to be generalized to other types.

1) multiD implements the chain rule for a function of several arguments. We use ReplaceDummies to avoid repeating a dummy in a term. In principle the dummy inside an argument of the function is shielded from the dummy of the differentiated argument. However it could happen that there are definitions which bring the term into an inconsistent state.

multiD[der_,f_[args__]]:=(Derivative[Sequence@@#][f][args]&/@IdentityMatrix[Length[{args}]]).(der/@ReplaceDummies/@{args})

multiD[der,f[a,b,c]]

Derivative[0,1][Derivative[1,1][f]]

multiD[der,Derivative[0,1,1][f][a,b,c]]

2) If there are several manifolds we could have derivatives which are zero simply because the derivative and the derived object belong to different manifolds. The function CheckZeroDerivative controls that point. It is important to stress that this is a question of dependencies and not of indices. This is the user-driver:

?CheckZeroDerivative

(* CovDTODO *)
CheckZeroDerivative[expr_]:=expr/.HoldPattern[covd_?CovDQ[i__][expr1_]]:>0/;ZeroDerivativeQ[covd[i],expr1];
SetNumberOfArguments[CheckZeroDerivative,1];
Protect[CheckZeroDerivative];

In the past there was a check function in the pattern i_. It was ?GIndexQ for PD and the corresponding pmQ function for other derivatives. I don't remember why it was there, and therefore I have removed it. I guess it was just a safety feature. The index inside the derivative is not relevant, as long as it is valid.

The function ZeroDerivativeQ actually decides whether a given covariant derivative of an object is zero or not. This is not simple because it depends very much on the allowed structures of submanifolds and supermanifolds. This is a slow function and must be used many times if the zero checking is automated. Hence, we define it with remembered values when applied on tensors, which is the most common situation. The nontrivial part of this function is hidden in ManifoldsOf. In principle, the test should be performed in the uncontracted version of expr (with respect to both basis-indices and directions). Note that we also pass the index a to ManifoldOfCovD to include the case of covd being PD. For the same reason, we need to store the result with a pm`Q check. Note also that we use ManifoldOfCovD and not all manifolds in DependenciesOfCovD, which wouldn't make sense.

(* Avoid checking slotted indices *)
ZeroDerivativeQ[covd_[__slot],_]:=False;
(* Tensors *)
ZeroDerivativeQ[covd_[a__],tensor_?xTensorQ[inds___?AIndexQ]]:=ZeroDerivativeQ[covd[a],tensor];
ZeroDerivativeQ[covd_[a__],tensor_?xTensorQ]:=With[{vbQ=VBundleIndexPMQ[VBundleOfIndex[First[{a}]]]},
Module[{prot=Unprotect[tensor],result},TagSet[tensor,ZeroDerivativeQ[covd[PatternTest[__,vbQ]],tensor],result=DisjointManifoldsQ[ManifoldsOfTensor[tensor],{ManifoldOfCovD[covd[a]],AnyDependencies}]];
Protect[Evaluate[prot]];
result
]
];
(* Other expressions *)
ZeroDerivativeQ[covd_[a__],expr_]:=DisjointManifoldsQ[ManifoldsOf[expr],{ManifoldOfCovD[covd[a]],AnyDependencies}];

It can be automated:

?CheckZeroDerivativeStart

?CheckZeroDerivativeStop

Note the ?AIndexQ check in the tensor definition. This avoids the possibility of missing dependencies provided by non-abstract indices.

(* CovDTODO *)
$CheckZeroDerivativeVerbose=False;
CheckZeroDerivativeStart[covd_]:=Module[{prot=Unprotect[covd]},(*If[Length[$Manifolds]<2,Throw[Message[CheckZeroDerivativeStart::error,"With less than two manifolds there is no need for CheckZeroDerivative."]]];*)
covd[a__?GIndexQ][tensor_?xTensorQ[___?AIndexQ]]:=Condition[0,If[$CheckZeroDerivativeVerbose,Print["Checking ",covd," on ",tensor]];ZeroDerivativeQ[covd[a],tensor]];
covd[a__?GIndexQ][expr_]:=Condition[0,If[$CheckZeroDerivativeVerbose,Print["Checking ",covd[a]," on ",expr]];ZeroDerivativeQ[covd[a],expr]];
Protect[Evaluate[prot]];];
CheckZeroDerivativeStop[covd_]:=Module[{prot=Unprotect[covd]},
covd[a__?GIndexQ][tensor_?xTensorQ[___?AIndexQ]]=.;
covd[a__?GIndexQ][expr_]=.;
Protect[Evaluate[prot]];];
SetNumberOfArguments[CheckZeroDerivativeStart,1];
SetNumberOfArguments[CheckZeroDerivativeStop,1];
Protect[CheckZeroDerivativeStart,CheckZeroDerivativeStop];

The fact that the check is not automatic has several advantages, but mainly two: first a gain in speed; secondly, the user can control and check which derivatives must be annihilated.

We shall define later ZeroDerOnMetricQ, which is rather redundant with ZeroDerivativeQ.

3) Now we define two functions implementing the general properties of the two arguments of a connection:

SetAttributes[{MakeLinearDerivative,MakeTensorialDerivative},HoldFirst]

MakeLinearDerivative implements some properties of the connection on its expression-argument

Right now, every time xTensor finds a covariant derivative, it performs two checks, in this order:
	1. Is the argument a constant? Use ConstantQ.
	2. Is the argument a scalar function? Use ScalarFunctionQ
(If we have automated CheckZeroDerivative then we have a third check). This takes some time, but I think it is unavoidable: this is an essential part of automatic simplification. The Leibnitz rule is optional because induced derivatives do not obey it. We remove the Scalar head because in general the result is not a scalar. (Note however that this conversion leads to infinite recursion with induced derivatives of scalars of the form Scalar[n[-a]V[a]] where n is the orthogonal vector and V is not orthogonal to n. FIXME)

MakeLinearDerivative[{covdL_,covdR_},leibnitz_]:=(
covdL[expr_Plus]:=Map[covdR,expr];
covdL[expr_SeriesData]:=SeriesDataMap[covdR,expr];
If[leibnitz,covdL[x_ y_]:=covdR[x]y+x covdR[y]];
covdL[_?ConstantQ]:=0;
covdL[f_?ScalarFunctionQ[args___]]:=multiD[covdR,f[args]];
covdL[Scalar[expr_]]:=covdR[ReplaceDummies[expr]];
covdL[list_List]:=Map[covdR,list];
);
MakeLinearDerivative[covd_Symbol,leibnitz_]:=MakeLinearDerivative[{covd[a_],covd[a]},leibnitz];

Properties of the new derivative head:

(* Special properties *)
Unprotect[CovD];
CovD[expr_]:=expr;
CovD[CovD[expr_,ders1__],ders2__]:=CovD[expr,ders1,ders2];
CovD[expr_,l___,a_Symbol,r___]:=CovD[expr,l,PD[a],r];
CovD[expr_,l___,-a_Symbol,r___]:=CovD[expr,l,PD[-a],r];
(* Derivative properties *)
CovD[expr_Plus,ders__]:=CovD[#,ders]&/@expr;
CovD[expr_SeriesData,ders___]:=SeriesDataMap[CovD[#,ders]&,expr];
CovD[x_ y_,der_,ders___]:=CovD[CovD[x,der]y+x CovD[y,der],ders];
CovD[_?ConstantQ,___]:=0;
CovD[f_?ScalarFunction[args___],der_,ders___]:=CovD[multiD[CovD[#,der]&,f[args]],ders];
CovD[Scalar[expr_],ders__]:=CovD[ReplaceDummies[expr],ders];
CovD[list_List,ders__]:=Map[CovD[#,list]&,list];
CovD[expr_,covd_?CovDQ[Dir[v_+w_]],ders___]:=CovD[expr,covd[Dir[v]],ders]+CovD[expr,covd[Dir[w]],ders];
CovD[expr_,covd_?CovDQ[Dir[(x_?ScalarQ)v_]],ders___]:=CovD[x CovD[expr,covd[Dir[v]]],ders];
CovD[expr_,covd_?CovDQ[Dir[0]],ders___]:=0;
Protect[CovD];

Old code:

MakeLinearDerivative[covd_,leibnitz_]:=(
covd[a_][x_+y_]:=covd[a][x]+covd[a][y];
If[leibnitz,covd[a_][x_ y_]:=covd[a][x]y+x covd[a][y]];
covd[a_][_?ConstantQ]:=0;
covd[a_][f_?ScalarFunctionQ[args___]]:=multiD[covd[a],f[args]];
covd[a_][Derivative[ders__Integer][f_?ScalarFunctionQ][args___]]:=multiD[covd[a],Derivative[ders][f][args]];
covd[a_][list_List]:=Map[covd[a],list];
);

MakeTensorialDerivative implements the properties of the connection on its index-argument, in case we find there a direction.

MakeTensorialDerivative[{covdL_,covdR_}]:=(
covdR[Dir[v_Plus]][expr_]:=Map[covdL[Dir[#]][expr]&,v];
covdR[Dir[v_SeriesData]][expr_]:=SeriesDataMap[covdL[Dir[#]][expr]&,v];
covdR[Dir[(x_?ScalarQ)v_]][expr_]:=x covdL[Dir[v]][expr];
covdR[Dir[0]][expr_]:=0;
);
MakeTensorialDerivative[covd_]:=MakeTensorialDerivative[{covd,covd}];

4) Concerning the orthogonality properties of a projected derivative, we shall use the same option OrthogonalTo for DefTensor. There are two issues: first, the tensors associated with the derivative will be just defined orthogonal to the vector; second, the derivative itself must be orthogonal, but not only in the derivative index, but in all indices of the expression being differentiated. Note that we implement the rule for both a covariant and a contravariant index in the derivative. The point is that the offending rule will be defined but not used if there are no derivatives with a contravariant index in the calculations.

(* CovDTODO *)
MakeOrthogonalDerivative[covd_,projector_[_,_],vector_[_]]:=(
TagSet[covd,vector[i_Symbol]covd[-i_Symbol][expr_],0];
TagSet[covd,vector[-i_Symbol]covd[i_Symbol][expr_],0];
TagSetDelayed[covd,vector[i_?AIndexQ]covd[_][expr_],Condition[0,IsIndexOf[expr,-i,projector]]];
)

The three objects is this and the previous definitions are assumed to form a consistent set. That is covd must be the Levi-Civita connection of the projector, which must itself be orthogonal with respect to the vector:

(* CovDTODO *)
MakeProjectedDerivative[covd_,projector_[_,_],vector_[_]]:=(
TagSetDelayed[covd,projector[i_Symbol,-j_Symbol]covd[k_][expr_],Condition[ReplaceIndex[covd[k][expr],-i->-j],IsIndexOf[covd[k][expr],-i,projector]&&OrthogonalToVectorQ[vector][expr]]];
TagSetDelayed[covd,projector[i_Symbol,-j_Symbol]covd[k_][expr_],Condition[ReplaceIndex[covd[k][expr],j->i],IsIndexOf[covd[k][expr],j,projector]&&OrthogonalToVectorQ[vector][expr]]];
TagSetDelayed[covd,projector[-i_Symbol,j_Symbol]covd[k_][expr_],Condition[ReplaceIndex[covd[k][expr],-j->-i],IsIndexOf[covd[k][expr],-j,projector]&&OrthogonalToVectorQ[vector][expr]]];
TagSetDelayed[covd,projector[-i_Symbol,j_Symbol]covd[k_][expr_],Condition[ReplaceIndex[covd[k][expr],i->j],IsIndexOf[covd[k][expr],i,projector]&&OrthogonalToVectorQ[vector][expr]]];
)

11.2.2. Origin in the affine space of connections: the fiducial PD

Note that by default only covariant partial derivatives commute. However if the metric is flat and PD is its associated covariant derivative, then all kinds of partial derivatives commute. That is defined below, with the metric definition.

Currently we assume that PD is never a projected derivative.

We define PD separately because it has very special properties:

(* Register *)
AppendToUnevaluated[$CovDs,PD];
CovDQ[PD]^=True;
SymbolOfCovD[PD]^={",","∂"};
CurvatureQ[PD]^=False;
CurvatureQ[PD,vbundle_]^=False;
TorsionQ[PD]^=False;
DependenciesOfCovD[PD]^:={};
WeightedWithBasis[PD]^:=AIndex;
ManifoldOfCovD[PD[a_]]^:=BaseOfVBundle@VBundleOfIndex[a];
ManifoldOfCovD[PD]^:=(Print["ManifoldOfCovD[PD] has been used."];{});
VBundlesOfCovD[PD[a_]]^:={VBundleOfIndex[a]};
VBundlesOfCovD[PD]^:=(Print["VBundlesOfCovD[PD] has been used."];{});
MetricOfCovD[PD]^=Null;
MasterOf[PD]^=Symbol;

(* Define derivative *)
MakeLinearDerivative[PD,True];
MakeTensorialDerivative[PD];

(* CovDTODO *)
(* Commutativity *)
SortCovDs[expr_,PD]:=expr//.$SortPDsRules;

(* No associated curvature or torsion tensors *)
RiemannToWeylRules[PD]={};
WeylToRiemannRules[PD]={};
RicciToTFRicciRules[PD]={};
TFRicciToRicciRules[PD]={};
RicciToEinsteinRules[PD]={};
EinsteinToRicciRules[PD]={};
RiemannToRiemannDownRules[PD]={};
RiemannDownToRiemannRules[PD]={};

(* All associated tensors are Zero *)
TagSet[PD,GiveSymbol[Riemann|RiemannDown|Ricci|TFRicci|RicciScalar|Einstein|Weyl|Kretschmann|Torsion|FRiemann,PD],Zero];

(* We do not add definitions for numbers of arguments other than one *)
Protect[PD];

QUESTION: I don't like the SortCovDs command. The problem is that IndexSorting is a nonlocal operation, and DisorderedPairQ[a,b] could be missing important information needed to sort the derivatives. On the other hand commutativity is currently only defined for covariant abstract indices (not including patterns or basis-indices); how do we deal with those other cases? In principle we have to resort to CommuteCovDs, which is more general.

Motivated by an email from Manuel Hohmann (April 2019). These are the rules for sorting PD derivatives. If needed (for example with flat first metrics) we will add more rules to this list:

$SortPDsRules={PD[-b_Symbol][PD[-a_Symbol][expr1_]]:>PD[-a][PD[-b][expr1]]/;DisorderedPairQ[-a,-b]};

11.2.3. DefCovD

This command is very long so that we break it into several steps, which are analyzed in the following subsubsections.

1) Check the input and the the options. The analysis of the Curvature options is separated for clarity of reading. Possibilities: True, False, Riemann, FRiemann, a vbundle or a list of vbundles. This function does some checking and then returns the list of vbundles on which the covd has nonzero curvature:

checkcovdcurvature[True,vbundles_List]:=vbundles;
checkcovdcurvature[False,vbundles_List]:={};
checkcovdcurvature[Riemann,{tb_,___}]:={tb};
checkcovdcurvature[FRiemann,{tb_,vb__}]:={vb};
checkcovdcurvature[FRiemann,{tb_}]:=Throw@Message[DefCovD::error,"Cannot define inner vbundle curvature only having the tangent bundle."];
checkcovdcurvature[vb_?VBundleQ,vbundles_List]:=If[MemberQ[vbundles,vb],{vb},Throw@Message[DefCovD::error,"Cannot define curvature on vbundle "<>ToString[vb]<>"."]];
checkcovdcurvature[list_List,vbundles_List]:=DeleteDuplicates@Flatten[checkcovdcurvature[#,vbundles]&/@list];
checkcovdcurvature[x_,vbundles_List]:=Throw@Message[DefCovD::unknown,"value of Curvature option",x];

Some of the checks are not necessary when the derivative is an extension of a previously defined external derivative. We need an If construction to control that issue. TODO.

DefCovDCheck[covd_,manifold_,vbundles_,symbol_,{torsion_,curvature_,metric_,curvrels_,ef_,odeps_,wwb_}]:=(
(* CovD *)
If[covd===PD,Throw@Message[DefCovD::error,"CovD PD denotes the fiducial ordinary derivative."]];
ValidateSymbol[covd];
ValidateSymbolInSession[covd];
(* Vector bundles *)
If[!VBundleQ[#],Throw@Message[DefCovD::invalid,#,"vbundle"]]&/@Flatten[{vbundles}];
If[Tangent[manifold]=!=First@vbundles,Throw@Message[DefCovD::error,"Index of non-tangent vbundle."]];
(* Symbol of derivative *)
If[Head[symbol]=!=List||Length@symbol=!=2,Throw@Message[DefCovD::invalid,symbol,"pair of strings for derivative output"]];
If[Head[First@symbol]=!=String ||Length@Characters@ToString@First@symbol=!=1,Throw@Message[DefCovD::invalid,First@symbol,"Postfix symbol for a derivative"]];
If[Head[Last@symbol]=!=String ,Throw@Message[DefCovD::invalid,Last@symbol,"Prefix symbol for a derivative"]];
(* Additional dependencies *)
If[!Or[ManifoldQ[#],ParameterQ[#]],Throw@Message[DefCovD::unknown,"dependency",#]]&/@odeps;
(* Metric *)
If[metric=!=Null&&!MetricQ[metric],Throw@Message[DefCovD::unknown,"metric",metric]];
(* Weight extension *)
If[wwb=!=Null,
If[!BasisQ[wwb],Throw@Message[DefCovD::unknown,"basis",wwb]];
If[metric===Null,Throw@Message[DefCovD::error,"Only Levi-Civita connections can be weight-extended."]]];
(* Torsion *)
If[!TrueOrFalse[torsion],Throw[Message[DefCovD::invalid,torsion,"value for option Torsion"]]];
(* If[torsion &&metric=!=Null&&!FirstMetricQ[metric],Throw@Message[DefCovD::error,"Connections with torsion can only be associated to a first-metric."]];*)
(* CurvatureRelations *)
If[!TrueOrFalse[curvrels],Throw[Message[DefCovD::invalid,curvrels,"value for option CurvatureRelations"]]];
(* Extended derivative *)
If[ef=!=Null&&!CovDQ[ef],Throw[Message[DefCovD::invalid,ef," covariant derivative to extend"]]];
(* Curvature. Return bundles with curvature *)
checkcovdcurvature[curvature,vbundles]
)

2) Special rules for special tensors for the tensors formatting. In most cases we just take the first character of the name:

Set[CovDTensorQ[#],True]&/@{Torsion,Christoffel,AChristoffel,Riemann,FRiemann,Ricci,RicciScalar,RiemannDown,Einstein,TFRicci,Weyl,Kretschmann};
CovDTensorQ[_]=False;

PrintAsCharacter[Torsion]="T";
PrintAsCharacter[Christoffel]="Γ";
PrintAsCharacter[AChristoffel]="A";
PrintAsCharacter[Riemann]="R";
PrintAsCharacter[FRiemann]="F";
PrintAsCharacter[Ricci]="R";
PrintAsCharacter[RicciScalar]="R";
PrintAsCharacter[RiemannDown]="ℛ";
PrintAsCharacter[Einstein]="G";
PrintAsCharacter[TFRicci]="S";
PrintAsCharacter[Weyl]="W";
PrintAsCharacter[Kretschmann]="K";

(* Special formatting of tensors associated to connections *)
GiveOutputString[tensor_Symbol?CovDTensorQ,covd_]:=StringJoin[PrintAsCharacter[tensor],"[",SymbolOfCovD[covd][[2]],"]"];
GiveOutputString[tensor_Symbol?CovDTensorQ,covd1_,covd2_]:=StringJoin[PrintAsCharacter[tensor],"[",SymbolOfCovD[covd1][[2]],",",SymbolOfCovD[covd2][[2]],"]"];

3) Backwards compatibility:

DefCovD[covd_[ind_],symbol:{_String,_String},options___]:=DefCovD[covd[ind],VBundleOfIndex[ind],SymbolOfCovD->symbol,options];
DefCovD[covd_[ind_],vbundles_,symbol:{_String,_String},options___]:=DefCovD[covd[ind],vbundles,SymbolOfCovD->symbol,options];
DefCovD[covd_[ind_],options___?OptionQ]:=DefCovD[covd[ind],VBundleOfIndex[ind],options];

4) This is the main command.

Options[DefCovD]={
SymbolOfCovD->{";","▽"},
Torsion->False,
Curvature->True,
FromMetric->Null,
CurvatureRelations->True,
ExtendedFrom->Null,
OtherDependencies->{},
OrthogonalTo->{},
ProjectedWith->{},
WeightedWithBasis->Null,
ProtectNewSymbol:>$ProtectNewSymbols,
Master->Null,
DefInfo->{"covariant derivative",""}};
DefCovD[list_List,rest___]:=Scan[DefCovD[#,rest]&,list];
DefCovD[covd_[ind_],vbundles_,options:OptionsPattern[]]:=
Catch@(If[Not[AIndexQ[ind]&&DownIndexQ[ind]],Throw[Message[DefCovD::invalid,"covariant abstract-index",ind]]];
With[{tbundle=VBundleOfIndex[ind],manifold=BaseOfVBundle@VBundleOfIndex[ind]},
Module[{allbundles,symbol,torsion,curvature,metric,curvrels,ef,odeps,wwb,pns,master,info,ot,pw,curvedbundles},

(* Options *)
{symbol,torsion,curvature,metric,curvrels,ot,pw,ef,odeps,wwb,pns,master,info}=OptionValue[{SymbolOfCovD,Torsion,Curvature,FromMetric,CurvatureRelations,OrthogonalTo,ProjectedWith,ExtendedFrom,OtherDependencies,WeightedWithBasis,ProtectNewSymbol,Master,DefInfo}];
ot=Flatten[{ot},1];
pw=Flatten[{pw},1];

(* Checks *)
allbundles=DeleteDuplicates@Flatten[{tbundle,vbundles,Dagger/@{vbundles}}];
curvedbundles=DefCovDCheck[covd,manifold,allbundles,symbol,{torsion,curvature,metric,curvrels,ef,odeps,wwb}];

(* Register *)
MakeDefInfo[DefCovD,covd[ind],info];
MakexTensions[DefCovD,"Beginning",covd[ind],vbundles,options];
CovDQ[covd]^=True;
AppendToUnevaluated[$CovDs,covd];
SymbolOfCovD[covd]^=symbol;
ManifoldOfCovD[covd]^=manifold;
VBundlesOfCovD[covd]^=allbundles;
DependenciesOfCovD[covd]^=SortDependencies@Join[{manifold},odeps];
TorsionQ[covd]^=torsion;
TagSet[covd,CurvatureQ[covd,#],True]&/@curvedbundles;
TagSet[covd,CurvatureQ[covd,#],False]&/@Complement[allbundles,curvedbundles];
MetricOfCovD[covd]^=metric;
WeightedWithBasis[covd]^=wwb;
SymbolRelations[covd,master,If[ef===Null,{manifold},{manifold,ef}]];
DefInfo[covd]^=info;

(* Define derivative operator *)
MakeLinearDerivative[covd,ot==={}];
MakeTensorialDerivative[covd];
If[ot=!={},MakeOrthogonalDerivative[covd,First[pw],First[ot]]];
If[pw=!={},MakeProjectedDerivative[covd,First[pw],First[ot]]];

(* Define curvature tensors and other properties *)
If[info=!=False,info=$DefInfoQ];
If[ef=!=Null,
ExtendedFrom[covd]^=ef;
defcovdTangent[covd,tbundle,{MetricOfCovD[ef],ef},{ot,pw,info}],
defcovdTangent[covd,tbundle,{torsion,CurvatureQ[covd,tbundle],metric,curvrels},{ot,pw,info}]];
If[Length[allbundles]>1,defcovdFiber[covd,tbundle,allbundles[[2]],MemberQ[curvedbundles,allbundles[[2]]],info]
];

MakexTensions[DefCovD,"End",covd[ind],vbundles,options];

If[pns,Protect[covd]];
]
]);
SetNumberOfArguments[DefCovD,{1,Infinity}];
Protect[DefCovD];

5) Default definitions:

CurvatureQ[covd_Symbol?CovDQ,vbundle_?VBundleQ]:=False;
CurvatureQ[x_,vbundle_?VBundleQ]:=Throw@Message[CurvatureQ::unknown,"covariant derivative",x];
CurvatureQ[covd_Symbol?CovDQ_,x_]:=Throw@Message[CurvatureQ::unknown,"vector bundle",x];
CurvatureQ[covd_]:=Apply[Or,Map[CurvatureQ[covd,#]&,VBundlesOfCovD[covd]]];
TorsionQ[covd_Symbol?CovDQ]:=False;
TorsionQ[x_]:=Throw@Message[TorsionQ::unknown,"covariant derivative",x];
MetricOfCovD[x_]:=Throw@Message[MetricOfCovD::unknown,"covariant derivative",x];
DependenciesOfCovD[x_]:=Throw@Message[DependenciesOfCovD::unknown,"covariant derivative",x];
ExtendedFrom[x_]:=Null;
WeightedWithBasis[covd_?CovDQ]:=Null;
WeightedWithBasis[x_]:=Throw@Message[WeightedWithBasis::unknown,"covariant derivative",x];
WeightedCovDQ[covd_]:=WeightedWithBasis[covd]=!=Null;
MetricCovDQ[covd_]:=MetricOfCovD[covd]=!=Null;

6) Construct associated tensors. These tensors are created by DefCovD, but we do not register their names (we could do it either explicitly there or with remembered values here). Hence, that assumes that the user will not tamper with GiveSymbol in the middle of a session. Recall that for PD there are special definitions giving always the Zero tensor.

General::nomet="Found nonmetric connection `1`.";

(* Always defined *)
Torsion[covd_Symbol?CovDQ]:=GiveSymbol[Torsion,covd];
Riemann[covd_Symbol?CovDQ]:=GiveSymbol[Riemann,covd];
FRiemann[covd_Symbol?CovDQ]:=GiveSymbol[FRiemann,covd];
Ricci[covd_Symbol?CovDQ]:=GiveSymbol[Ricci,covd];
(* Defined only for metric-derived connections *)
RicciScalar[covd_Symbol?CovDQ]:=If[MetricCovDQ[covd],GiveSymbol[RicciScalar,covd],Throw@Message[RicciScalar::nomet,covd]];
Einstein[covd_Symbol?CovDQ]:=If[MetricCovDQ[covd],GiveSymbol[Einstein,covd],Throw@Message[Einstein::nomet,covd]];
TFRicci[covd_Symbol?CovDQ]:=If[MetricCovDQ[covd],GiveSymbol[TFRicci,covd],Throw@Message[TFRicci::nomet,covd]];
Weyl[covd_Symbol?CovDQ]:=If[MetricCovDQ[covd],GiveSymbol[Weyl,covd],Throw@Message[Weyl::nomet,covd]];
Kretschmann[covd_Symbol?CovDQ]:=If[MetricCovDQ[covd],GiveSymbol[Kretschmann,covd],Throw@Message[Kretschmann::nomet,covd]];
(* Defined only for connections associated to a frozen metric *)
RiemannDown[covd_Symbol?CovDQ]:=If[MetricCovDQ[covd],
If[FrozenMetricQ[MetricOfCovD[covd]],GiveSymbol[RiemannDown,covd],GiveSymbol[Riemann,covd]],
Throw@Message[RiemannDown::nomet,covd]
];

Set a default:

SetDelayed[#1[x_],Throw@Message[#::unknown,"connection",x]]&/@{Torsion,Riemann,FRiemann,Ricci,RiemannDown,RicciScalar,Einstein,TFRicci,Weyl,Kretschmann};

7) There is a second use for CurvatureRelations. Note that there is no equivalent for FRiemann because there is no inner vbundle Weyl, Ricci, TFRicci or RicciScalar.

CurvatureRelations[]:=Apply[Join,Map[CurvatureRelations,$CovDs]];
CurvatureRelations[covd_Symbol?CovDQ]:=Join[CurvatureRelations[covd,Riemann],If[MetricOfCovD[covd]=!=Null,CurvatureRelations[covd,Ricci],{}]];
CurvatureRelations[___]:={};

This is a simple driver for CurvatureRelations:

ContractCurvature[expr_,args___]:=expr//.CurvatureRelations[args];

8) Finalize commands:

SetNumberOfArguments[#,1]&/@{TorsionQ,MetricOfCovD,SymbolOfCovD,ExtendedFrom,DependenciesOfCovD,WeightedWithBasis};
SetNumberOfArguments[CurvatureQ,{1,2}];
Protect[FRiemann,Curvature,Torsion,FromMetric,CurvatureRelations,CurvatureQ,TorsionQ,MetricOfCovD,SymbolOfCovD,ContractCurvature,ExtendedFrom,DependenciesOfCovD,WeightedWithBasis];

9) Motivated by the package Spinors`, we introduce the concept of symmetry of a derivative. Sometimes we shall be working with multi-index derivatives, and that requires handling possible symmetries in those indices. We shall completely follow the structure of SymmetryGroupOfTensor.

(* By default the symmetry group of a derivative is trivial *)
SymmetryGroupOfCovD[covd_[___]]:=SymmetryGroupOfCovD[covd];
SymmetryGroupOfCovD[covd_Symbol]:=StrongGenSet[{},GenSet[]];

11.2.4. UndefCovD

This function is too complicated in comparison with other UndefType functions. QUESTION: Can it be simplified?

UndefCovD[PD]:=Throw@Message[UndefCovD::noundef,"CovD",PD,"it is the fiducial origin of derivatives"];
UndefCovD[covd_]:=($MultiIndexCovDs=DeleteCases[$MultiIndexCovDs,covd];RemoveSymbol[covd])/;MemberQ[$MultiIndexCovDs,covd];
UndefCovD[list:{___?CovDQ}]:=Scan[UndefCovD,list];
UndefCovD[covd_]:=Catch@With[{manifold=ManifoldOfCovD[covd],ef=ExtendedFrom[covd]},Module[{servants=ServantsOf[covd],christoffels},

If[!CovDQ[covd],Throw[Message[UndefCovD::unknown,"covariant derivative",covd]]];
CheckRemoveSymbol[covd];
MakexTensions[UndefCovD,"Beginning",covd];
xUpSet[ServantsOf[covd],{}];
christoffels=Cases[$Christoffels,{_,{___,covd,___},_}];
$Christoffels=Complement[$Christoffels,christoffels];
DropFromHosts[covd];
Undef/@Union[First/@christoffels,servants];
If[ef=!=Null,
xUpDeleteCasesTo[VisitorsOf[ef],covd];RemoveSymbol/@(StringJoin[#,ToString[covd]]&/@Join[{"Christoffel","Riemann","Ricci","Torsion"},If[MetricOfCovD[ef]=!=Null,{"RicciScalar","Weyl","TFRicci","Einstein","Kretschmann"},{}]])];
$CovDs=DeleteCases[$CovDs,covd];
If[MetricOfCovD[covd]=!=Null,
Unset[RiemannToWeylRules[covd]];
Unset[WeylToRiemannRules[covd]];
Unset[RicciToTFRicciRules[covd]];
Unset[TFRicciToRicciRules[covd]];
Unset[RicciToEinsteinRules[covd]];
Unset[EinsteinToRicciRules[covd]];
];
Unset[SortCovDs[expr_,covd]];
MakexTensions[UndefCovD,"End",covd];
MakeUndefInfo[UndefCovD,covd];
RemoveSymbol[covd];
]
];
SetNumberOfArguments[UndefCovD,1];
Protect[UndefCovD];

Listable functions:

SortCovDs[expr_]:=SortCovDs[expr,$CovDs];
SortCovDs[expr_,list_List]:=Fold[SortCovDs,expr,list];
SetNumberOfArguments[SortCovDs,{1,2}];

deflistableCovDs[function_]:=With[{rules=SymbolJoin[function,"Rules"]},
function[expr_]:=function[expr,$CovDs];
function[expr_,list_List]:=Fold[function,expr,list];
function[expr_,covd_Symbol?CovDQ]:=expr/.rules[covd];
SetNumberOfArguments[function,{1,2}];
Protect[function];
];

deflistableCovDs/@{RiemannToWeyl,WeylToRiemann,RicciToTFRicci,TFRicciToRicci,RicciToEinstein,EinsteinToRicci,RiemannToRiemannDown,RiemannDownToRiemann};

11.2.5. Torsion, curvature and metric

This is a trivial function in charge of the many messages that DefCovD outputs

defmessage[adjective_String ,tensor_String,output_,comment_:""]:=Print["** DefCovD:  Defining "<>If[adjective==="","",adjective<>" "]<>tensor<>" tensor ",output,comment]

defmessage["vanishing","Riemann",R[-a,-b,-c,-d]]

CovD::noleib="Cannot apply Leibnitz rule for `1` on `2`."

This simple function with arguments metricQ, torsionQ decides the symmetry of the Riemann tensor:

riemannsymmetric[True,False]:=RiemannSymmetric[{1,2,3,4}];
riemannsymmetric[True,True]:=StrongGenSet[{1,2,3},GenSet[-xAct`xPerm`Cycles[{1,2}],-xAct`xPerm`Cycles[{3,4}]]];

Here we define all the properties of the tensors associated with the connection, depending on the properties of the connection. Concerning induced (projected) derivatives, the only consideration here is constructing objects which are projected along the corresponding vectors and projectors.

Thanks to Thomas for pointing out that the dimension dim was not correct in the projected case. Fixed in August 2013.

defcovdTangent[covd_,tbundle_,{torQ_,curvQ_,metric_,curvrels_},{ov_,pw_,info_}]:=With[
(* Reinterpretation of input *)
{indexlist=GetIndicesOfVBundle[tbundle,9],
dim=If[pw==={},DimOfVBundle[tbundle],DimOfVBundle[tbundle]-1],
metricQ=(metric=!=Null),
orthogonalQ=(ov=!={}),
projectedQ=(pw=!={}),
endowedQ=MetricEndowedQ[tbundle],
frozenQ=If[metric=!=Null,FrozenMetricQ[metric],False]},
With[
(* Secondary definitions *)
{tbQ=VBundleIndexQ[tbundle],
tbpmQ=VBundleIndexPMQ[tbundle],
invmetric=If[metricQ,If[frozenQ,GiveSymbol[Inv,metric],metric],False],
TorsionName=GiveSymbol[Torsion,covd],
ChristoffelName=GiveSymbol[Christoffel,covd],
RiemannName=GiveSymbol[Riemann,covd],
RiemannDownName=If[metricQ,GiveSymbol[If[frozenQ,RiemannDown,Riemann],covd],$Failed],
RicciName=GiveSymbol[Ricci,covd],
WeylName=If[metricQ,GiveSymbol[Weyl,covd]],
TFRicciName=If[metricQ,GiveSymbol[TFRicci,covd]],
EinsteinName=If[metricQ,GiveSymbol[Einstein,covd]],
RicciScalarName=If[metricQ,GiveSymbol[RicciScalar,covd]],
KretschmannName=If[metricQ,GiveSymbol[Kretschmann,covd]],
i1=indexlist[[1]],
i2=indexlist[[2]],
i3=indexlist[[3]],
i4=indexlist[[4]],
i5=indexlist[[5]],
i1d=indexlist[[6]],
i2d=indexlist[[7]],
i3d=indexlist[[8]],
i4d=indexlist[[9]],
integerdimQ=IntegerQ[dim]},
Module[{prot,vector,projector,tmp,vanishQ},

(* 0. Check orthogonality and projections *)
If[!endowedQ&&(projectedQ||orthogonalQ),Throw@Message[DefCovD::error,"xTensor cannot yet project in a vector bundle without metric."]];

If[orthogonalQ,vector=ov[[1,0]]];
If[projectedQ,projector=pw[[1,0]]];

(* 1. Define torsion tensor *)
vanishQ=!torQ;
DefTensor[TorsionName[i1,-i2,-i3],DependenciesOfCovD[covd],Antisymmetric[{2,3}],
PrintAs:>GiveOutputString[Torsion,covd],
VanishingQ->vanishQ,
Master->covd,
OrthogonalTo:>If[orthogonalQ,{vector[-i1],vector[i2],vector[i3]},{}],
ProjectedWith:>If[projectedQ,{projector[-i1,i1d],projector[i2,-i2d],projector[i3,-i3d]},{}],
DefInfo:>If[info,{"torsion tensor",""},False],
TensorID->{Torsion,covd}];

(* 2. Define Christoffel tensor relating covd to PD. Always nonzero *)
DefTensor[ChristoffelName[i1,-i2,-i3],DependenciesOfCovD[covd],If[torQ,StrongGenSet[{},GenSet[]],Symmetric[{2,3}]],
PrintAs:>GiveOutputString[Christoffel,covd],
Master->covd,
OrthogonalTo:>If[orthogonalQ,{vector[-i1],vector[i2],vector[i3]},{}],
ProjectedWith:>If[projectedQ,{projector[-i1,i1d],projector[i2,-i2d],projector[i3,-i3d]},{}],
DefInfo:>If[info,{If[torQ,"non-symmetric ","symmetric "]<>"Christoffel tensor",""},False],
TensorID->{Christoffel,covd,PD}];
AppendTo[$Christoffels,{ChristoffelName,{Christoffel,covd,PD},{tbundle}}];

(* 3. Automatic commutativity of scalars, even if there is torsion. Only for covariant derivatives with abstract indices *)
(* CovDTODO *)
covd[-b_?tbQ][covd[-a_?tbQ][scalar_?xTensorQ[]]]:=covd[-a][covd[-b][scalar[]]]+$TorsionSign Module[{dummy=DummyIn[tbundle]},TorsionName[dummy,-a,-b]covd[-dummy][scalar[]]]/;$CommuteCovDsOnScalars&&DisorderedPairQ[a,b];

(* 4. Metric compatibility *)
(* CovDTODO *)
If[metricQ,
If[frozenQ,
covd[a_][invmetric[b_Symbol?tbQ,c_Symbol?tbQ]]:=0;
covd[a_][metric[-b_Symbol?tbQ,-c_Symbol?tbQ]]:=0;
covd/:TensorDerivative[invmetric,covd,___]:=Zero;
covd/:TensorDerivative[metric,covd,___]:=Zero,
covd[a_][metric[b_?tbpmQ,c_?tbpmQ]]:=0;
covd/:TensorDerivative[metric,covd,___]:=Zero
]
];

(* 5. Only if there is a metric and no torsion the RiemannDown tensor has its full symmetries *)
vanishQ=!curvQ||If[integerdimQ,dim<2,False];
If[metricQ,
DefTensor[RiemannDownName[-i1,-i2,-i3,-i4],DependenciesOfCovD[covd],If[torQ,JoinSGS[Antisymmetric[{1,2}],Antisymmetric[{3,4}]],RiemannSymmetric[{1,2,3,4}]],
PrintAs:>GiveOutputString[If[frozenQ,RiemannDown,Riemann],covd],
VanishingQ->vanishQ,
Master->covd,
OrthogonalTo:>If[orthogonalQ,{vector[i1],vector[i2],vector[i3],vector[i4]},{}],
ProjectedWith:>If[projectedQ,{projector[i1,-i1d],projector[i2,-i2d],projector[i3,-i3d],projector[i4,-i4d]},{}],
DefInfo:>If[info,{"Riemann tensor",If[torQ,"Antisymmetric pairs cannot be exchanged.",""]},False],
TensorID->{Riemann,covd}]];
If[!metricQ||(metricQ&&frozenQ),
DefTensor[RiemannName[-i1,-i2,-i3,i4],DependenciesOfCovD[covd],Antisymmetric[{1,2}],
PrintAs:>GiveOutputString[Riemann,covd],
VanishingQ->vanishQ,
Master->covd,
OrthogonalTo:>If[orthogonalQ,{vector[i1],vector[i2],vector[i3],vector[-i4]},{}],
ProjectedWith:>If[projectedQ,{projector[i1,-i1d],projector[i2,-i2d],projector[i3,-i3d],projector[-i4,i4d]},{}],
DefInfo:>If[info,{"Riemann tensor",If[curvQ,"Antisymmetric only in the first pair.",""]},False],
TensorID->{Riemann,covd}]
];

(* 6. Only if there is a metric and no torsion the Ricci tensor is symmetric *)
vanishQ=!curvQ||If[integerdimQ,dim<2,False];
DefTensor[RicciName[-i1,-i2],DependenciesOfCovD[covd],If[metricQ&&!torQ,Symmetric[{1,2}],StrongGenSet[{},GenSet[]]],
PrintAs:>GiveOutputString[Ricci,covd],
VanishingQ->vanishQ,
Master->covd,
OrthogonalTo:>If[orthogonalQ,{vector[i1],vector[i2]},{}],
ProjectedWith:>If[projectedQ,{projector[i1,-i1d],projector[i2,-i2d]},{}],
DefInfo:>If[info,{If[vanishQ,"",If[metricQ&&!torQ,"symmetric ","non-symmetric "]]<>"Ricci tensor",""},False],
TensorID->{Ricci,covd}];
If[!vanishQ,
covd/:CurvatureRelations[covd,Riemann]=MakeRule[{RiemannName[-i1,-i2,-i3,i2],$RicciSign RicciName[-i1,-i3]},MetricOn->All];
If[curvrels,
If[info,Print["** DefCovD:  Contractions of Riemann automatically replaced by Ricci."]];
prot=Unprotect[RiemannName];
AutomaticRules[RiemannName,CurvatureRelations[covd,Riemann],Verbose->False];
Protect[Evaluate[prot]];
]
];

(* 7. The Ricci scalar only exists for a metric connection, even if there is torsion *)
If[metricQ,
vanishQ=!curvQ||If[integerdimQ,dim<2,False];
DefTensor[RicciScalarName[],DependenciesOfCovD[covd],
PrintAs:>GiveOutputString[Ricci,covd],
VanishingQ->vanishQ,
Master->covd,
DefInfo:>If[info,{"Ricci scalar",""},False],
TensorID->{RicciScalar,covd}];
If[!vanishQ,
covd/:CurvatureRelations[covd,Ricci]=Join[MakeRule[{invmetric[i1,i2]RicciName[-i1,-i2],RicciScalarName[]},MetricOn->All],If[!frozenQ,MakeRule[{RicciName[-i1,i1],RicciScalarName[]},MetricOn->All],{}]];
If[curvrels,
If[info,Print["** DefCovD:  Contractions of Ricci automatically replaced by RicciScalar."]];
prot=Unprotect[RicciName];
AutomaticRules[RicciName,CurvatureRelations[covd,Ricci],Verbose->False];
Protect[Evaluate[prot]];
]
]
];

(* 8. The Einstein tensor only exists for a metric connection, even if there is torsion *)
If[metricQ,
vanishQ=!curvQ||If[integerdimQ,dim<3,False];
DefTensor[EinsteinName[-i1,-i2],DependenciesOfCovD[covd],If[torQ,StrongGenSet[{},GenSet[]],Symmetric[{1,2}]],
PrintAs:>GiveOutputString[Einstein,covd],
VanishingQ->vanishQ,
Master->covd,
OrthogonalTo:>If[orthogonalQ,{vector[i1],vector[i2]},{}],
ProjectedWith:>If[projectedQ,{projector[i1,-i1d],projector[i2,-i2d]},{}],
DefInfo:>If[info,{If[vanishQ,"",If[torQ,"non-symmetric ","symmetric "]]<>"Einstein tensor",""},False],
TensorID->{Einstein,covd}];
If[!vanishQ,
prot=Unprotect[invmetric];
AutomaticRules[invmetric,MakeRule[{invmetric[i2,i3]covd[-i3][EinsteinName[-i1,-i2]],$TorsionSign invmetric[i2,i3]RicciName[-i4,-i2]TorsionName[i4,-i1,-i3]-$TorsionSign $RicciSign/2 invmetric[i2,i3]RiemannName[-i1,-i4,-i2,i5]TorsionName[i4,-i3,-i5]}],Verbose->False];
Protect[Evaluate[prot]];
If[!frozenQ ,
prot=Unprotect[EinsteinName];
AutomaticRules[EinsteinName,MakeRule[{covd[-i2][EinsteinName[-i1,i2]],$TorsionSign metric[i2,i3]RicciName[-i4,-i2]TorsionName[i4,-i1,-i3]-$TorsionSign $RicciSign/2 metric[i2,i3]RiemannName[-i1,-i4,-i2,i5]TorsionName[i4,-i3,-i5]},MetricOn->All],Verbose->False];
Protect[Evaluate[prot]];
]
]
];

(* 9. We define the Weyl tensor only for a metric connection, even with torsion *)
If[metricQ,
(* Weyl *)
vanishQ=!curvQ||If[integerdimQ,dim<4,False];
DefTensor[WeylName[-i1,-i2,-i3,-i4],DependenciesOfCovD[covd],If[torQ,JoinSGS[Antisymmetric[{1,2}],Antisymmetric[{3,4}]],RiemannSymmetric[{1,2,3,4}]],
PrintAs:>GiveOutputString[Weyl,covd],
VanishingQ->vanishQ,
Master->covd,
OrthogonalTo:>If[orthogonalQ,{vector[i1],vector[i2],vector[i3],vector[i4]},{}],
ProjectedWith:>If[projectedQ,{projector[i1,-i1d],projector[i2,-i2d],projector[i3,-i3d],projector[i4,-i4d]},{}],
DefInfo:>If[info,{"Weyl tensor",If[torQ,"Antisymmetric pairs cannot be exchanged.",""]},False],
TensorID->{Weyl,covd}];
If[!vanishQ,
prot=Unprotect[WeylName];
AutomaticRules[WeylName,MakeRule[{invmetric[i2,i4]WeylName[-i1,-i2,-i3,-i4],0},MetricOn->All],Verbose->False];
If[!frozenQ,
AutomaticRules[WeylName,MakeRule[{WeylName[i1,-i2,-i1,-i3],0},MetricOn->All],Verbose->False];
];
Protect[Evaluate[prot]];
]
];

(* 10. TFRicci for metric connections, even with torsion *)
If[metricQ,
vanishQ=!curvQ||If[integerdimQ,dim<3,False];
DefTensor[TFRicciName[-i1,-i2],DependenciesOfCovD[covd],If[torQ,StrongGenSet[{},GenSet[]],Symmetric[{1,2}]],
PrintAs:>GiveOutputString[TFRicci,covd],
VanishingQ->vanishQ,
Master->covd,
OrthogonalTo:>If[orthogonalQ,{vector[i1],vector[i2]},{}],
ProjectedWith:>If[projectedQ,{projector[i1,-i1d],projector[i2,-i2d]},{}],
DefInfo:>If[info,{If[vanishQ,"",If[torQ,"non-symmetric ","symmetric "]]<>"TFRicci tensor",""},False],
TensorID->{TFRicci,covd}];
If[!vanishQ,
prot=Unprotect[TFRicciName];
AutomaticRules[TFRicciName,MakeRule[{invmetric[i1,i2]TFRicciName[-i1,-i2],0},MetricOn->All],Verbose->False];If[!frozenQ,
AutomaticRules[TFRicciName,MakeRule[{TFRicciName[i1,-i1],0},MetricOn->All],Verbose->False];
Protect[Evaluate[prot]];
]
]
];

(* 10b. Kretschmann for metric connections, even with torsion *)
If[metricQ,
vanishQ=!curvQ;
DefTensor[KretschmannName[],DependenciesOfCovD[covd],
PrintAs:>GiveOutputString[Kretschmann,covd],
VanishingQ->vanishQ,
Master->covd,
DefInfo:>If[info,{"Kretschmann scalar",""},False],
TensorID->{Kretschmann,covd}];
];

(* 11. Commutation of derivatives with abstract indices *)
If[metricQ &&!frozenQ,
SortCovDs[expr_,covd]:=(expr//.
HoldPattern[covd[b_?tbpmQ][covd[a_?tbpmQ][expr1_]]]:>makeCommuteCovDs[expr1,covd,{a,b}]/;DisorderedPairQ[a,b]),
SortCovDs[expr_,covd]:=(expr//.HoldPattern[covd[-b_?tbQ][covd[-a_?tbQ][expr1_]]]:>makeCommuteCovDs[expr1,covd,{-a,-b}]/;DisorderedPairQ[-a,-b])
];

(* 12. Riemann versus Weyl *)
RiemannToWeylRules[covd]=If[curvQ&&metricQ&&If[integerdimQ,dim>1,True],If[info,Print["** DefCovD:  Computing RiemannToWeylRules for dim ",dim]];
Which[
dim===2,
MakeRule[{RiemannDownName[i1,i2,i3,i4],$RicciSign RicciScalarName[](metric[i1,i3]metric[i2,i4]-metric[i1,i4]metric[i2,i3])/2},MetricOn->All,ContractMetrics->True],
dim===3,MakeRule[{RiemannDownName[i1,i2,i3,i4],$RicciSign(metric[i1,i3]RicciName[i2,i4]+metric[i2,i4]RicciName[i1,i3]-metric[i1,i4]RicciName[i2,i3]-metric[i2,i3]RicciName[i1,i4])/(dim-2)-$RicciSign RicciScalarName[](metric[i1,i3]metric[i2,i4]-metric[i1,i4]metric[i2,i3])/(dim-1)/(dim-2)},MetricOn->All,ContractMetrics->True],
True,MakeRule[{RiemannDownName[i1,i2,i3,i4],WeylName[i1,i2,i3,i4]+$RicciSign(metric[i1,i3]RicciName[i2,i4]+metric[i2,i4]RicciName[i1,i3]-metric[i1,i4]RicciName[i2,i3]-metric[i2,i3]RicciName[i1,i4])/(dim-2)-$RicciSign RicciScalarName[](metric[i1,i3]metric[i2,i4]-metric[i1,i4]metric[i2,i3])/(dim-1)/(dim-2)},MetricOn->All,ContractMetrics->True]
],
{}];
WeylToRiemannRules[covd]=If[If[integerdimQ,dim≥4,True]&&metricQ&&curvQ,MakeRule[{WeylName[i1,i2,i3,i4],RiemannDownName[i1,i2,i3,i4]-$RicciSign(metric[i1,i3]RicciName[i2,i4]+metric[i2,i4]RicciName[i1,i3]-metric[i1,i4]RicciName[i2,i3]-metric[i2,i3]RicciName[i1,i4])/(dim-2)+$RicciSign RicciScalarName[](metric[i1,i3]metric[i2,i4]-metric[i1,i4]metric[i2,i3])/(dim-1)/(dim-2)},MetricOn->All,TestIndices->False,ContractMetrics->True],
{}];

RiemannToRiemannDownRules[covd]=If[metricQ&&frozenQ&&curvQ,MakeRule[{RiemannName[i1,i2,i3,i4],RiemannDownName[i1,i2,i3,-i1d]invmetric[i1d,i4]},MetricOn->All,TestIndices->False,ContractMetrics->True],
{}];
RiemannDownToRiemannRules[covd]=If[metricQ&&frozenQ&&curvQ,MakeRule[{RiemannDownName[i1,i2,i3,i4],RiemannName[i1,i2,i3,i1d]metric[-i1d,i4]},MetricOn->All,TestIndices->False,ContractMetrics->True],
{}];

(* 13. Ricci versus TFRicci. QUESTION: Are dimensions right when orthogonalQ or projectedQ? *)
RicciToTFRicciRules[covd]=If[curvQ&&metricQ&&If[integerdimQ,dim>1,True]&&!frozenQ,If[info,Print["** DefCovD:  Computing RicciToTFRicci for dim ",dim]];
Which[
dim===2,
MakeRule[{RicciName[i1,i2],RicciScalarName[]metric[i1,i2]/2},MetricOn->All,ContractMetrics->True],
True,MakeRule[{RicciName[i1,i2],TFRicciName[i1,i2]+ RicciScalarName[]metric[i1,i2]/dim},MetricOn->All,ContractMetrics->True]
],
{}];
TFRicciToRicciRules[covd]=If[If[integerdimQ,dim≥3,True]&&metricQ&&curvQ&&!frozenQ,MakeRule[{TFRicciName[i1,i2],RicciName[i1,i2]- RicciScalarName[]metric[i1,i2]/dim},MetricOn->All,TestIndices->False,ContractMetrics->True],
{}];

(* 14. Ricci versus Einstein *)
RicciToEinsteinRules[covd]=
If[curvQ&&metricQ&&If[integerdimQ,dim>1,True],
If[info,Print["** DefCovD:  Computing RicciToEinsteinRules for dim ",dim]];
Which[
dim===2,
MakeRule[{RicciName[i1,i2],metric[i1,i2]/2RicciScalarName[]},MetricOn->All,TestIndices->False,ContractMetrics->True],
True,
MakeRule[{RicciName[i1,i2],EinsteinName[i1,i2]+metric[i1,i2]/2RicciScalarName[]},MetricOn->All,TestIndices->False,ContractMetrics->True]
],
{}];
EinsteinToRicciRules[covd]=If[If[integerdimQ,dim≥3,True]&&metricQ&&curvQ,MakeRule[{EinsteinName[i1,i2],RicciName[i1,i2]-metric[i1,i2]/2RicciScalarName[]},MetricOn->All,TestIndices->False,ContractMetrics->True],
{}];

]
]
]

This function adds further definitions for those cases in which a derivative is defined as extension of another one:

defcovdTangent[covd_,tbundle_,{metric_,covd2_},{ov_,pw_,info_}]:=With[
(* Reinterpretation of input *)
{metricQ=(metric=!=Null),
orthogonalQ=(ov=!={}),
projectedQ=(pw=!={}),
endowedQ=MetricEndowedQ[tbundle],
frozenQ=If[metric=!=Null,FrozenMetricQ[metric],False]},
With[
(* Secondary definitions *)
{tbQ=VBundleIndexQ[tbundle],
tbpmQ=VBundleIndexPMQ[tbundle],
TorsionName=GiveSymbol[Torsion,covd],
ChristoffelName=GiveSymbol[Christoffel,covd],
Christoffel12Name=GiveSymbol[Christoffel,##]&@@Sort[{covd,covd2}],
RiemannName=GiveSymbol[Riemann,covd],
RiemannDownName=If[metricQ,GiveSymbol[If[frozenQ,RiemannDown,Riemann],covd]],
RicciName=GiveSymbol[Ricci,covd],
WeylName=If[metricQ,GiveSymbol[Weyl,covd]],
TFRicciName=If[metricQ,GiveSymbol[TFRicci,covd]],
EinsteinName=If[metricQ,GiveSymbol[Einstein,covd]],
RicciScalarName=If[metricQ,GiveSymbol[RicciScalar,covd]],
KretschmannName=If[metricQ,GiveSymbol[Kretschmann,covd]]},

(* 0. Check orthogonality and projections *)
If[!endowedQ&&(projectedQ||orthogonalQ),Throw[Message[DefCovD::error,"xTensor cannot yet project in a vector bundle without metric."]]];

(* 1. Define torsion tensor *)
TorsionQ[covd]^=TorsionQ[covd2];
TorsionName=GiveSymbol[Torsion,covd2];

(* 2. Define Christoffel tensor relating covd to PD. Always nonzero *)
ChristoffelName=GiveSymbol[Christoffel,covd2];
(* The Christoffel relating a derivative and its extension is zero, but not the AChristoffel *)
defChristoffel[Christoffel12Name,{tbundle,tbundle},{Christoffel,Sequence@@Sort[{covd,covd2}]},VanishingQ->True];
(* Christoffel12Name[_,_,_]:=0;*)

(* CovDTODO *)
(* 3. Automatic commutativity of scalars, even if there is torsion. Only for covariant derivatives with abstract indices *)
covd[-b_?tbQ][covd[-a_?tbQ][scalar_?xTensorQ[]]]:=covd[-a][covd[-b][scalar[]]]+$TorsionSign Module[{dummy=DummyIn[tbundle]},TorsionName[dummy,-a,-b]covd[-dummy][scalar[]]]/;$CommuteCovDsOnScalars&&DisorderedPairQ[a,b];

(* 4. Only if there is a metric the Riemann tensor has its full symmetries *)
RiemannName=GiveSymbol[Riemann,covd2];
If[frozenQ,RiemannDownName=GiveSymbol[RiemannDown,covd2]];

(* 5. Only if there is a metric the Ricci tensor is symmetric *)
RicciName=GiveSymbol[Ricci,covd2];

(* 6. The Ricci scalar only exists for a metric connection *)
If[metricQ,RicciScalarName=GiveSymbol[RicciScalar,covd2]];

(* 7. Metric compatibility is automatically extended *)
If[metricQ,covd[_][metric[_?AIndexQ,_?AIndexQ]]:=0];

(* 8. The Einstein tensor only exists for a metric connection *)
If[metricQ,EinsteinName=GiveSymbol[Einstein,covd2]];

(* 9. The Weyl and TFRicci tensors only exist for a metric connection *)
If[metricQ,
WeylName=GiveSymbol[Weyl,covd2];
TFRicciName=GiveSymbol[TFRicci,covd2];
KretschmannName=GiveSymbol[Kretschmann,covd2]];

(* 10. Commutation of derivatives with abstract indices *)
(* CovDTODO *)
If[metricQ &&!frozenQ,
SortCovDs[expr_,covd]:=(expr//.
HoldPattern[covd[b_?tbpmQ][covd[a_?tbpmQ][expr1_]]]:>makeCommuteCovDs[expr1,covd,{a,b}]/;DisorderedPairQ[a,b]),
SortCovDs[expr_,covd]:=(expr//.HoldPattern[covd[-b_?tbQ][covd[-a_?tbQ][expr1_]]]:>makeCommuteCovDs[expr1,covd,{-a,-b}]/;DisorderedPairQ[-a,-b])
];

If[metricQ,
(* 11. Riemann versus Weyl. Are dimensions right when orthogonalQ or projectedQ? *)
RiemannToWeylRules[covd]=RiemannToWeylRules[covd2];
WeylToRiemannRules[covd]=WeylToRiemannRules[covd2];

(* 12. Ricci versus TFRicci. Are dimensions right when orthogonalQ or projectedQ? *)
RicciToTFRicciRules[covd]=RicciToTFRicciRules[covd2];
TFRicciToRicciRules[covd]=TFRicciToRicciRules[covd2];

(* 13. Ricci versus Einstein *)
RicciToEinsteinRules[covd]=RicciToEinsteinRules[covd2];
EinsteinToRicciRules[covd]=EinsteinToRicciRules[covd2];
];

(* 14. Conversion to derivative on the tangent bundle. Deactivated.
covd[a_][expr_]:=covd2[a][expr]/;DeleteCases[FindIndices[expr],x_/;GIndexQ[x,tbundle]]===IndexList[];
*)

]
];

Finally, these are the definitions associated to the inner part of the derivative:

defcovdFiber[covd_,tbundle_,fbundle_,curvQ_,info_]:=With[
(* Reinterpretation of input *)
{tindexlist=GetIndicesOfVBundle[tbundle,2],
findexlist=GetIndicesOfVBundle[fbundle,4]},
With[
(* Secondary definitions *)
{AChristoffelName=GiveSymbol[AChristoffel,covd],
FRiemannName=GiveSymbol[FRiemann,covd],
i1=tindexlist[[1]],
i2=tindexlist[[2]],
fi1=findexlist[[1]],
fi2=findexlist[[2]],
fi3=findexlist[[3]],
fi4=findexlist[[4]]},

(* 1. Define Christoffel tensor relating covd to PD. Always nonzero *)
DefTensor[AChristoffelName[fi1,-i2,-fi3],DependenciesOfCovD[covd],StrongGenSet[{},GenSet[]],
PrintAs:>GiveOutputString[AChristoffel,covd],
Dagger:>If[DaggerQ[fbundle],Complex,Real],
Master->covd,
DefInfo:>If[info,{"nonsymmetric AChristoffel tensor",""},False],
TensorID->{AChristoffel,covd,PD}];
AppendTo[$Christoffels,{AChristoffelName,{AChristoffel,covd,PD},{tbundle,fbundle}}];

(* 2. Define FRiemann tensor *)
DefTensor[FRiemannName[-i1,-i2,-fi3,fi4],DependenciesOfCovD[covd],Antisymmetric[{1,2}],
PrintAs:>GiveOutputString[FRiemann,covd],
Dagger:>If[DaggerQ[fbundle],Complex,Real],
VanishingQ:>!curvQ,
Master->covd,
DefInfo:>If[info,{"FRiemann tensor",If[curvQ,"Antisymmetric only in the first pair.",""]},False],
TensorID->{FRiemann,covd}
];

]
]

We need a small function which will be set to True in particular cases by DefMetric. In general:

InducedCovDQ[covd_]:=False;

11.2.6. Automatic SortCovDs for derivatives with abstract indices

These functions automatize the commutation of covariant derivatives. By default even PD is not automatically commutative. Recall that default commutation only happens on *nonindexed* scalars, and that can be switched off using $CommuteCovDsOnScalars. Covariant derivatives on Scalar objects replace the Scalar head by ReplaceDummies.

(* CovDTODO *)
SortCovDsStart[PD]:=Module[{},
If[Not@$CommuteCovDsOnScalars,Print["Note that $CommuteCovDsOnScalars is still False."]];
Unprotect[PD];
PD[-b_Symbol][PD[-a_Symbol][expr1_]]:=PD[-a][PD[-b][expr1]]/;DisorderedPairQ[-a,-b];
If[PD===CovDOfMetric@FirstMetricOfVBundle[#,False],
With[{vbQ=VBundleIndexPMQ[#]},
PD[b_?vbQ][PD[a_?vbQ][expr1_]]:=PD[a][PD[b][expr1]]/;DisorderedPairQ[-a,-b]]
]&/@Select[$VBundles,MetricEndowedQ];
Protect[PD];
];

SortCovDsStart[covd_?CovDQ]:=With[{
tbQ=VBundleIndexQ[TangentBundleOfCovD[covd]],
tbpmQ=VBundleIndexPMQ[TangentBundleOfCovD[covd]],
metric=MetricOfCovD[covd]},
If[Not@$CommuteCovDsOnScalars,Print["Note that $CommuteCovDsOnScalars is still False."]];
If[metric=!=Null&&!FrozenMetricQ[metric],
covd[b_?tbpmQ][covd[a_?tbpmQ][expr1_]]:=makeCommuteCovDs[expr1,covd,{a,b}]/;DisorderedPairQ[a,b],
covd[-b_?tbQ][covd[-a_?tbQ][expr1_]]:=makeCommuteCovDs[expr1,covd,{-a,-b}]/;DisorderedPairQ[-a,-b]
]
];

SortCovDsStart[list_List]:=SortCovDsStart/@list
SortCovDsStart[covd_]:=Message[SortCovDsStart::unknown,"covariant derivative",covd]
SetNumberOfArguments[SortCovDsStart,1];
Protect[SortCovDsStart];

(* CovDTODO *)
SortCovDsStop[PD]:=Module[{},
If[$CommuteCovDsOnScalars,Print["Note that $CommuteCovDsOnScalars is still True."]];
Unprotect[PD];
PD/:PD[-b_Symbol][PD[-a_Symbol][expr1_]]=.;
If[PD===CovDOfMetric@FirstMetricOfVBundle[#,False],
With[{vbQ=VBundleIndexPMQ[#]},
PD/:PD[b_?vbQ][PD[a_?vbQ][expr1_]]=.]
]&/@Select[$VBundles,MetricEndowedQ];
Protect[PD];
];

SortCovDsStop[covd_?CovDQ]:=With[{
tbQ=VBundleIndexQ[TangentBundleOfCovD[covd]],
tbpmQ=VBundleIndexPMQ[TangentBundleOfCovD[covd]],
metric=MetricOfCovD[covd]
},
If[$CommuteCovDsOnScalars,Print["Note that $CommuteCovDsOnScalars is still True."]];
If[metric=!=Null&&!FrozenMetricQ[metric],
covd[b_?tbpmQ][covd[a_?tbpmQ][expr1_]]=.,
covd[-b_?tbQ][covd[-a_?tbQ][expr1_]]=.
]
];

SortCovDsStop[covd_]:=Message[SortCovDsStop::unknown,"covariant derivative",covd]
SetNumberOfArguments[SortCovDsStop,1];
Protect[SortCovDsStop];

BeginExamples[]

DefManifold[M2,2,{A,B,C,D,F,G}]

DefTensor[v[A],M2]

PD[-A][PD[-B][v[C]]]

SortCovDs[%,PD]

SortCovDsStart[PD];

PD[-A][PD[-B][v[C]]]

SortCovDsStop[PD]

PD[-A][PD[-B][v[C]]]

UndefTensor[v]

UndefManifold[M2]

EndExamples[]

11.2.7. TensorD and TensorDerivative

We introduce another form of derivative, this time index-free based.

xTensorQ[TensorDerivative[tensor_,ders___]]^:=And[xTensorQ[tensor],And@@(TensorDerQ/@{ders})];

TensorDerQ[covd_?CovDQ]:=True;
TensorDerQ[LieD[v_?xTensorQ[_]]]:=True;
TensorDerQ[ParamD[_Symbol?ParameterQ]]:=True;
TensorDerQ[OverDot]:=True;
TensorDerQ[_]:=False;

A tensor derivative object has the following associated slots. Note that connections are always naturally covariant, and that the derivative slots are added at the end, in the order given by the ders arguments.

SlotOfDerivative[PD]:=-All;
(* Recall that the first vbundle of a covd is the tangent covd *)
SlotOfDerivative[covd_?CovDQ]:=-First@VBundlesOfCovD[covd];
SlotOfDerivative[_ParamD|OverDot|_LieD]:=Sequence[];
SlotsOfTensor[TensorDerivative[tensor_,ders__]]^:=Join[SlotsOfTensor[tensor],SlotOfDerivative/@{ders}];

Formatting:

PrefixFormatDer[ParamD[par_]]:=SubscriptBox["∂",PrintAs[par]];
PrefixFormatDer[OverDot]:=SubscriptBox["∂","#"];

PrefixFormatDer[covd_?HeldCovDQ]:=Last[SymbolOfCovD[covd]];

(* Commented out. We typeset with boxes now, rather than with strings.
PrefixFormatDerString[der_]:="\!\(\*"<>ToString[PrefixFormatDer[der]]<>"\)";*)

PrintAs[TensorDerivative[tensor_,ders___]]^:=RowBox[Append[PrefixFormatDer/@Reverse[{ders}],PrintAs[tensor]]];

Other properties.
TODO: Dagger on all derivatives (Lie derivatives for instance).

Dagger[TensorDerivative[tensor_,ders__]]^:=TensorDerivative[Dagger[tensor],ders];

TODO: I now don’t understand what follows. This could perhaps be done without going through SymmetryOf, using directly CovDSymmetryOf. This is actually wrong, because FromTensorDerivative in general will return a sum of objects, and SymmetryOf does not know how to find the symmetry of a sum.

SymmetryGroupOfTensor[TensorDerivative[tensor_,ders__][inds___]]^:=JoinSGS[SymmetryGroupOfTensor[tensor],Apply[Sequence,SymDers/@Split[Transpose[{{ders},Range[Length[{ders}]]+Length[{inds}]-Length[{ders}]}],First[#1]===First[#2]&]]];
SymDers[{{PD,n1_},{PD,_}...,{PD,nl_}}]:=SGSofsym@Symmetric[Range[n1,nl]];
SymDers[{{covd_?CovDQ,n1_},{covd_,_}...,{covd_,nl_}}]:=SGSofsym@Symmetric[Range[n1,nl]]/;!CurvatureQ[covd]&&!TorsionQ[covd];
SymDers[list_]:=StrongGenSet[{},GenSet[]];

Now we define basic properties of a derivative. Note the postfix order.

TensorDerivative[tensor_?xTensorQ][inds___]:=tensor[inds];
TensorDerivative[TensorDerivative[tensor_,ders1___],ders2___][inds___]:=TensorDerivative[tensor,ders1,ders2][inds];
TensorDerivative[expr_Plus,ders___][inds___]:=TensorDerivative[#,ders][inds]&/@expr;
TensorDerivative[expr_SeriesData,ders___][inds___]:=SeriesDataMap[TensorDerivative[#,ders][inds]&,expr];

Conversion to TensorDerivative. This is fast enough to use ReplaceRepeated.

ToTensorDerivative[expr_]:=expr//.{
covd_?CovDQ[index_][tensor_?xTensorQ[indices___]]:>ToTensorDerivative1[covd[index],tensor[indices]],
LieD[v_][tensor_?xTensorQ[indices___]]:>ToTensorDerivative1[LieD[v],tensor[indices]]
};

ToTensorDerivative1[der_,tensor_[indices___]]:=With[{tslots=SlotsOfTensor[tensor],islots=SignedVBundleOfIndex/@{indices}},
If[Length[tslots]=!=Length[islots],Throw@Message[ToTensorDerivative::error,"Incompatible number of indices."]];
TDI[der,tensor][indices]+Apply[Plus,MapIndexed[ToTensorDerivativeIndex[der,tensor[indices]],Transpose[{{indices},tslots,islots}]]]
];

The construction of TensorDerivative expressions is funneled through TDI, so that the derivative ant the tensor do not see each other before this point:

TDI[covd_?CovDQ[index_],tensor_][indices___]:=TensorDerivative[tensor,covd][indices,index];
TDI[der_,tensor_][indices___]:=TensorDerivative[tensor,der][indices];

(* On abstract indices: {index, vb-should-be, vb-it-is} *)
ToTensorDerivativeIndex[_,t_][{_LI|-_LI,_,_},{n_}]:=0;
ToTensorDerivativeIndex[_,t_][{i_?AIndexQ,All,_Symbol},{n_}]:=0;
ToTensorDerivativeIndex[_,t_][{i_?AIndexQ,-All,-_Symbol},{n_}]:=0;
ToTensorDerivativeIndex[_,t_][{i_?AIndexQ,vb_,vb_},{n_}]:=0;
ToTensorDerivativeIndex[der_,t_][{i_?AIndexQ,All,-vb_?VBundleQ},{n_}]:=With[{metric=FirstMetricOfVBundle[vb],dummy=DummyIn[vb]},ReplacePart[t,n:>dummy]TDI[der,metric][-dummy,i]];
ToTensorDerivativeIndex[der_,t_][{i_?AIndexQ,vb_,-vb_},{n_}]:=With[{metric=FirstMetricOfVBundle[vb],dummy=DummyIn[vb]},ReplacePart[t,n:>dummy]TDI[der,metric][-dummy,i]];
ToTensorDerivativeIndex[der_,t_][{i_?AIndexQ,-All,vb_?VBundleQ},{n_}]:=With[{metric=FirstMetricOfVBundle[vb],dummy=DummyIn[vb]},-ReplacePart[t,n:>-dummy]TDI[der,metric][dummy,i]];
ToTensorDerivativeIndex[der_,t_][{i_?AIndexQ,-vb_,vb_},{n_}]:=With[{metric=FirstMetricOfVBundle[vb],dummy=DummyIn[vb]},-ReplacePart[t,n:>-dummy]TDI[der,metric][dummy,i]];
(* On basis indices *)
ToTensorDerivativeIndex[der_,t_][{i:{_,basis_?BasisQ},vb_,vb_?VBundleQ},{n_}]:=With[{dummy=DummyIn[vb],dummyb=DummyIn[vb,basis]},ReplacePart[t,n:>dummyb]ReplaceAll[der[Basis[-dummy,i]],-dummy->-dummyb]];
ToTensorDerivativeIndex[der_,t_][{i:{_,-basis_?BasisQ},-vb_,-vb_?VBundleQ},{n_}]:=With[{dummy=DummyIn[vb],dummyb=DummyIn[vb,basis]},ReplacePart[t,n:>-dummyb]ReplaceAll[der[Basis[i,dummy]],dummy->dummyb]];
ToTensorDerivativeIndex[der_,t_][{i:{_,basis_?BasisQ},-vb_,vb_?VBundleQ},{n_}]:=With[{metric=FirstMetricOfVBundle[vb],dummy=DummyIn[vb],dummyb=DummyIn[vb,basis]},ReplacePart[t,n:>-dummyb](-TDI[der,metric][dummyb,i]+ReplaceAll[der[Basis[-dummy,i]],-dummy->dummyb])];
ToTensorDerivativeIndex[der_,t_][{i:{_,-basis_?BasisQ},vb_,-vb_?VBundleQ},{n_}]:=With[{metric=FirstMetricOfVBundle[vb],dummy=DummyIn[vb],dummyb=DummyIn[vb,basis]},ReplacePart[t,n:>dummyb](TDI[der,metric][-dummyb,i]+ReplaceAll[der[Basis[i,dummy]],dummy->-dummyb])];

TODO: When extracting a basis index which is not in its natural position, the Christoffel tensor has an index not in its natural position, and that is odd. I think this should be changed so that the indices are kept in their original positions. The priority must be having “neat Christoffels”.

Opposite conversion, from TensorDerivative. Again this is fast enough to use ReplaceRepeated.

This is wrong. We cannot put together tensor and the indices. We first need to construct the ??? TODO

FromTensorDerivative[expr_]:=SameDummies@Expand[expr//.{
TensorDerivative[tensor_,ders___,covd_?CovDQ][inds___,ind_]:>FromTensorDerivative1[covd[ind],TensorDerivative[tensor,ders][inds]],
TensorDerivative[tensor_,ders___,LieD[v_]][inds___]:>FromTensorDerivative1[LieD[v],TensorDerivative[tensor,ders][inds]]
}];

FromTensorDerivative1[der_,tensor_[indices___]]:=With[{tslots=SlotsOfTensor[tensor],islots=SignedVBundleOfIndex/@{indices}},
der[tensor[indices]]+Apply[Plus,MapIndexed[FromTensorDerivativeIndex[der,tensor[indices]],Transpose[{{indices},tslots,islots}]]]];

(* On abstract indices *)
FromTensorDerivativeIndex[_,t_][{i_?AIndexQ,vb_,vb_},{n_}]:=0;
FromTensorDerivativeIndex[_,t_][{i_?AIndexQ,All,_Symbol},{n_}]:=0;
FromTensorDerivativeIndex[_,t_][{i_?AIndexQ,-All,-_Symbol},{n_}]:=0;
FromTensorDerivativeIndex[der_,t_][{i_?AIndexQ,vb_,-vb_},{n_}]:=With[{metric=FirstMetricOfVBundle[vb],dummy=DummyIn[vb]},-ReplacePart[t,n:>dummy]der[metric[-dummy,i]]];
FromTensorDerivativeIndex[der_,t_][{i_?AIndexQ,-vb_,vb_},{n_}]:=With[{metric=FirstMetricOfVBundle[vb],dummy=DummyIn[vb]},ReplacePart[t,n:>-dummy]der[metric[dummy,i]]];
(* On basis indices *)
FromTensorDerivativeIndex[der_,t_][{i:{_,basis_?BasisQ},vb_?VBundleQ,vb_},{n_}]:=With[{dummy=DummyIn[vb],dummyb=DummyIn[vb,basis]},-ReplacePart[t,n:>dummyb]ReplaceAll[der[Basis[-dummy,i]],-dummy->-dummyb]];
FromTensorDerivativeIndex[der_,t_][{i:{_,-basis_?BasisQ},-vb_?VBundleQ,-vb_},{n_}]:=With[{dummy=DummyIn[vb],dummyb=DummyIn[vb,basis]},-ReplacePart[t,n:>-dummyb]ReplaceAll[der[Basis[i,dummy]],dummy->dummyb]];
FromTensorDerivativeIndex[der_,t_][{i:{_,basis_?BasisQ},-vb_?VBundleQ,vb_},{n_}]:=With[{metric=FirstMetricOfVBundle[vb],dummy=DummyIn[vb],dummyb=DummyIn[vb,basis],dummyc=DummyIn[vb]},-ReplacePart[t,n:>-dummyb](-metric[dummyb,dummy]metric[i,dummyc]FromTensorDerivative1[der,metric[-dummy,-dummyc]]+ReplaceAll[der[Basis[-dummy,i]],-dummy->dummyb])];
FromTensorDerivativeIndex[der_,t_][{i:{_,-basis_?BasisQ},vb_,-vb_?VBundleQ},{n_}]:=With[{metric=FirstMetricOfVBundle[vb],dummy=DummyIn[vb],dummyb=DummyIn[vb,basis]},-ReplacePart[t,n:>dummyb](FromTensorDerivative1[der,metric[-dummyb,i]]+ReplaceAll[der[Basis[i,dummy]],dummy->-dummyb])];

We need a generalization to encode the number of indices of each first derivative (recall the 2-index spinor derivatives).

TensorD is the action of taking a derivative. It has to be very careful with the presence of metrics and bases.

(* Derivative properties *)
TensorD[expr_,der1_,ders__]:=TensorD[TensorD[expr,der1],ders];
TensorD[expr_Plus,der_]:=TensorD[#,der]&/@expr;
TensorD[expr_SeriesData,der_]:=SeriesDataMap[TensorD[#,der]&,expr];
(* Assumes Leibnitz. This could be wrong for induced derivatives *)
TensorD[expr1_ expr2_,der_]:=TensorD[expr1,der]expr2+expr1 TensorD[expr2,der];
TensorD[_?ConstantQ,der_]:=0;
TensorD[f_?ScalarFunctionQ[args___],der_]:=multiD[TensorD[#,der]&,f[args]];
TensorD[Scalar[expr_],der_]:=TensorD[ReplaceDummies[expr],der];
TensorD[list_List,der_]:=TensorD[#,der]&/@list;
(* On particular tensors *)
TensorD[t:(_?xTensorQ[__]),der_]:=ToTensorDerivative1[der,t];

11.2.8. PullBackCovD

This is the pullback connection, and is actually closer to PrecomposeTensor than to PullBackTensor, but we follow the standard naming squeme and call this a “pullback connection”. I don’t think there is a concept of pulling back a connection CD[-A] on TN to a connection cd[-a] on TM. Only to a connection PullBackCovD[CD, phi][-a] on PullBackVBundle[TN, phi].

The pullback connection allows differentiation of pullback sections, but it is not clear to me how to relate that to differentiation of pushforward fields.

With ϕ: M -> N and a tensor field T[A, -B] on TN⊗T*N and a connection CD[-A] on TN:

	PullBackCovD[CD, ϕ][-a][ Precompose[T, ϕ][A*, -B*] ]
		== TensorDerivative[ Precompose[T, ϕ], PullBackCovD[CD, ϕ] ][A*, -B*, -a]
		== dϕ[-a, C*] Precompose[ TensorDerivative[T, CD], ϕ ][A*, -B*, -C*]

Hence CD[-A], a connection with vbundles {TN} is pulled back to PullBackCovD[CD, ϕ][-a], a connection with vbundles {PullBackVBundle[TN, ϕ]}.

That is exactly the last equation of http://en.wikipedia.org/wiki/Pullback_(differential_geometry)#Pullback_of_connections_covariant_derivatives . We see that the last step must be given in index-free (TensorDerivative) notation.

PullBackCovD[covd_?CovDQ,_IdentityMapping]:=covd;

(* Basic definitions *)
CovDQ[PullBackCovD[covd_?CovDQ,phi_?MappingQ]]^:=True;
VBundlesOfCovD[PullBackCovD[covd_?CovDQ,phi_?MappingQ]]^:=PrecomposeVBundles[BundlesOfCovD[covd],phi];
DependenciesOfCovD[PullBackCovD[covd_?CovDQ,phi_?MappingQ]]^:=PrecomposeDependencies[DependenciesOfCovD[covd],phi];
ManifoldOfCovD[PullBackCovD[covd_?CovDQ,phi_?MappingQ]]^:=PrecomposeDependency[ManifoldOfCovD[covd],phi];
MetricOfCovD[PullBackCovD[covd_?CovDQ,phi_?MappingQ]]^:=Precompose[MetricOfCovD[covd],phi];
SymbolOfCovD[PullBackCovD[covd_?CovDQ,phi_?MappingQ]]^:={#1,PullBackString[#2,phi]}&@@SymbolOfCovD[covd];
WeightedWithBasis[PullBackCovD[covd_?CovDQ,phi_?MappingQ]]^:=PrecomposeWeight[WeightedWithBasis[covd],phi];

(* Declare as a covariant derivative *)
MakeLinearDerivative[{PullBackCovD[covd_?CovDQ,phi_?MappingQ][a_],PullBackCovD[covd,phi][a]},True];
MakeTensorialDerivative[{PullBackCovD[covd_?CovDQ,phi_?MappingQ],PullBackCovD[covd,phi]}];

(* Curvature: we assume it is preserved *)
CurvatureQ[PullBackCovD[covd_?CovDQ,phi_?MappingQ]]^:=CurvatureQ[covd];
TorsionQ[PullBackCovD[covd_?CovDQ,phi_?MappingQ]]^:=TorsionQ[covd];
(* Associated tensors *)
Riemann[PullBackCovD[covd_?CovDQ,phi_?MappingQ]]^:=Precompose[Riemann[covd],phi];
Ricci[PullBackCovD[covd_?CovDQ,phi_?MappingQ]]^:=Precompose[Ricci[covd],phi];
RicciScalar[PullBackCovD[covd_?CovDQ,phi_?MappingQ]]^:=Precompose[RicciScalar[covd],phi];
Einstein[PullBackCovD[covd_?CovDQ,phi_?MappingQ]]^:=Precompose[Einstein[covd],phi];
Weyl[PullBackCovD[covd_?CovDQ,phi_?MappingQ]]^:=Precompose[Weyl[covd],phi];
TFRicci[PullBackCovD[covd_?CovDQ,phi_?MappingQ]]^:=Precompose[TFRicci[covd],phi];

Formatting.

PrintAs[PullBackCovD[covd_,phi_]]^:=PullBackString[PrintAs[covd],phi];

11.3. Validation

SetAttributes[ValidateCovD,HoldFirst];

Validation of covariant derivatives. When ind is a direction there are several functions here using UltraindexOf. I don't think it is worth programming a second version of this function only for directions.

(* CovDTODO *)
ValidateCovD[x:der_[ind_][expr_]]:=Catch[
(* Check derivative name *)
If[!CovDQ[der],Throw[Message[Validate::unknown,"covariant derivative",der];ERROR[x]]];
(* Check index. Patterns are not accepted *)
If[!GIndexQ[ind],Throw[Message[Validate::unknown,"g-index",ind];ERROR[x]]];
(* Check expression *)
UncatchedValidate[Unevaluated[expr]];
(* Check that derivative and index are compatible *)
If[!IndexOnQ[ind,TangentBundleOfCovD[der[ind]]],
Throw[Message[Validate::invalid,ind,"index for derivative"<>ToString[der]];ERROR[x]]];
(* Check that there is a metric if index is an up-index *)
If[UpIndexQ[ind]&&!MetricEndowedQ[VBundleOfIndex[ind]],Throw[Message[Validate::invalid,ind,"index for a derivative because ther is no metric in its vector bundle"];ERROR[x]]];
x];

11.4. Formatting

SetAttributes[HeldCovDQ,HoldAllComplete];
HeldCovDQ[expr_]:=CovDQ[Unevaluated[expr]];

Driver for the three needed cases.

$CovDFormat="Prefix";
xTensorFormStart[CovD]:=
(MakeBoxes[covd_Symbol?HeldCovDQ[inds__][expr_],StandardForm]:=Block[{$WarningFrom="CovD Formatting"},interpretbox[covd[inds][expr],MakeBoxesCovD[Unevaluated[covd][inds][boxof@BracketizedBoxesIfTimes[expr,StandardForm]],$CovDFormat]]];
MakeBoxes[CovD[expr_,ders__,covd_?HeldCovDQ[inds__]],StandardForm]:=Block[{$WarningFrom="CovD Formatting"},interpretbox[CovD[expr,ders,covd[inds]],MakeBoxesCovD[Unevaluated[covd][inds][boxof@MakeBoxes[CovD[expr,ders],StandardForm]],$CovDFormat]]];MakeBoxes[CovD[expr_,covd_?HeldCovDQ[inds__]],StandardForm]:=Block[{$WarningFrom="CovD Formatting"},interpretbox[CovD[expr,covd[inds]],MakeBoxesCovD[Unevaluated[covd][inds][boxof@MakeBoxes[expr,StandardForm]],$CovDFormat]]]);
xTensorFormStop[CovD]:=(
MakeBoxes[covd_Symbol?HeldCovDQ[inds__][expr_],StandardForm]=.;MakeBoxes[CovD[expr_,ders__,covd_?HeldCovDQ[inds__]],StandardForm]=.;MakeBoxes[CovD[expr_,covd_?HeldCovDQ[inds__]],StandardForm]=.);
xTensorFormStart[CovD]

SetAttributes[BracketizedBoxesIfTimes,HoldFirst];
BracketizedBoxesIfTimes[expr_Times,format_]:=RowBox[{"[",MakeBoxes[expr,format],"]"}];
BracketizedBoxesIfTimes[expr_,format_]:=MakeBoxes[expr,format];

There are two possibilities: Prefix and Postfix notation. Directional derivatives are always given in Prefix notation.

(* Non-directional derivatives in Postfix notation. Handle both SubsuperscriptBox and GridBox *)
MakeBoxesCovD[der_[i_/;Head[i]=!=Dir][SubsuperscriptBox[head_,downstr_,upstr_]],"Postfix"]:=Block[{$WarningFrom="CovD Formatting"},SubsuperscriptBox[head,#1,#2]&@@AddIndex[{downstr,upstr},i,der]];
MakeBoxesCovD[der_[i_/;Head[i]=!=Dir][gridbox_GridBox],"Postfix"]:=Block[{$WarningFrom="CovD Formatting"},ReplacePart[gridbox,AppendIndexPair[gridbox[[1,1,2,1,1]],Reverse@IndexPair[i,der]],{1,1,2,1,1}]];
(* Other cases: Prefix notation *)
MakeBoxesCovD[der_[i_][MBexpr_],str_String]:=Block[{$WarningFrom="CovD Formatting"},
FlattenRowBox@RowBox[{If[downQ[i],SubscriptBox,SuperscriptBox][Last@SymbolOfCovD@der,IndexForm@UpIndex[i]],MBexpr}]];

AppendIndexPair[grid_,pair_List]:=Transpose@Append[Transpose[grid],pair];
AppendIndexPair[grid_,pairs_IndexList]:=Transpose@Join[Transpose[grid],List@@pairs];

Additional definitions for multiple-indices derivatives. These two lines are the only place in this CovD section which allow multiple-index derivatives!

(* Postfix notation *)
MakeBoxesCovD[der_[inds__][SubsuperscriptBox[head_,downstr_,upstr_]],"Postfix"]:=Block[{$WarningFrom="CovD Formatting"},SubsuperscriptBox[head,#1,#2]&@@AddIndex[{downstr,upstr},IndexList[inds],der]];
MakeBoxesCovD[der_[ind_,inds__][gridbox_GridBox],"Postfix"]:=Block[{$WarningFrom="CovD Formatting"},
ReplacePart[gridbox,AppendIndexPair[AppendIndexPair[gridbox[[1,1,2,1,1]],Reverse@IndexPair[ind,der]],Reverse/@IndexPair/@IndexList[inds]],{1,1,2,1,1}]];
(* Prefix notation *)
MakeBoxesCovD[der_[inds__][MBexpr_],"Prefix"]:=Block[{$WarningFrom="CovD Formatting"},
FlattenRowBox@RowBox[{SubsuperscriptBox[Last@SymbolOfCovD@der,#1,#2]&@@SSSBinds[{inds}],MBexpr}]];

The function FlattenRowBox simply removes one level of RowBox:

FlattenRowBox[RowBox[{box1_,RowBox[{boxes___}]}]]:=RowBox[{box1,boxes}];
FlattenRowBox[expr_]:=expr;

Note that MakeBoxesCovD returns a box-expression, but Makeboxes returns an InterpretationBox expression. That is why there is the First@MakeBoxes in the first definition: we want to get the box out of the interpretation-box.

Teake's code (deactivated and not initialized) to typeset with parentheses the covariant derivative of a product, if the Leibnitz expansion is deactivated:

MakeBoxes[covd_Symbol?HeldCovDQ[inds__][expr_Times],StandardForm]:=Block[{$WarningFrom="CovD Formatting"},xAct`xTensor`Private`interpretbox[covd[inds][expr],xAct`xTensor`Private`MakeBoxesCovD[Unevaluated[covd][inds][xAct`xTensor`Private`boxof[RowBox[{StyleBox["("],MakeBoxes[expr,StandardForm],StyleBox[")"]}]]],(*Always prefix notation.Postfix doesn't make sense on products.*)"Prefix"]]];

BeginExamples[]

RowBox[{SubscriptBox[ColorString["▽",Hue[0]],ColorString["a",Hue[0.6]]]}]//DisplayForm

DefManifold[M2,2,{A,B,C,D,F,G}]

DefTensor[T[A,B,C],M2]

CovDQ[Cd]^=True;
SymbolOfCovD[Cd]^={";","∂"};

$CovDFormat="Postfix";

T[A,B]

ToBoxes[%]

First[First[%]]

Cd[-D][T[A,B]]

Cd[F][Cd[-D][T[A,B]]]

%//ToBoxes

Cd[-F][Cd[-D][T[A,B]]]

BasisQ[polar]^=True;
xAct`xCoba`BasisColor[polar]^=RGBColor[0,0,1];

Cd[{F,polar}][Cd[-D][T[A,B]]]

%//ToBoxes

Cd[{-F,-polar}][Cd[-D][T[A,B]]]

Cd[Dir[T[Z]]][T[A,B]]

%//ToBoxes

Cd[Dir[T[-A]]][T[A,B]]

$CovDFormat="Prefix";

Cd[-F][Cd[-D][T[A,B]]]

SymbolOfCovD[Cd]^={";","▽"};

Cd[F][Cd[-D][T[A,B]]]

Cd[Dir[T[Z]]][Cd[Dir[T[-Z]]][T[A,B]]]

ToBoxes[%]

Multiple-index derivative:

$CovDFormat="Prefix";

Cd[-F][Cd[-A,-B,-C][T[C,D]]]

$CovDFormat="Postfix";

Cd[-F][Cd[-A,B,-C][T[C,D]]]

CovDQ[Cd]^=False;
SymbolOfCovD[Cd]^=Null;
UndefTensor[T]

DefTensor[T[A,B,C],M2]

CovDQ[Cd]^=True;
SymbolOfCovD[Cd]^={ColorString["¸",Hue[0]],ColorString["▽",Hue[0]]};

$CovDFormat="Prefix";

Cd[F][Cd[-D][T[A,B]]]

Cd[{F,polar}][Cd[{-D,-polar}][T[A,B]]]

%//ToBoxes

%%//InputForm

$CovDFormat="Postfix";

Cd[-G][Cd[F][Cd[-D][T[A,B]]]]

Cd[{-F,-polar}][Cd[{D,polar}][T[A,-B]]]

Cd[{-F,-polar}][Cd[{D,polar}][T[A$101,-B]]]

Remove[polar]
CovDQ[Cd]^=False;
SymbolOfCovD[Cd]^=Null;
UndefTensor[T]
Remove[Cd];

UndefManifold[M2]

Remove[A$101,Z]

EndExamples[]

11.5. Examples

BeginExamples[]

DefManifold[M2,2,{A,B,C,D,F,G}]

DefManifold[S2,2,{a,b,c,d,e,f,g}]

DefTensor[r[],M2]
DefTensor[s[],S2]

Covariant derivative not associated to any metric:

DefCovD[CDT[-A],{"|","∂"},Torsion->True,Curvature->False]

?CDT

UndefCovD[CDT]

DefCovD[CDT[-A],{"|","∂"},Torsion->True]

Covariant derivative not associated to any metric:

DefCovD[CDM[-A],{"|","∂"}]

ChangeCurvature[RiemannCDM[-A,-B,-C,D],CDM]//ScreenDollarIndices

Covariant derivative associated to a metric g. Note that because the manifold has dimension 2 the Einstein and Weyl tensors vanish:

DefTensor[metricg[-A,-B],M2,PrintAs->"g"]
Unprotect[TangentM2,metricg];
MetricsOfVBundle[TangentM2]^={metricg};
MetricQ[metricg]^=True;
xATP`FrozenMetricQ[metricg]^=False;
InducedFrom[metricg]^=Null;
Protect[TangentM2,metricg];

DefCovD[CDN[-A],{"#","▽"},FromMetric->metricg]

EinsteinCDN[A,B]

WeylCDN[A,B,C,D]

RiemannCDN[-A,-B,A,-C]//ScreenDollarIndices

RiemannCDN[A,B,-A,-B]//ScreenDollarIndices

xATP`RicciToEinsteinRules[CDN]

xATP`RiemannToWeylRules[CDN]

RicciCDN[-A,-B]//RicciToEinstein

Note that xTensor detects that the index of the derivative does not belong to the manifold of the metric:

DefCovD[CCD[-p],{"#","▽"},FromMetric->metricg]

Remove[CCD,p]

DefCovD[Com[-A],{"%","∂"},Curvature->False]

DefCovD[CDS[-a],{":","▽"}]

The issue of commutativity of derivatives. Is it working? What happens here with s[]?

CDM[-B][r[C]+s[]]

CDM[-A][%]

%/.CDM->Com

SortCovDs[%]

CheckZeroDerivative[%]

More general:

DefTensor[T[A,-B],M2]

CDT[-A][CDT[-B][T[]]]//ScreenDollarIndices

CDT[-A][CDT[-B][T[-C,D]]]//SortCovDs//ScreenDollarIndices

CDT[-C][CDT[-D][T[A]]]-CDT[-D][CDT[-C][T[A]]]//SortCovDs//ScreenDollarIndices

$CovDFormat="Postfix";

CDM[-A][CDM[-B][T[C,-D]]]

Note that the first index cannot be reversed because it is upstairs:

PD[A][PD[-A][PD[-C][T[C]]]]

PD[-A][PD[-a][PD[-c][T[C]]]]

CDM[-C][Cos[Sin[r[]]^2]]

DefScalarFunction[ff]

CDM[-C][ff[r[],r[]^2,T[]]]

UndefScalarFunction[ff]

CDM[-C][CDM[-A][CDM[-B][r[]]]]-CDM[-C][CDM[-B][CDM[-A][r[]]]]

CDS[-a][T[A]]

CheckZeroDerivative[%]

CheckZeroDerivativeStart[CDS]

CDS[-a][T[A]]

CheckZeroDerivativeStop[CDS]

CDS[-a][T[A]]

CDM[-A][CDM[-B][T[-C,-D]]]

SortCovDs[CDM[-A][CDM[-B][T[-C,-D]]],CDM]//ScreenDollarIndices

CDM[-A][CDM[-B][CDM[-C][T[-D,-F]]]]//SortCovDs//ScreenDollarIndices

RiemannToChristoffel[SortCovDs[CDM[-A][CDM[-B][T[-C,-D]]],CDM],CDM]//ScreenDollarIndices

DefTensor[S[-a],S2]

CDN[-A][S[-a]]

CheckZeroDerivative[%]

$Tensors

DefTensor[v[A],M2]

TracePrint[xATP`ValidateCovD[CDN[-A][T[A,-B]+T[A,-B]]],xATP`UncatchedValidate[_]]

DefTensor[u[A],M2]

The messages here are spurious, due to the fact the ContractMetric has not been defined yet, and so ContractMetric[0] and 0 are not recognized as equal.

Catch@DefCovD[cd[-A],{"*","D"},OrthogonalTo->{u[A]}]

UndefCovD/@{cd,CDT,CDN};

Unprotect[TangentM2];
MetricsOfVBundle[TangentM2]^={};
Protect[TangentM2];

Unprotect[metricg];
MetricQ[metricg]^=False;
UndefTensor[metricg]

UndefTensor/@{S,u,v,s,T,r};

$CovDs

DefConstantSymbol[Mass]

PD[-A][3Mass]

CDM[-A][5+Mass]

UndefConstantSymbol[Mass]

DefTensor[T[A,B,c],{M2,S2}]

ChangeCovD[CDM[-C][T[-A,B]],CDM]//ScreenDollarIndices

ChangeCovD[CDM[A][T[]]CDM[-A][T[B]],CDM]//ScreenDollarIndices

ChangeCovD[CDM[A][T[]]CDM[-A][T[B]],CDM,Com]//ScreenDollarIndices

ChangeCovD[CDM[-C][CDM[-A][T[B]]],CDM]//ScreenDollarIndices

ChangeCovD[CDM[-C][T[-A,A]],CDM]//ScreenDollarIndices

ChangeCovD[CDS[-b][CDM[-C][T[-A,a]]],CDM]//ScreenDollarIndices

CheckZeroDerivative[%]

CDS[-b][CDM[-C][T[-A,a]]]//ChangeCovD//ScreenDollarIndices

CheckZeroDerivative[%]

Christoffel[PD,PD][A,-B,-C]

Christoffel[CDM,PD][A,-B,-C]

Christoffel[PD,CDM][A,-B,-C]

Christoffel[CDM,Com][A,-B,-C]

Christoffel[Com,CDM][A,-B,-C]

?ChristoffelCDMCom

BreakChristoffel[ChristoffelCDMCom[A,-B,-C],ChristoffelCDMCom,PD]

BreakChristoffel[ChristoffelCDMCom[A,-B,-C],ChristoffelCDMCom]

BreakChristoffel[ChristoffelCDM[A,-B,-C],ChristoffelCDM,Com]

DefCovD[CDT[-A],{";","D"},Torsion->True]

TorsionCDT[A,-B,-C]//ChangeTorsion

ChangeTorsion[TorsionCDT[A,-B,-C],CDT]

ChangeTorsion[TorsionCDT[A,-B,-C],CDT,Com]

RiemannCDT[-A,-B,-C,D]//ChangeCurvature//ScreenDollarIndices

RicciCDT[-A,-B]//ChangeCurvature//ScreenDollarIndices

ChangeCurvature[RicciCDT[-A,-B],CDT]//ScreenDollarIndices

If we need "metrics":

BasisQ[polar]^=True;
xAct`xCoba`VBundleOfBasis[polar]^=TangentM2;
xAct`xCoba`BasisColor[polar]^=RGBColor[0,0,1];

ChangeCurvature[RiemannCDT[{-A,-polar},{-B,-polar},{C,polar},{D,polar}],CDT,CDM]//ScreenDollarIndices

xATP`$Christoffels//ColumnForm

UndefCovD[CDT]

xATP`$Christoffels//ColumnForm

UndefCovD[Com]
UndefCovD[CDM]
UndefCovD[CDS]
UndefTensor[T];

xATP`$Christoffels

Remove[polar]

$CovDs

$Tensors

UndefManifold[M2]

UndefManifold[S2]

EndExamples[]

11.6. OverDot derivative

We need a generic derivative with respect to a parameter. We will use OverDot. OverDot of an expression is never zero unless explicitly stated.

Unprotect[OverDot];
(* Nest high-order derivatives *)
HoldPattern[OverDot[expr_,1]]:=OverDot[expr];
OverDot[expr_,n_Integer?Positive]:=OverDot[OverDot[expr,n-1]];
(* Derivative properties *)
OverDot[expr_Plus]:=OverDot/@expr;
OverDot[expr_SeriesData]:=SeriesDataMap[OverDot,expr];
OverDot[x_ y_]:=OverDot[x]y+x OverDot[y];
OverDot[x_?ConstantQ]:=0;
(* Scalar functions *)
OverDot[f_?ScalarFunctionQ[args___]]:=multiD[OverDot,f[args]];
(* No need to replace dummies internally *)
OverDot[Scalar[expr_]]:=Scalar[OverDot[expr]];
(* Listability *)
OverDot[list_List]:=Map[OverDot,list];

We assume that it commutes with partial derivatives, but only for covariant-index derivatives. Note that the generalization to the directional case contains two terms:

OverDot[PD[-ind_][expr_]]:=PD[-ind][OverDot[expr]]
OverDot[PD[Dir[v_]][expr_]]:=PD[Dir[v]][OverDot[expr]]+PD[Dir[OverDot[v]]][expr]

SetNumberOfArguments[OverDot,{1,2}];
Protect[OverDot];

QUESTION: It is not clear how to expand the time-derivative of a tensor (not a derivative) with a directional slot.

QUESTION: What about Lie derivatives? And brackets?

QUESTION: As pointed out by David Yllanes, the formatting of OverDot is quite bad, because it places the dot over the whole tensor, and not over its head.

BeginExamples[]

DefManifold[M2,2,{A,B,C,D,F,G}]

DefTensor[r[],M2]

OverDot[r[]^2]

OverDot[PD[-A][r[]^3]]

PD[-A][r[]^3]

OverDot[%]

%//FullForm

DefTensor[T[A,B],M2]

OverDot[Exp[T[A,B]T[-A,-B]]]

OverDot[Log[T[A,B]T[-A,-B]]]

%//ScreenDollarIndices

UndefTensor/@{r,T};

UndefManifold[M2]

EndExamples[]

11.7. ParamD

11.7.1. Definitions

Parameter derivatives commute by definition:

ParamD[][expr_]:=expr;
(* Unnest parametric derivatives, contrary to OverDot. Sort parameters, always assumed to commute *)
ParamD[p1__][ParamD[p2__][expr_]]:=(ParamD@@Sort[{p1,p2}])[expr]
(* Properties of a derivative *)
ParamD[p__][expr_Plus]:=ParamD[p]/@expr;
ParamD[p__][expr_SeriesData]:=SeriesDataMap[ParamD[p],expr];
ParamD[p___,p1_][x_ y_]:=ParamD[p][ParamD[p1][x]y+x ParamD[p1][y]];
ParamD[p___,p1_][p1_]:=ParamD[p][1];
ParamD[p__][_?ConstantQ]:=0;
ParamD[p__][expr_]:=0/;FreeQ[ParametersOf[expr],Alternatives[p,AnyDependencies]];
(* Scalar functions: sequentially apply chain rule *)
ParamD[p___,p1_][f_?ScalarFunctionQ[args___]]:=ParamD[p][multiD[ParamD[p1],f[args]]];
(* On Scalar. No need to replace internal dummies *)
ParamD[p__][Scalar[expr_]]:=Scalar[ParamD[p][expr]];
(* Listability *)
ParamD[p__][list_List]:=Map[ParamD[p],list];

QUESTION: Again, what about directions, Lie ders and brackets?

11.7.2. Formatting

Code copied from Leo's email in the group on 22 June 2011:

MakeBoxes[expr:(ParamD[ps__][expr_]),form_]:=interpretbox[expr,MakeBoxesParamD[ps][MakeBoxes[expr,form],form]];

MakeBoxesParamD[][boxes_,form_]:=boxes;
MakeBoxesParamD[rest___,p_][boxes_,form_]:=MakeBoxesParamD[rest][FlattenRowBox@RowBox[{SubscriptBox["∂",PrintAs[p]],boxes}],form];

SymbolOfCovD[ParamD]^={",","∂"};

$ParamDFormat="Prefix";
xTensorFormStart[ParamD]:=
(MakeBoxes[ParamD[ps__][expr_],StandardForm]:=Block[{$WarningFrom="ParamD Formatting"},interpretbox[ParamD[ps][expr],MakeBoxesParamD[{ps},boxof@MakeBoxes[expr,StandardForm],$ParamDFormat,StandardForm]]]
);
xTensorFormStop[ParamD]:=(
MakeBoxes[ParamD[ps__][expr_],StandardForm]=.
);
xTensorFormStart[ParamD];

(* Postfix notation *)
MakeBoxesParamD[pslist_List,SubsuperscriptBox[head_,downstr_,upstr_],"Postfix",StandardForm]:=Block[{$WarningFrom="ParamD Formatting"},SubsuperscriptBox[head,#1,#2]&@@AddIndex[{downstr,upstr},Minus/@IndexList@@pslist,ParamD]];
MakeBoxesParamD[pslist_List,gridbox_GridBox,"Postfix",StandardForm]:=Block[{$WarningFrom="ParamD Formatting"},
ReplacePart[gridbox,AppendIndexPair[AppendIndexPair[gridbox[[1,1,2,1,1]],{"",First@SymbolOfCovD[ParamD]}],IndexPair/@IndexList@@pslist],{1,1,2,1,1}]];
MakeBoxesParamD[pslist_List,boxes_,"Postfix",StandardForm]:=Block[{$WarningFrom="ParamD Formatting"},SubscriptBox[boxes,StringJoin[First@SymbolOfCovD[ParamD],Sequence@@(PrintAs/@pslist)]]];
(* SinglePrefix notation *)
MakeBoxesParamD[pslist_List,boxes_,"SinglePrefix",StandardForm]:=Block[{$WarningFrom="ParamD Formatting"},RowBox[{SubscriptBox[Last@SymbolOfCovD[ParamD],StringJoin@@(PrintAs/@pslist)],boxes}]];
(* Prefix notation *)
MakeBoxesParamD[{},boxes_,"Prefix",StandardForm]:=boxes;
MakeBoxesParamD[{rest___,p_},boxes_,"Prefix",StandardForm]:=Block[{$WarningFrom="ParamD Formatting"},MakeBoxesParamD[{rest},FlattenRowBox@RowBox[{SubscriptBox[Last@SymbolOfCovD[ParamD],PrintAs[p]],boxes}],"Prefix",StandardForm]];

11.7.3. Examples

BeginExamples[]

DefParameter[time]

DefParameter[space]

?time

DefManifold[M2,2,{A,B,C,D,F,G}]

DefTensor[v[A],{M2,time}]

DefTensor[w[A],{M2,space}]

ParamD[time][2v[A]]

ParamD[space][4v[A]+3w[A]]

ParamD[time,space][v[A]w[-A]]

Catch@UndefParameter[time]

UndefTensor[v]
UndefTensor[w]

VisitorsOf[time]

UndefParameter[time]
UndefParameter[space]

UndefManifold[M2]

?M2

EndExamples[]

12. Lie derivatives and brackets

(******************* 12.Lie derivatives and brackets ******************)

{TimeUsed[],SessionTime[],TimeUsed[]/SessionTime[]}

12.0. Comments

If[$ReadingVerbose,Print["Reading section 12: Lie derivatives."],Null,Null]

12.1. Definition

?LieD

There are two forms of a Lie derivative: a formal derivative and a computing function in terms of a connection.

1) Properties of a Lie derivative

(* Properties of a derivative *)
LieD[v_][expr_Plus]:=LieD[v]/@expr;
LieD[v_][expr_SeriesData]:=SeriesDataMap[LieD[v],expr];
LieD[v_][expr1_ expr2_]:=LieD[v][expr1]expr2+expr1 LieD[v][expr2];
LieD[v_][_?ConstantQ]:=0;
LieD[v_][f_?ScalarFunctionQ[args___]]:=multiD[LieD[v],f[args]];
(* On Scalar. No need to replace internal dummies *)
LieD[v_][Scalar[expr_]]:=Scalar[LieD[v][expr]];
(* Listability *)
LieD[v_][list_List]:=Map[LieD[v],list];
(* Vector field argument. Not tensorial! Just linear *)
LieD[v_Plus][expr_]:=LieD[#][expr]&/@v;
LieD[v_SeriesData][expr_]:=SeriesDataMap[LieD[#][expr]&,v];
LieD[(x_?ConstantQ)v_][expr_]:=x LieD[v][expr];
LieD[0][expr_]:=0;
(* Two special useful cases *)
LieD[v_?xTensorQ[_Symbol]][v_[_Symbol]]:=0;
LieD/:v_?xTensorQ[i_Symbol]LieD[v_[_Symbol]][expr_]:=0/;HasOrthogonalIndexQ[expr,v[i]];

2) If a second argument is supplied then the Lie derivative is expanded. QUESTION: Is it correct for the density case? Somehow the result should depend on the basis associated to the density, and not only to the metric of the Levi-Civita connection. I'm not even sure whether the Lie derivative must see the density character of an expression... QUESTION: And what happens with basis indices? Currently we are only expanding abstract indices, through the use of vb`Q functions.

Note of 18 Mar 2011: for the case of weighted tensors, we now replace (where metric is the LeviCivita of covd).

1/2 expr metric[i1,i2]LieD[vector,covd][metric[-i1,-i2]]

by the simplest form

covd[-i1][vector/.indv->i1]

Note of 22 Aug 2015: Alfonso has added previously-missing torsion terms.

LieD[vector_,covd_][f_?ScalarFunctionQ[args___]]:=multiD[LieD[vector,covd],f[args]];
LieD[vector_,covd_][Scalar[expr_]]:=Scalar[LieD[vector,covd][expr]];
LieD[vector_,covd_][expr_]:=ExpandLieD[ReplaceDummies[vector],covd,False,Identity1][expr];
ExpandLieD[vector_,covd_,dirQ_,tmpcovdhead_][expr_]:=
Expand[tmpcovdhead[ If[dirQ,Identity,SeparateDir][covd[Dir[vector]][expr]],LieD ]+lieDcovDdiff[expr,ReplaceDummies[vector],covd,VBundleOfIndex@UltraindexOf[vector],Identity]
];
CovDToLieD[covd_[Dir[vector_]][expr_],tmpchrhead_]:=LieD[vector][expr]-lieDcovDdiff[expr,ReplaceDummies[vector],covd,VBundleOfIndex[Dir[vector]],tmpchrhead];
lieDcovDdiff[expr_,vector_,covd_,vb_,tmpchrhead_]:=With[{indv=UltraindexOf[vector],vbQ=VBundleIndexQ[vb],inds=FindFreeIndices[expr],dummy=DummyIn[vb],dummy2=DummyIn[vb]},

(* Checks *)
If[!CovDQ[covd],Throw[Message[LieD::unknown,"derivative",covd];ERROR[LieD[vector,covd][expr]]]];
ValidateDir[Dir[vector]];
If[covd=!=PD&&ManifoldOfCovD[covd]=!=BaseOfVBundle[vb],Throw[Message[LieD::error,"Invalid derivative in Lie Derivative."];ERROR[LieD[vector,covd][expr]]]];

(* CovDTODO *)
(* Additional terms *)
With[{torsion=Torsion[covd],newv=If[TorsionQ[covd],ReplaceIndex[vector,indv->dummy2],0]},
Expand[
Plus@@Map[(tmpchrhead[covd[-#][ReplaceIndex[vector,indv->dummy]]]+$TorsionSign newv torsion[dummy,-dummy2,-#])ReplaceIndex[expr,-#->-dummy]&,Select[ChangeIndex/@inds,vbQ] ]-Plus@@Map[(tmpchrhead[covd[-dummy][ReplaceIndex[vector,indv->#]]]+$TorsionSign newv torsion[#,-dummy2,-dummy])ReplaceIndex[expr,#->dummy]&,Select[inds,vbQ] ]+
If[WeightedCovDQ[covd],
With[{weight=WeightOf[expr,WeightedWithBasis[covd]]},
If[weight=!=0,weight expr covd[-indv][vector],0]
],
0
]
]
]
];
(* Messages *)
LieD[_][]:=Throw@Message[LieD::argx,LieD,0]
LieD[][_,x__]:=Throw@Message[LieD::argx,LieD,1+Length[{x}]]
LieD[][_]:=Throw@Message[LieD::error,"There is no contravariant vector"]
LieD[_,_,__][_]:=Throw@Message[LieD::error,"Too many arguments for LieD."]
Protect[LieD];

The function LieDToCovD converts from the former to the latter:

?LieDToCovD

LieDToCovD[expr_,covd_:PD]:=expr//.LieD[vector_]:>LieD[vector,covd];
SetNumberOfArguments[LieDToCovD,{1,2}];
Protect[LieDToCovD];

DirCovDToLieD[expr_,vector_]:=expr/.(rest_. vector[a_]covd_?CovDQ[-a_][expr1_]|rest_. vector[-a_]covd_?CovDQ[a_][expr1_]|rest_. covd_?CovDQ[Dir[vector[a_]]][expr1_]):>rest CovDToLieD[covd[Dir[vector[a]]][expr1],Identity];
SetNumberOfArguments[DirCovDToLieD,2];
Protect[DirCovDToLieD];

12.2. Validation

SetAttributes[ValidateLieD,HoldFirst];
ValidateLieD[x:LieD[v_][expr_]]:=Catch[
ValidateDir[Dir[v]];
UncatchedValidate[Unevaluated[expr]];
x
];
Protect[ValidateLieD];

12.3. Formatting

Formatting of a Lie derivative in prefix form. There is no postfix formatting.

PrefixFormatDer[LieD[v_?HeldxTensorQ[i_]]]:=SubscriptBox["ℒ",PrintAs[v]];
PrefixFormatDer[LieD[v_?HeldxTensorQ[label_LI,i_]]]:=SubscriptBox["ℒ",boxof@MakeBoxes[v[label],StandardForm]];
PrefixFormatDer[LieD[v_]]:=SubscriptBox["ℒ",boxof@MakeBoxes[Short[v],StandardForm]];

xTensorFormStart[LieD]:=(MakeBoxes[LieD[v_][expr_],StandardForm]:=interpretbox[LieD[v][expr],RowBox[{PrefixFormatDer[LieD[v]],boxof@MakeBoxes[expr,StandardForm]}]]);
xTensorFormStop[LieD]:=(MakeBoxes[LieD[v_][expr_],StandardForm]=.);
xTensorFormStart[LieD];

xTensorFormStart[LieD]:=(
MakeBoxes[LieD[v_?HeldxTensorQ[i_]][expr_],StandardForm]:=interpretbox[LieD[v[i]][expr],RowBox[{SubscriptBox["ℒ",PrintAs[v]],boxof@MakeBoxes[expr,StandardForm]}]];
MakeBoxes[LieD[v_?HeldxTensorQ[label_LI,i_]][expr_],StandardForm]:=interpretbox[LieD[v[label,i]][expr],RowBox[{SubscriptBox["ℒ",boxof@MakeBoxes[v[label],StandardForm]],boxof@MakeBoxes[expr,StandardForm]}]];
MakeBoxes[LieD[v_][expr_],StandardForm]:=interpretbox[LieD[v][expr],RowBox[{SubscriptBox["ℒ",boxof@MakeBoxes[Short[v],StandardForm]],boxof@MakeBoxes[expr,StandardForm]}]];
);
xTensorFormStop[LieD]:=(
MakeBoxes[LieD[v_?HeldxTensorQ[i_]][expr_],StandardForm]=.;
MakeBoxes[LieD[v_?HeldxTensorQ[label_LI,i_]][expr_],StandardForm]=.;
MakeBoxes[LieD[v_][expr_],StandardForm]=.;
)
xTensorFormStart[LieD]

12.4. Examples

BeginExamples[]

DefManifold[M2,2,{A,B,C,D,F,G}]

DefTensor[T[A,B],M2]

DefTensor[xi[-A],{M2},GenSet[],PrintAs->"ξ"]

?xi

DefCovD[CDM[-A],{"|","▽"}]

LieD[xi[A]][T[A,B]xi[-A]]

LieD[xi[A],PD][CDM[-D][T[B,-C]]]//ScreenDollarIndices

LieDToCovD[LieD[xi[A]][CDM[-D][T[B,-C]]],CDM]//ScreenDollarIndices

LieD[xi[A]][CDM[-D][T[B,-C]]T[C,D]]

LieD[xi[A]][LieD[xi[A]][CDM[-D][T[B,-C]]T[C,D]]]

xATP`ValidateLieD[LieD[T[A,B]xi[-B]][CDM[-D][T[B,-C]]]]

LieD[T[A,B]xi[-B]][CDM[-D][T[B,-C]]T[C,D]]

DefConstantSymbol[Mass]

LieD[xi[A]][3+Mass]

We can use any kind of indices in the vector argument because they are isolated from the indices of the differentiated expression:

LieD[T[B,A]xi[-A]][RicciCDM[-A,-B]]

%//LieDToCovD

%//ScreenDollarIndices

UndefConstantSymbol[Mass]

UndefCovD[CDM]

UndefTensor/@{T,xi};

UndefManifold[M2]

EndExamples[]

12.5. Lie brackets

Properties as a tensor:

xTensorQ[Bracket[v1_,v2_]]^:=True;
SlotsOfTensor[Bracket[v1_,v2_]]^:={VBundleOfIndex[First@FindFreeIndices[v1]]};
SymmetryGroupOfTensor[Bracket[v1_,v2_]]^:=StrongGenSet[{},GenSet[]];
DependenciesOfTensor[Bracket[v1_,v2_]]^:=Union[DependenciesOf[v1],DependenciesOf[v2]];
WeightOfTensor[Bracket[v1_,v2_]]^:=WeightOf[v1]+WeightOf[v2];
Dagger[Bracket[v1_,v2_]]^:=Bracket[Dagger[v1],Dagger[v2]];

Recall that UltraindexOf returns either the (abstract) ultraindex or None or throws an error.

SetAttributes[ValidateBracket,HoldFirst];
ValidateBracket[x:Bracket[v1_,v2_][i_]]:=Catch@Module[{
vb=VBundleOfIndex[i],
i1=UltraindexOf[v1],
i2=UltraindexOf[v2]},
If[DownIndexQ[i1]||DownIndexQ[i2],Throw[Message[Validate::error,"Indices in the vectors of Bracket must be all contravariant"];ERROR[x]]];
If[VBundleOfIndex[i1]=!=VBundleOfIndex[i2],Throw[Message[Validate::error,"Vectors in Bracket belong to different manifolds"];ERROR[x]]];
If[VBundleOfIndex[i1]=!=vb,Throw[Message[Validate::error,"Index in Bracket is incompatible with indices of vectors"];ERROR[x]]];
ValidateDir[Dir[v1]];
ValidateDir[Dir[v2]];
x
];
ValidateBracket[0]:=0;

Antisymmetry:

Bracket[v_,v_]:=Zero;

Bilinearity of Bracket:

Bracket[0,v2_]:=Zero;
Bracket[v1_,0]:=Zero;
Bracket[v1_Plus,v2_][a__]:=Bracket[#,v2][a]&/@v1;
Bracket[v1_SeriesData,v2_][a__]:=SeriesDataMap[Bracket[#,v2][a]&,v1];
Bracket[v1_,v2_Plus][a__]:=Bracket[v1,#][a]&/@v2;
Bracket[v1_,v2_SeriesData][a__]:=SeriesDataMap[Bracket[v1,#][a]&,v2];
Bracket[c_?ConstantQ v1_,v2_][a__]:=c Bracket[v1,v2][a];
Bracket[v1_,c_?ConstantQ v2_][a__]:=c Bracket[v1,v2][a];

Derivations:

Bracket[s_?ScalarQ v1_,v2_][a_]:=With[{rs=ReplaceDummies[s]},
rs Bracket[v1,v2][a]-PD[Dir[v2]][rs]ReplaceIndex[v1,UltraindexOf[v1]->a]
];
Bracket[v1_,s_?ScalarQ v2_][a_]:=With[{rs=ReplaceDummies[s]},
rs Bracket[v1,v2][a]+PD[Dir[v1]][rs]ReplaceIndex[v2,UltraindexOf[v2]->a]
];

Brackets to covariant derivatives. We need to worry about different manifolds:

BracketToCovD[expr_,covd_:PD]:=expr/.Bracket[v1_,v2_][a_]:>With[{u1=UltraindexOf[v1],u2=UltraindexOf[v2]},With[{b=DummyAs[u1],c=DummyAs[u2],rv1=ReplaceDummies[v1],rv2=ReplaceDummies[v2]},
ReplaceIndex[rv1,u1->b]covd[-b][ReplaceIndex[rv2,u2->a]]-ReplaceIndex[rv2,u2->b]covd[-b][ReplaceIndex[rv1,u1->a]]-$TorsionSign Torsion[covd][a,-b,-c]ReplaceIndex[rv1,u1->b]ReplaceIndex[rv2,u2->c]
]
];

BeginExamples[]

DefManifold[M2,2,{A,B,C,D,F,G}]

DefTensor[v[A],M2]
DefTensor[w[A],M2]
DefTensor[T[A,B],M2]

Bracket[-3v[A]+w[A],4w[A]][A]

xATP`ValidateBracket[Evaluate[%[[2]]]]

Bracket[0,v[A]][A]

EndExamples[]

Formatting:

PrintAs[Bracket[v1_,v2_]]^:=Block[{$WarningFrom="Bracket Formatting"},RowBox[{"[",boxof@MakeBoxes[v1,StandardForm],",",boxof@MakeBoxes[v2,StandardForm],"]"}]
];

BeginExamples[]

Bracket[T[A,B]v[-B],w[A]][-A]

Bracket[T[]v[A],w[A]][A]

Bracket[T[]v[A],T[]w[A]][A]

DefCovD[CD[-A],{";","D"},Torsion->True]

BracketToCovD[Bracket[v[A],w[A]][A]]//ScreenDollarIndices

BracketToCovD[Bracket[v[A],w[A]][A],CD]//ScreenDollarIndices

UndefCovD[CD]

EndExamples[]

Implement skewsymmetry:

Bracket[expr1_,expr2_][i_]:=-Bracket[expr2,expr1][i]/;OrderedQ[{expr2,expr1}]

BeginExamples[]

Bracket[v[A],w[A]][A]+Bracket[w[A],v[A]][A]

UndefTensor/@$Tensors;

UndefManifold[M2]

EndExamples[]

QUESTION: Can we implement the Jacobi identity?

12.6. PullBack and PushForward

12.6.1 PullBack

A pullback under ϕ : M->N is a combined operation: a precomposition (to change dependencies from N to M) and then a linear transformation using the transpose of dϕ. The result is a tensor with different dependencies and with different indices (the new indices are starred if and only if the original indices are starred). We require from the user to specify explicitly the change of free indices, but not for dummies. There should be a default, because that is problematic for Dir-type arguments (ultraindices).

PullBack[expr_Plus,phi_,firules_]:=PullBack[#,phi,firules]&/@expr;
PullBack[expr_,phi_,firules_]:=
With[{dom=MappingDomain[phi],im=MappingImage[phi],fdindices=FindFreeAndDummyIndices[expr]},
With[{allirules=PBIndexRules[fdindices,firules,Tangent[dom],Tangent[im]]},
Apply[Times,PullBack1[#,phi,allirules]&/@ListOfFactors[expr]]
]
];

This could be made safer by using DuplicateRule and Replace only. TODO: check invertibility for the lower indices.

PullBack1[tensor_?xTensorQ[inds___],phi_,allirules_List]:=With[{newinds=ReplaceIndexList[IndexList[inds],allirules]},
If[newinds===IndexList[inds],tensor[inds],PullBackTensor[tensor,phi]@@newinds]
];
(* TODO: What happens if covd[_][dphi] is not zero? *)
PullBack1[covd_?CovDQ[inds__][expr_],phi_,allirules_List]:=Apply[PullBackCovD[covd,phi],ReplaceIndexList[IndexList[inds],allirules]][PullBack1[expr,phi,allirules]];
(* TODO: We need something special for the ultraindex *)
PullBack1[LieD[v_][expr_],phi_,allirules_List]:=LieD[PullBack1[v,phi,allirules]][PullBack1[expr,phi,allirules]];
PullBack1[c_?ConstantQ,phi_,allirules_List]:=c;

PullBack::frees="Missing pull-back rules for free indices `1` of tangent bundle `2`.";

PBIndexRules[{frees_IndexList,dummies_IndexList},firules_List,tdom_,tim_]:=With[{timpmQ=VBundleIndexPMQ[tim]},
If[#=!={},Throw[Message[PullBack::frees,#,tim]]]&@Complement[Select[List@@frees,timpmQ],First/@firules];Join[firules,Flatten[{Rule@@#,Rule@@(-#)}&/@({#,DummyIn[tdom]}&/@Select[List@@dummies,timpmQ])]]
];

12.6.2. ExpandPullBack

Expand a PullBackTensor or a PullBackCovD expression into a precomposition contracted with tangent-map factors.

ExpandPullBack[expr_]:=expr/.{
PullBackTensor[tensor_?xTensorQ,phi_?MappingQ][inds___]:>ExpandPullBackTensor[tensor,phi,{inds}],
PullBackCovD[covd_?CovDQ,phi_?MappingQ][ind_][tensor_?xTensorQ[inds___]]:>ExpandPullBackCovD[covd,phi,{ind},tensor,{inds}],
TensorDerivative[Precompose[tensor_?xTensorQ,phi_],PullBackCovD[covd_?CovDQ,phi_?MappingQ]][inds___,ind_]:>ExpandPullBackCovD[covd,phi,{ind},tensor,{inds}]
};

Tensors:

ExpandPullBackTensor[tensor_,phi_,inds_List]:=With[{dphi=TangentTensor[phi],tim=Tangent[MappingImage[phi]]},
With[{ilist=Transpose[pullfactor1[#,dphi,tim,PullBackVBundle[tim,phi]]&/@Transpose[{SlotsOfTensor[tensor],inds}]]},
Precompose[tensor,phi]@@First[ilist]Times@@Last[ilist]
]
];
pullfactor1[{-tim_,ind_?DownIndexQ},dphi_,tim_,ptim_]:=With[{new=DummyIn[ptim]},{-new,dphi[ind,new]}];
pullfactor1[{tim_,ind_?UpIndexQ},dphi_,tim_,ptim_]:=With[{new=DummyIn[ptim]},{new,Inv[dphi][-new,ind]}];
pullfactor1[{_,ind_},dphi_,tim_,ptim_]:={ind,1};

Covariant derivatives:

ExpandPullBackCovD[covd_,phi_,{ind_},tensor_,inds_List]:=With[{dphi=TangentTensor[phi],new=DummyIn[PullBackVBundle[VBundleOfIndex[ind],phi]]},
dphi[ind,new]Precompose[TensorDerivative[tensor,covd],phi]@@Join[inds,{-new}]
];

12.6.3. PushForward

First handle the abstract indices and generalize later.

PushForward[expr_Plus,phi_,firules_]:=PushForward[#,phi,firules]&/@expr;
PushForward[expr_,phi_,firules_]:=
With[{dom=MappingDomain[phi],im=MappingImage[phi],fdindices=FindFreeAndDummyIndices[expr]},
With[{allirules=PFIndexRules[fdindices,firules,Tangent[dom],Tangent[im]]},
Apply[Times,PushForward1[#,phi,allirules]&/@ListOfFactors[expr]]
]
];

This could be made safer by using DuplicateRule and Replace only. TODO: check invertibility for the lower indices.

PushForward1[tensor_?xTensorQ[inds___],phi_,allirules_List]:=With[{newinds=ReplaceIndexList[IndexList[inds],allirules]},
If[newinds===IndexList[inds],tensor[inds],PushForwardTensor[tensor,phi]@@newinds]
];
(* What is the push-forward of a covariant derivative? *)
PushForward1[covd_?CovDQ[inds__][expr_]]:=TODO;
(* TODO: We need something special for the ultraindices *)
PushForward1[LieD[v_][expr_],phi_,allirules_List]:=LieD[PushForward1[v,phi,allirules]][PushForward1[expr,phi,allirules]];
PushForward1[c_?ConstantQ,phi_,allirules_List]:=c;

PushForward::frees="Missing push-forward rules for free indices `1` of tangent bundle `2`.";

PFIndexRules[{frees_IndexList,dummies_IndexList},firules_List,tdom_,tim_]:=With[{tdompmQ=VBundleIndexPMQ[tdom]},
If[#=!={},Throw[Message[PushForward::frees,#,tdom]]]&@Complement[Select[List@@frees,tdompmQ],First/@firules];Join[firules,Flatten[{Rule@@#,Rule@@(-#)}&/@({#,DummyIn[tim]}&/@Select[List@@dummies,tdompmQ])]]
];

12.6.4. ExpandPushForward

This function converts a PushForwardTensor object into a product of the original tensor and a bunch of tangent mappings.

ExpandPushForward[expr_]:=expr/.{
LinearPush[tensor_?xTensorQ,dphi_?xTensorQ][inds___]:>ExpandLinearPush[tensor,dphi,{inds}],
PushForwardTensor[tensor_?xTensorQ,phi_?MappingQ][inds___]:>ExpandPushForwardTensor[tensor,phi,{inds}]
};

Linear push of a tensor:

ExpandLinearPush[tensor_,dphi_,inds_List]:=With[{tdom=-SlotsOfTensor[dphi][[1]]},
With[{ilist=Transpose[pushfactor1[#,dphi,tdom]&/@Transpose[{SlotsOfTensor[tensor],inds}]]},
tensor@@First[ilist]Times@@Last[ilist]
]
];
pushfactor1[{tdom_,ind_?UpIndexQ},dphi_,tdom_]:=With[{new=DummyIn[tdom]},{new,dphi[-new,ind]}];
pushfactor1[{-tdom_,ind_?DownIndexQ},dphi_,tdom_]:=With[{new=DummyIn[tdom]},{-new,Inv[dphi][ind,new]}];
pushfactor1[{_,ind_},dphi_,tdom_]:={ind,1};

Push forward of a tensor field:

ExpandPushForwardTensor[tensor_,phi_,inds_List]:=ExpandPullBackTensor[tensor,InverseMapping[phi],inds];

13. Variational derivatives

(********************** 13.Variational derivatives ********************)

{TimeUsed[],SessionTime[],TimeUsed[]/SessionTime[]}

13.0. Comments

If[$ReadingVerbose,Print["Reading section 13: Variational derivatives."],Null,Null]

13.1. Code

Public function:

ImplicitTensorDepQ[tensor_,tensor_]:=True;
ImplicitTensorDepQ[list_List,tensor_]:=Apply[Or,ImplicitTensorDepQ[#,tensor]&/@list];
(* Default behaviour *)
ImplicitTensorDepQ[tensor1_,tensor2_]:=False;
SetNumberOfArguments[ImplicitTensorDepQ,2];
Protect[ImplicitTensorDepQ];

Currently we only allow variational derivatives of scalar expressions. Other cases seem problematic: for instance, the delta we generate in VarD[ v[a], PD ][ v[b] ] is actually a Kronecker and not a tensor, because VarD[v[a], PD][ v[a] ] is 1 and not dim. We replace initially all dummies and so we will never find such delta[-a, a] case.

Variational derivatives should differentiate functionals, and not their integrands. However, xTensor does not yet have a concept of integration and hence we develop an alternative notation: we work with the derivative which would be compatible with the given volume form.

(* Assume PD derivative *)
VarD[tensor_][expr_]:=VarD[tensor,PD][expr];
(* Generate rest. Replace dummies in expr. This does not act on scalar arguments of functions *)
VarD[tensor_,der_][expr_]:=If[ScalarQ[expr],
VarD[tensor,der][ReplaceDummies[expr],1],
Message[VarD::nouse,"VarD","a non-scalar expression"];
NonScalarVarD[tensor,der][expr]
];
(* Thread over Plus *)
VarD[tensor_,der_][expr_Plus,rest_]:=VarD[tensor,der][#,rest]&/@expr;
VarD[tensor_,der_][expr_SeriesData,rest_]:=SeriesDataMap[VarD[tensor,der][#,rest]&,expr];
(* VarD on products: sum of VarDtake's of elements *)
VarD[tensor_,der_][expr_Times,rest_]:=Sum[VarDtake[tensor,der,rest,List@@expr,count],{count,Length@expr}];
(* VarD element n of a list of factors *)
VarDtake[tensor_,der_,rest_,list_List,n_Integer]:=VarD[tensor,der][list[[n]],Times@@ReplacePart[list,rest,n]];
(* Scalar functions
VarD[tensor_,der_][func_?ScalarFunctionQ[expr_],rest_]:=VarD[tensor,der][ReplaceDummies[expr],func'[expr]rest];
*)
(* Leo suggested the exponent term 
VarD[tensor_,der_][Power[base_,exponent_],rest_]:=VarD[tensor,der][ReplaceDummies[base],exponent Power[base,exponent-1]rest]+VarD[tensor,der][ReplaceDummies[exponent],Power[base,exponent]Log[base]rest];
*)
(* Scalar functions. Multiargument generalization contributed by Leo. multiD is not enough here *)
VarD[tensor_,der_][func_?ScalarFunctionQ[args__],rest_]:=With[{repargs=ReplaceDummies/@{args}},Plus@@MapThread[VarD[tensor,der][#1,rest (Derivative@@#2)@func@@repargs]&,{repargs,IdentityMatrix@Length@repargs}]];
(* Remove Scalar head because in general the result is not a scalar *)
VarD[tensor_,der_][Scalar[expr_],rest_]:=VarD[tensor,der][ReplaceDummies[expr],rest];
(* Constants *)
VarD[tensor_,der_][x_?ConstantQ,rest_]:=0;
(* Same tensor: metric. Do not use ContractMetric, which hides the metric *)
VarD[metric_[a_,b_],der_][metric_Symbol?MetricQ[c_,d_],rest_]:=metricsign[a,b,c,d]ToCanonical[rest(metric[ChangeIndex@a,c]metric[ChangeIndex@b,d]+metric[ChangeIndex@a,d]metric[ChangeIndex@b,c])/2,UseMetricOnVBundle->None];
metricsign[_Symbol,_Symbol,_Symbol,_Symbol]:=1;
metricsign[-_Symbol,-_Symbol,-_Symbol,-_Symbol]:=1;
metricsign[-_Symbol,-_Symbol,_Symbol,_Symbol]:=-1;
metricsign[_Symbol,_Symbol,-_Symbol,-_Symbol]:=-1;
metricsign[_,_,_,_]:=0;
(* Same tensor. Place indices in proper delta positions. QUESTION: could this be problematic for spinors? *)
varddelta[ind1_?UpIndexQ,ind2_?DownIndexQ]:=delta[ind2,ind1];
varddelta[ind1_,ind2_]:=delta[ind1,ind2];
VarD[tensor_[inds1___],der_][tensor_?xTensorQ[inds2___],rest_]:=With[{clist=ChangeIndex/@IndexList[inds1]},
ToCanonical[ImposeSymmetry[Inner[varddelta,clist,IndexList[inds2],Times],clist,SymmetryGroupOfTensor[tensor[inds1]]]rest,UseMetricOnVBundle->None]];
(* A different tensor *)
VarD[tensor1_[inds1___],der_][tensor2_?xTensorQ[inds2___],rest_]:=0/;!ImplicitTensorDepQ[tensor2,tensor1];
(* Same connection: integration by parts *)
VarD[tensor_,covd_][covd_?CovDQ[ind_][expr_],rest_]:=-VarD[tensor,covd][expr,covd[ind][rest]];
(* Different connection: ChangeCovD *)
VarD[tensor_,covd1_?CovDQ][expr:covd2_?CovDQ[_][_],rest_]:=VarD[tensor,covd1][ChangeCovD[expr,covd2,covd1],rest]/;CompatibleCovDsQ[covd1,covd2];
(* Support for parametric derivatives *)
VarD[tensor_,OverDot][OverDot[expr_],rest_]:=-VarD[tensor,OverDot][expr,OverDot[rest]];
VarD[tensor_,ParamD[p_]][ParamD[pl___,p_,pr___][expr_],rest_]:=-VarD[tensor,ParamD[p]][ParamD[pl,pr][expr],ParamD[p][rest]];

An extension for nonscalar objects, that has been requested several times in the group. I'm not sure it is safe, for the reasons stated above. It certainly does not work in those cases in which the differentiation tensor is itself part of a derivative.

NonScalarVarD[tensor_,der_][expr_]:=
With[{inds=ChangeIndex/@FindFreeIndices[expr]},With[{tmp=Tensor["TMP",SignedVBundleOfIndex/@inds,DependenciesOf[expr]]@@inds},IndexCoefficient[VarD[tensor,der][tmp expr],tmp]
]
];

13.2. Examples

See xTensorDoc.nb.

14. Metric. Continue here with general review

(****************************** 14.Metric *****************************)

{TimeUsed[],SessionTime[],TimeUsed[]/SessionTime[]}

14.0. Comments

If[$ReadingVerbose,Print["Reading section 14: Metrics."],Null,Null]

The signature of the metric, and hence the sign of the determinant, are invariants under real transformations (though not under complex transformations), and therefore are defined here in xTensor. The determinant of the metric depends on the chosen basis to define the determinant and hence is defined in xCoba.

It is possible to have metric fields on an inner vbundle, but now their properties are different from those of the metric fields on tangent vbundles (assume external indices a, b, c, ... and inner indices A, B, C, ...):
	- There are compatible connections, in the sense of giving zero on the metric field, but now they are not unique. If the metric is g_AB and a compatible connection is 𝔇_a, so that 𝔇_a g_BC = 0 then we can try to construct 𝔇_a from any other derivative D_a. The relation would be     𝔇_a g_BC = D_a g_BC - A^F_aB g_FC - A^F_aC g_BF = D_a g_BC - A_CaB - A_BaC = 0 . We see that we can get the symmetric part (in the first and third indices) of the "Christoffel" A_BaC, but not its antisymmetric part, which remains free. That means that there are many derivatives 𝔇_a which are compatible with the metric field g_AB . By second differentiation of the metric it is simple to see that the inner curvature tensor is antisymmetric on the second pair of indices when lowering the upper index with any of those compatible metrics. This antisymmetry is not implemented in xTensor.
	- It is possible to have a "complex metric", that is, a metric which gives complex values on artibrary pairs of vectors on a complex vbundle. To ensure "real squares" it seems natural to have a Hermitian metric, with one index on a complex vbundle and the other index on its conjugate vbundle. For example, the metric in Quantum Mechanics is actually a Hermitian metric of the form deltaQM[-adagger, -b]. What we usually call   < x | y >  is really Dagger[ x^a ] deltaQM[ -adagger, b ] y^b . Currently we are assuming in xTensor that we work with a real metric on a real vbundle. 
	- It is not clear that there is a clear notion of curvature for an inner metric field. In the following we shall asume that "metric" means a real symmetric 2-tensor field on a tangent bundle. It is rather restrictive, but I don't know how to generalize it still considering curvature tensors.

14.1. Definition

14.1.1. Definition

1) Metrics can be flat (FlatMetric->True) or not (FlatMetric->False, the default). This is a stupid name: it should be Curvature->False/True. They have an associated derivative (the corresponding Levi-Civita connection), which is flat or not, respectively. It is possible to have torsion as well. If a metric is flat, its torsionless derivative will be what Wald calls an ordinary derivative, but not necessarily PD. If you ask for PD then you must supply the correct symbols for PD. Note that at that moment the generic chart associated to PD would get a meaning: it would be a chart where the components of that flat metric are constants.

QUESTION: Right now we only accept metrics on the tangent vbundle. That is clearly a strong limitation, and needs to be generalized.

2) We introduce an option InducedFrom to define the induced metric on a hypersurface orthogonal to a normal vector. The option must be given as a pair {metric, vector} where vector can be spacelike or timelike with respect to metric, but not null, because its norm is computed to construct the associated projector. Nontrivial definitions associated to induced metrics are given below. The fact that an induced metric is both a projector from the point of view of the original vbundle and a metric from the point of view of the projected vbundle is a problem that must be handled carefully. I'm not sure the current notations are the best option.

Note that the orthogonal vector in the induced case must be a vector, and not a generic vectorial expression. This is typically not a limitation, because this vector is such an important object that it is always named.

3) Metrics which are not the first-metric *and* are not induced from the first-metric are called "frozen metrics". Most of the rules that you expect for a metric do not work. For example if frozen[-a,-b] is a frozen metric then frozen[a,b] is not its inverse because frozen[a,b] is g[a,c] g[b,d] frozen[-c,-d], where g[-a,-b] is the first-metric of the manifold of frozen. The following function assumes that we already know that the tested symbol *is* a metric; otherwise FirstMetricQ will throw an error.

FrozenMetricQ[metric_]:=And[Not@FirstMetricQ[metric],InducedFrom[metric]===Null];

4) Messages:

DefMetric::old="There are already metrics `1` in vbundle `2`.";
DefMetric::inds="Indices `1` and `2` do not belong to the same vector bundle.";
DefMetric::no1smetric="Metrics can only be induced from the first-metric of a vector bundle.";
DefMetric::noicovd="Metrics in inner vbundles do not support covariant derivatives.";

5) Checks at definition time. Note that there is a first DefCovDCheck[covd, covdsymbol, {torsion, curvature, metric, curvrels, ef, wwb}] which send the wrog setting metric=Null to do an initial minimal checking. Later DefCovD will do the full checking.

DefMetricCheck[signdet_,metric_[-ind1_,-ind2_],covd_,covdsymbol_,flat_,inducedfrom_,confto_,odeps_,wwb_,eoib_]:=Module[{vb,supermetric,vector,tangentmetricQ},
(* Indices *)
If[!AbstractIndexQ[ind1],Throw@Message[DefMetric::unknown,"abstract index",ind1]];
If[!AbstractIndexQ[ind2],Throw@Message[DefMetric::unknown,"abstract index",ind2]];
vb=VBundleOfIndex[ind1];
If[vb=!=VBundleOfIndex[ind2],Throw@Message[DefMetric::inds,ind1, ind2]];
tangentmetricQ=SameQ[Tangent[BaseOfVBundle@vb],vb];
(* Metric *)
If[MetricEndowedQ[vb],Message[DefMetric::old,MetricsOfVBundle[vb],vb]];
ValidateSymbol[metric];
ValidateSymbolInSession[metric];
(* Dependencies *)
If[!Or[ManifoldQ[#],ParameterQ[#]],Throw@Message[DefMetric::unknown,"dependency",#]]&/@odeps;
(* Sign Det. A phase Exp[I alpha] is accepted if Abs returns 1 on it *)
Which[
Abs[signdet]===1,Null,
signdet===0,Null,
MatchQ[signdet,{_Integer?NonNegative,_Integer?NonNegative,_Integer?NonNegative}],Null,
True,Throw@Message[DefMetric::invalid,signdet,"signdet of metric"]
];
(* The Levi-Civita covd *)
If[tangentmetricQ,
Which[
!TrueOrFalse[flat],Throw@Message[DefMetric::invalid,flat,"value for option FlatMetric"],
covd===PD &&!flat,Throw@Message[DefMetric::error,"PD can only be associated to a flat metric."],
covd===PD&&flat&&covdsymbol=!=SymbolOfCovD[PD],Message[DefMetric::error,"Using standard "<>ToString[SymbolOfCovD[PD]]<>" as symbols for PD."],
covd===None,Throw@Message[DefMetric::invalid,covd,"covd"],
covd=!=PD,DefCovDCheck[covd,covdsymbol,{False,!flat,Null,False,False,wwb}]
],
If[covd=!=None,
Throw@Message[DefMetric::noicovd];
]
];
(* Induced metric *)
Switch[inducedfrom,
Null,Null,
{_,_},{supermetric,vector}=inducedfrom;
If[!MetricQ[supermetric],Throw@Message[DefMetric::unknown,"metric",supermetric]];If[!FirstMetricQ[supermetric],Throw@Message[DefMetric::no1smetric]];
If[!xTensorQ[vector]||Length[SlotsOfTensor[vector]]=!=1,Throw@Message[DefMetric::unknown,"vector",vector]],
_,Throw@Message[DefMetric::invalid,inducedfrom,"value for option InducedFrom"]
];
(* Conformal relations *)
Switch[confto,
Null,Null,
{_,_},{originalmetric,confactor}=confto;
If[!MetricQ[Head[originalmetric]],Throw@Message[DefMetric::unknown,"conformally related metric ",Head@originalmetric]];
If[!ScalarQ[confactor],Throw@Message[DefMetric::invalid,confactor,"conformal scalar factor"]];
];
(* epsilon orientation in a basis *)
Which[
Head[eoib]=!=List||Length[eoib]=!=2,Throw@Message[DefMetric::invalid,eoib,"value for option epsilonOrientationInMetric"],
!BasisQ[eoib[[1]]],Throw@Message[DefMetric::unknown,"basis",eoib[[1]]],
_,Null
];
]

6) Output of the tensors associated to a metric.

Set[MetricTensorQ[#],True]&/@{epsilon,ExtrinsicK,Acceleration,Projector,Inv,Tetra};
MetricTensorQ[_]=False;

PrintAsCharacter[epsilon]="ϵ";
PrintAsCharacter[ExtrinsicK]="K";
PrintAsCharacter[Acceleration]="A";
PrintAsCharacter[Projector]="P";
PrintAsCharacter[Inv]="i";
PrintAsCharacter[Tetra]="G";

Formatting of tensors associated to a metric follow the general SymbolJoin approach, and not the tensor[covd][inds] notation of covds. Hence we do not need a special GiveOutputString definition for MetricTensorQ objects. There is an exceptional case, though:

(* Exception to general GiveOutputString to have a subscript *)
GiveOutputString[Projector,metric_]:=StringJoin["\!\(",PrintAsCharacter[Projector],"\+",PrintAs[metric],"\)"];

7) Objects associated to a metric field:

LC[metric_?MetricQ]:=GiveSymbol[LC,metric];
epsilon[metric_?MetricQ]:=GiveSymbol[epsilon,metric];
ExtrinsicK[metric_?MetricQ]:=GiveSymbol[ExtrinsicK,metric];
Acceleration[vector_?xTensorQ]:=GiveSymbol[Acceleration,vector];
Projector[metric_?MetricQ]:=GiveSymbol[Projector,metric];
Inv[metric_?MetricQ]:=GiveSymbol[Inv,metric];
Tetra[metric_?MetricQ]:=GiveSymbol[Tetra,metric];

Defaults:

SetDelayed[#[x_],Throw@Message[#::unknown,"metric",x]]&/@{LC,epsilon,Tetra};
SetDelayed[#[x_],Throw@Message[#::unknown,"induced metric",x]]&/@{ExtrinsicK,Projector};
Inv[x_]:=Throw@Message[Inv::unknown,"metric or linear operator",x];
Acceleration[x_]:=Throw@Message[Acceleration::unknown,"metric-orthogonal vector",x];

8) Main. There are a few things concerning induced metrics which are not solved in the following definition. QUESTION. For example the issues of determinants, signatures, etc. Recall that we assume that this is a metric on a tangent bundle. (EINDEX: many hardwired minus signs). Note that we cannot use threading over a list in the first argument here.

(* Backwards compatibility *)
DefMetric[signdet_,metric_,covd_,covdsymbol:{_String,_String},options:OptionsPattern[]]:=DefMetric[signdet,metric,covd,SymbolOfCovD->covdsymbol,options];

Off[RuleDelayed::rhs];
Options[DefMetric]:={
PrintAs->Identity,
FlatMetric->False,
InducedFrom->Null,
ConformalTo->Null,
OtherDependencies->{},
WeightedWithBasis->Null,
epsilonOrientationInBasis:>{AIndex,$epsilonSign},
Master->Null,
ProtectNewSymbol:>$ProtectNewSymbols,
DefInfo->{"",""}}
DefMetric[signdet_,metric_[-ind1_,-ind2_],covd_,options:OptionsPattern[]]:=Catch@With[{
vbundle=VBundleOfIndex[ind1]},

Module[{tangentmetricQ,covdsymbol,flat,inducedfrom,confto,odeps,wwb,eoib,pns,info,flatPD,inducedQ,dim,integerdimQ,frozenQ,firstQ,invertQ,firstmetric,supermetric,vector,LCmetric},

(* Options and checks *)
{covdsymbol,flat,inducedfrom,confto,odeps,wwb,eoib,pns,info}=OptionValue[{DefMetric,DefCovD},{options},{SymbolOfCovD,FlatMetric,InducedFrom,ConformalTo,OtherDependencies,WeightedWithBasis,epsilonOrientationInBasis,ProtectNewSymbol,DefInfo}];

DefMetricCheck[signdet,metric[-ind1,-ind2],covd,covdsymbol,flat,inducedfrom,confto,odeps,wwb,eoib];

(* Explore *)
tangentmetricQ=SameQ[Tangent[BaseOfVBundle@vbundle],vbundle];
flatPD=flat&&(covd===PD);
dim=DimOfVBundle[vbundle];
integerdimQ=IntegerQ[dim];
(* One and only one of firstQ, inducedQ, frozenQ is True, and the other two are False *)
firstQ=MetricsOfVBundle[vbundle]==={};
inducedQ=And[!firstQ,inducedfrom=!=Null];
frozenQ=And[!firstQ,!inducedQ];
If[inducedQ,{supermetric,vector}=inducedfrom];
If[frozenQ,firstmetric=First[MetricsOfVBundle[vbundle]]];

With[{
manifold=BaseOfVBundle[vbundle],
deps=Union[{BaseOfVBundle[vbundle]},odeps],
vbQ=VBundleIndexQ[vbundle],
vbpmQ=VBundleIndexPMQ[vbundle],
invmetric=If[frozenQ,GiveSymbol[Inv,metric],metric]},

(* Avoid messages from options of DefMetric not accepted in DefTensor or DefCovD *)
Off[OptionValue::nodef];

(* Define metric tensor. Do not protect symbol. Do not use ProjectedWith. It is always symmetric *)
DefTensor[metric[-ind1,-ind2],deps,Symmetric[{1,2}],
ProtectNewSymbol->False,
OrthogonalTo:>If[inducedQ,{vector[ind1]},{}],
DefInfo:>If[info===False,False,{"symmetric metric tensor",""}],
options];

MakexTensions[DefMetric,"Beginning",signdet,metric[-ind1,-ind2],covd,options];

(* Register structure *)
AppendToUnevaluated[$Metrics,metric];
MetricQ[metric]^=True;
CovDOfMetric[metric]^=covd;
VBundleOfMetric[metric]^=vbundle;
xUpAppendTo[MetricsOfVBundle[vbundle],metric];
FlatMetricQ[metric]^=flat;
InducedFrom[metric]^=inducedfrom;

(* Signature *)
If[Head[signdet]===List &&Length[signdet]===3,
SignatureOfMetric[metric]^=signdet;
SignDetOfMetric[metric]^=If[signdet[[3]]===0,(-1)^signdet[[2]],0],
SignDetOfMetric[metric]^=signdet;
];
(* Invertibility *)
invertQ=SignDetOfMetric[metric]=!=0;
(* Define inverse metric. TODO: Orthogonal and Projected? *)
If[invertQ,
If[frozenQ ,
DefTensor[invmetric[ind1,ind2],deps,Symmetric[{1,2}],
ProtectNewSymbol->False,
Master->metric,
DefInfo:>If[info===False,False,{"inverse metric tensor","Metric is frozen!"}],
TensorID->{InvMetric,metric},
PrintAs:>GiveOutputString[Inv,metric],
options],
Inv[metric]^=metric
],
Print["** DefMetric: non-invertible metric being defined! Dangerous!"]
];

(* Directional indices are not allowed in metrics. Why only for first metrics? *)
If[firstQ,
metric[Dir[expr_],b_]:=ReplaceIndex[expr,UltraindexOf[expr]->b];
metric[a_,Dir[expr_]]:=ReplaceIndex[expr,UltraindexOf[expr]->a];
];

(* Define epsilon tensor, with covariant indices. Do not protect symbol *)
metric/:epsilonOrientation[metric,eoib[[1]]]=eoib[[2]];
With[{epsilonname=GiveSymbol[epsilon,metric],
inds=GetIndicesOfVBundle[vbundle,If[integerdimQ,If[inducedQ,dim-1,dim],2]]},
DefTensor[epsilonname@@(ChangeIndex/@inds),deps,Antisymmetric@Range@Length@inds,
PrintAs:>GiveOutputString[epsilon,metric],
ProtectNewSymbol->False,
Master->metric,
OrthogonalTo:>If[inducedQ,{vector[First[inds]]},{}],
ProjectedWith:>If[inducedQ,{metric[-DummyIn[vbundle],First[inds]]},{}],
DefInfo:>If[info===False,False,{"antisymmetric tensor",""}],
TensorID->{epsilon,metric}];
If[Not@integerdimQ && Not@inducedQ,
TagSetDelayed[epsilonname,SymmetryGroupOfTensor[epsilonname[inds1__]],Antisymmetric[Range@Length@{inds1}]];
TagUnset[epsilonname,SymmetryGroupOfTensor[epsilonname]];
TagSetDelayed[epsilonname,SymmetryGroupOfTensor[epsilonname],Antisymmetric[Range@DimOfVBundle@vbundle]]
];

(* Products of two epsilons. In the induced and frozen cases expansions give metric and not delta *)
If[inducedQ ||frozenQ,
epsilonname/:epsilonname[inds1__]epsilonname[inds2__]:=SignDetOfMetric[metric]expandGdelta[metric][inds1,inds2],
epsilonname/:epsilonname[inds1__]epsilonname[inds2__]:=SignDetOfMetric[metric]ExpandGdelta[Gdelta[inds1,inds2]]
];

(* Derivatives of epsilon. Note that we have not yet defined covd (!?) *)
If[tangentmetricQ,
If[frozenQ,
covd[a_][epsilonname[(-b_?vbQ)..]]^=0,
covd[a_][epsilonname[b__?vbpmQ]]^=0
];
TensorDerivative[epsilonname,covd,___]:=Zero;
If[!inducedQ,
If[!frozenQ,
epsilonname/:LieD[v_][epsilonname[inds1__?UpIndexQ]]:=Module[{dummy=DummyIn[vbundle]},-covd[-dummy][ReplaceIndex[v,{UltraindexOf[v]->dummy}]epsilonname[inds1]]]
];
epsilonname/:LieD[v_][epsilonname[inds1__?DownIndexQ]]:=Module[{dummy=DummyIn[vbundle]},covd[-dummy][ReplaceIndex[v,{UltraindexOf[v]->dummy}]epsilonname[inds1]]];
epsilonname/:TensorDerivative[epsilonname,LieD[vhead_?xTensorQ[_]]]:=With[{dummy=DummyIn[vbundle]},MultiplyHead[TensorDerivative[vhead,covd][dummy,-dummy],epsilonname]];
]
];

(* Special relation in 2d, valid for all types of indices *)
If[dim===2&&firstQ,
epsilonname[a_,b_]epsilonname[c_,d_]^=SignDetOfMetric[metric] (metric[a,c]metric[b,d]-metric[a,d]metric[b,c]);
];

(* Define Tetra, only in dimension 4. This is an algebraic construction, hence valid for frozen metrics *) 
If[dim==4,
With[{TetraName=GiveSymbol[Tetra,metric]},
Module[{i1,i2,i3,i4},
{i1,i2,i3,i4}=GetIndicesOfVBundle[vbundle,4];
DefTensor[TetraName[-i1,-i2,-i3,-i4],deps,GenSet[xAct`xPerm`Cycles[{1,2},{3,4}],xAct`xPerm`Cycles[{1,3},{2,4}]],
Dagger->Complex,
PrintAs:>GiveOutputString[Tetra,metric],
Master->metric,
ProtectNewSymbol->False,
DefInfo:>If[info===False,False,{"tetrametric",""}]
];
TetraRule[metric]^:=MakeRule[{TetraName[i1,i2,i3,i4],I/2epsilonOrientation[metric,AIndex]epsilonname[i1,i2,i3,i4]+metric[i1,i4]metric[i2,i3]/2-metric[i1,i3]metric[i2,i4]/2+metric[i1,i2]metric[i3,i4]/2},Evaluate->True];
With[{TetraNamedag=Dagger[TetraName]},
TetraNamedag[i1_,i2_,i3_,i4_]:=TetraName[i1,i4,i3,i2]
]
];
If[$ProtectNewSymbols,Protect[TetraName,Evaluate[Dagger@TetraName]]]
]
];

If[$ProtectNewSymbols,Protect[epsilonname]]
];

(* Self-contractions. Transformation to delta or metric for A-indices contraction of two metrics (this could be generalized). Projectors not automatically converted into delta *)
If[frozenQ,
invmetric/:metric[a_,-b_?vbQ]invmetric[b_?EIndexQ,c_]:=firstmetric[a,c];
invmetric/:metric[-b_?vbQ,a_]invmetric[b_?EIndexQ,c_]:=firstmetric[a,c];
invmetric/:metric[a_,-b_?vbQ]invmetric[c_,b_?EIndexQ]:=firstmetric[a,c];
invmetric/:metric[-b_?vbQ,a_]invmetric[c_,b_?EIndexQ]:=firstmetric[a,c];
invmetric/:metric[a_,b_?vbQ]invmetric[-b_?EIndexQ,c_]:=firstmetric[a,c];
invmetric/:metric[b_?vbQ,a_]invmetric[-b_?EIndexQ,c_]:=firstmetric[a,c];
invmetric/:metric[a_,b_?vbQ]invmetric[c_,-b_?EIndexQ]:=firstmetric[a,c];
invmetric/:metric[b_?vbQ,a_]invmetric[c_,-b_?EIndexQ]:=firstmetric[a,c],
If[inducedQ,
metric[a_?vbQ,-a_?EIndexQ]:=dim-1;
metric[-a_?vbQ,a_?EIndexQ]:=dim-1
];
If[firstQ,
metric[a_?UpIndexQ,b_?DownIndexQ]:=delta[b,a];
metric[a_?DownIndexQ,b_?UpIndexQ]:=delta[a,b]
];
HoldPattern[metric[a_,b_?vbQ]metric[-b_?EIndexQ,c_]]^:=metric[a,c];
HoldPattern[metric[a_,b_?vbQ]metric[c_,-b_?EIndexQ]]^:=metric[a,c];
HoldPattern[metric[b_?vbQ,a_]metric[-b_?EIndexQ,c_]]^:=metric[a,c];
HoldPattern[metric[b_?vbQ,a_]metric[c_,-b_?EIndexQ]]^:=metric[a,c];
];

(* Define covariant derivative(s). Do not protect symbol *)
If[tangentmetricQ,
If[flatPD,
(* Flat metric with PD. Derivative already defined *)
Print["** DefMetric: Associating fiducial flat derivative PD to metric."];
Unprotect[PD];
MetricOfCovD[PD]^=metric;
PD[c_][metric[a_?vbpmQ,b_?vbpmQ]]^=0;
metric/:TensorDerivative[metric,PD]:=Zero;
If[!frozenQ,
(* Place rule for this metric second, after the general rule for lower indices *)
AppendTo[$SortPDsRules,PD[b_?vbpmQ][PD[a_?vbpmQ][expr1_]]:>PD[a][PD[b][expr1]]/;DisorderedPairQ[a,b]]
],
(* Other cases. Define derivative. For a frozen metric the associated tensors are wrong! TODO *)
DefCovD[covd[-ind1],covdsymbol,
FromMetric->metric,
Curvature:>Not[flat],
OtherDependencies->odeps,
OrthogonalTo:>If[inducedQ,{vector[ind1]},{}],
ProjectedWith:>If[inducedQ,{metric[ind1,-ind2]},{}],
Master->metric,
ProtectNewSymbol->False,
DeleteCases[{options},_[PrintAs,_]]
]
];
InducedCovDQ[covd]=inducedQ;
(* Torsion. TODO: modify the covdsymbol in the LCmetric *)
LCmetric=If[TorsionQ[covd],LC[metric],covd];
If[!CovDQ[LCmetric],
DefCovD[LCmetric[-ind1],covdsymbol,
FromMetric->metric,
Torsion->False,
Curvature->True,
OtherDependencies->odeps,
OrthogonalTo:>If[inducedQ,{vector[ind1]},{}],
ProjectedWith:>If[inducedQ,{metric[ind1,-ind2]},{}],
Master->metric,
ProtectNewSymbol->False,
DeleteCases[{options},_[PrintAs,_]]
]
];
metric/:CovDOfMetric[metric,Torsion[covd]]=covd;
metric/:CovDOfMetric[metric,Torsion[LCmetric]]=LCmetric;
metric/:CovDOfMetric[metric,Zero]=LCmetric;
metric/:LC[metric]=LCmetric;

If[flatPD,Protect[PD]];
If[$ProtectNewSymbols,Protect[covd]];

(* Derivatives of the metric are defined in DefCovD *)
(* Other covariant derivatives on the metric with upstairs abstract indices *)
If[!inducedQ,
invmetric/:HoldPattern[der_?FirstDerQ[invmetric[b_?vbQ,c_?vbQ]]]:=Module[{b1=DummyIn[vbundle],c1=DummyIn[vbundle]},-invmetric[b,b1]invmetric[c,c1]der[metric[-b1,-c1]]]];
(* There is no simple generalization for induced metrics.
QUESTION: Is there an equivalent rule for the epsilon tensor?*)
];
(* Determinant in the basis AIndex. Has to be defined after the covd and the invmetric *)
If[info===False,
Block[{$DefInfoQ=False},Determinant[metric,AIndex][]],
Determinant[metric,AIndex][]
];

(* Define induced metric *)
If[tangentmetricQ,
If[inducedQ,DefInducedMetric[metric[-ind1,-ind2],{manifold},covd,{vector,supermetric,CovDOfMetric[supermetric]},flat]]
];

(* Store conformal relations *)
If[confto=!=Null,
SetConformalTo[metric[-ind1,-ind2],confto]
];

MakexTensions[DefMetric,"End",signdet,metric[-ind1,-ind2],covd,options];

On[OptionValue::nodef];

If[pns,Protect[metric]];
]
]
];
(* For metrics on inner vbundles *)
DefMetric[signdet_,metric_,opts:OptionsPattern[]]:=DefMetric[signdet,metric,None,opts];
DefMetric[_,metric_,_,OptionsPattern[]]:=Message[DefMetric::invalid,metric,"metric"];
SetNumberOfArguments[DefMetric,{2,Infinity}];
Protect[DefMetric];
On[RuleDelayed::rhs];

CovDOfMetric[metric_]:=Throw@Message[CovDOfMetric::unknown,"metric",metric];
CovDOfMetric[metric_,torsion_?xTensorQ]:=Throw@Message[CovDOfMetric::unknown,"metric",metric];
CovDOfMetric[metric_?xTensorQ,torsion_]:=Throw@Message[CovDOfMetric::unknown,"torsion",torsion];
LC[metric_]:=Throw@Message[LC::unknown,"metric",metric];
SignatureOfMetric[metric_]:=Throw@Message[SignatureOfMetric::unknown,"(signature of) metric",metric];
SignDetOfMetric[metric_]:=Throw@Message[SignDetOfMetric::unknown,"metric",metric];
VBundleOfMetric[metric_]:=Throw@Message[VBundleOfMetric::unknown,"metric",metric];
InducedFrom[metric_]:=Throw@Message[InducedFrom::unknown,"metric",metric];
SetNumberOfArguments[#,1]&/@{LC,SignatureOfMetric,SignDetOfMetric,VBundleOfMetric,InducedFrom};
SetNumberOfArguments[CovDOfMetric,{1,2}];
Protect[CovDOfMetric,SignatureOfMetric,SignDetOfMetric,VBundleOfMetric,FlatMetricQ,FlatMetric,InducedFrom];

The function relating epsilon tensors and eta tensors have a default value, equal to the old value of that factor. The difference is that now the factor can be set differently for each pair {metric, basis} instead of globally for all of them.

epsilonOrientation[_?MetricQ,_?BasisQ]:=$epsilonSign;
SetNumberOfArguments[epsilonOrientation,2];
Protect[epsilonOrientation];

14.1.2. Undefinition

It could happen that PD is a servant of a metric. To avoid trying to undefine PD we drop it from the servants list.

UndefMetric[list:{___?MetricQ}]:=Scan[UndefMetric,list];
UndefMetric[metric_]:=Catch@With[{servants=DeleteCases[ServantsOf[metric],PD],vbundle=VBundleOfMetric[metric]},
(* Check that it is really a metric *)
If[!MetricQ[metric],Throw@Message[UndefMetric::unknown,"metric",metric]];
CheckRemoveSymbol[metric];
MakexTensions[UndefMetric,"Beginning",metric];
xUpSet[ServantsOf[metric],{}];
DropFromHosts[metric];
Undef/@Reverse[servants];
(* Unregister *)
xUpDeleteCasesTo[MetricsOfVBundle[vbundle],metric];
$Metrics=DeleteCases[$Metrics,metric];
Unprotect[metric];
If[MetricOfCovD[PD]===metric,
xUpSet[MetricOfCovD[PD],Null];
$SortPDsRules=Take[$SortPDsRules,1]; (* Preserve only the general rule *)
];
If[MemberQ[$ProductMetrics,metric],
Unset[ProductMetricRules[metric,Metric]];
Unset[ProductMetricRules[metric,CovD]];
Unset[ProductMetricRules[metric,Christoffel]];
Unset[ProductMetricRules[metric,Riemann]];
$ProductMetrics=DeleteCases[$ProductMetrics,metric]];
(* Remove tensor *)
TagUnset[metric,MetricQ[metric]];
MakexTensions[UndefMetric,"End",metric];
UndefTensor[metric];
];
SetNumberOfArguments[UndefMetric,1];
Protect[UndefMetric];

Note that we must unset MetricQ before calling UndefTensor to avoid coming back here from there!

14.1.3. GradMetricToChristoffel and ChristoffelToGradMetric

This function translates any covariant derivative of a (tangent-bundle) metric into the corresponding Christoffel. The derivative can be of any type (with or without curvature, with or without torsion). Note that only when we find a particular gradient of a metric then we construct the required Christoffel tensor, and not all the possible tensors that could be constructed with the metrics and covds at hand.

Essentially this is a simpler form of ChangeCurvature, here applied to derivatives of metrics, the idea being simply the change from the given derivative to the Levi-Civita connection of the metric:

(* Three arguments: expr, metric, covd. Main *)
GradMetricToChristoffel[expr_,metric_Symbol?MetricQ,covd_?CovDQ]:=gradMetricToChristoffel[expr,{CovDOfMetric[metric],metric,Inv[metric]},covd];
(* Other cases *)
GradMetricToChristoffel[expr_,metric_,list_List]:=Fold[GradMetricToChristoffel[#1,metric,#2]&,expr,list];
GradMetricToChristoffel[expr_,list_List,covd_]:=Fold[GradMetricToChristoffel[#1,#2,covd]&,expr,list];
GradMetricToChristoffel[_,x_,covd_?CovDQ]:=Throw@Message[GradMetricToChristoffel::unknown,"metric",x];
GradMetricToChristoffel[_,_,y_]:=Throw@Message[GradMetricToChristoffel::unknown,"covariant derivative",y];
(* Two arguments: expr, metric *)
GradMetricToChristoffel[expr_,list_List]:=Fold[GradMetricToChristoffel,expr,list];
GradMetricToChristoffel[expr_,metric_]:=GradMetricToChristoffel[expr,metric,$CovDs];
(* One argument: expr *)
GradMetricToChristoffel[expr_]:=GradMetricToChristoffel[expr,$Metrics];
SetNumberOfArguments[GradMetricToChristoffel,{1,3}];
Protect[GradMetricToChristoffel];

Search for appropriate metric derivatives in the expression and introduce a Christoffel term per index of the metric (which can be both abstract or basis). This is assuming that the metric is symmetric (I have no idea about whether Christoffels, etc exist for antisymmetric metrics):

gradMetricToChristoffel[expr_,{metriccovd_,metric_,invmetric_},covd_]:=expr/.{
covd[i_][metric[i1_?DownIndexQ,i2_?DownIndexQ]]:>gradMetricTerm[covd[i],metriccovd,metric,i1,i2]+gradMetricTerm[covd[i],metriccovd,metric,i2,i1],covd[i_][invmetric[i1_?UpIndexQ,i2_?UpIndexQ]]:>gradInvMetricTerm[covd[i],metriccovd,invmetric,i1,i2]+gradInvMetricTerm[covd[i],metriccovd,invmetric,i2,i1]
};

This is valid for frozen metrics, but I'm not sure about induced metrics. It is interesting that this formulas do not need torsion terms. Note that the second rule (the one for derivatives of the inverse metric) might not be needed at all because derivatives of inverse metrics evaluate to derivatives of metrics contracted with pairs of inverse metrics.

gradMetricTerm[covd_[a_],metriccovd_,metric_,-b_Symbol,c_]:=With[{d=DummyAs[b]},metric[-b,-d]Christoffel[metriccovd,covd][d,a,c]];
gradInvMetricTerm[covd_[a_],metriccovd_,invmetric_,b_Symbol,c_]:=With[{d=DummyAs[b]},-invmetric[b,d]Christoffel[covd,metriccovd][c,a,-d]];
gradMetricTerm[covd_[a_],metriccovd_,metric_,b:({_,-basis_Symbol}|-basis_?BasisQ[_]),c_]:=With[{d=-DummyAs[b]},metric[b,-d]Christoffel[metriccovd,xAct`xCoba`PDOfBasis[basis]][d,a,c]]; (* BASIS1 and BASIS2 *);
gradInvMetricTerm[covd_[a_],metriccovd_,invmetric_,b:({_,basis_Symbol}|basis_?BasisQ[_]),c_]:=With[{d=DummyAs[b]},-invmetric[b,d]Christoffel[xAct`xCoba`PDOfBasis[basis],metriccovd][c,a,-d]]; (* BASIS1 and BASIS2 *);

This function performs the opposite operation. The second derivative is also generic., except for the fact that it must be one of the two derivatives in the Christoffel tensor.

(* Three arguments: expr, metric, covd. Main *)
ChristoffelToGradMetric[expr_,metric_Symbol?MetricQ,covd_?CovDQ]:=christoffelToGradMetric[expr,{CovDOfMetric[metric],metric,Inv[metric]},covd];
(* Other cases *)
ChristoffelToGradMetric[expr_,metric_,list_List]:=Fold[ChristoffelToGradMetric[#1,metric,#2]&,expr,list];
ChristoffelToGradMetric[expr_,list_List,covd_]:=Fold[ChristoffelToGradMetric[#1,#2,covd]&,expr,list];
ChristoffelToGradMetric[_,x_,covd_?CovDQ]:=Throw@Message[ChristoffelToGradMetric::unknown,"metric",x];
ChristoffelToGradMetric[_,_,y_]:=Throw@Message[ChristoffelToGradMetric::unknown,"covariant derivative",y];
(* Two arguments: expr, metric *)
ChristoffelToGradMetric[expr_,list_List]:=Fold[ChristoffelToGradMetric,expr,list];
ChristoffelToGradMetric[expr_,metric_]:=ChristoffelToGradMetric[expr,metric,$CovDs];
(* One argument: expr *)
ChristoffelToGradMetric[expr_]:=ChristoffelToGradMetric[expr,$Metrics];
SetNumberOfArguments[ChristoffelToGradMetric,{1,3}];
Protect[ChristoffelToGradMetric];

Our convention on how to sort Christoffels in an expression.

orderChristoffels[PD,covd_]:=-1;
orderChristoffels[covd_,PD]:=1;
orderChristoffels[covd1_,covd2_]:=Order[covd1,covd2];

The hard work is done by this function, which is valid for frozen metrics, but I'm not sure about induced metrics. Torsion terms have been fixed for 1.1.0 after Teake reported a bug in the group on August 15, 2013.

(* If the metricovd is PD then we have a Cartesian metric, and it makes no sense to differentiate it *)
christoffelToGradMetric[expr_,{PD,_,_},_]:=expr;
christoffelToGradMetric[expr_,{metriccovd_,_,_},metriccovd_]:=expr;
christoffelToGradMetric[expr_,{metriccovd_,metric_,invmetric_},covd_]:=With[{vbundle=VBundleOfMetric[metric],name=Cases[$Christoffels,{chr_,{_,metriccovd,covd}|{_,covd,metriccovd},_}:>chr]},
If[name==={},
expr,
expr/.First[name][i1_,i2_,i3_]:>With[{ii1=DummyIn[vbundle],ii2=DummyIn[vbundle],ii3=DummyIn[vbundle]},invmetric[i1,ii1]delta[i2,ii2]delta[i3,ii3]orderChristoffels[metriccovd,covd](covd[-ii2][metric[-ii3,-ii1]]+covd[-ii3][metric[-ii2,-ii1]]-covd[-ii1][metric[-ii2,-ii3]]+$TorsionSign(Torsion[covd][-ii2,-ii3,-ii1]+Torsion[covd][-ii3,-ii2,-ii1]-Torsion[covd][-ii1,-ii2,-ii3]-Torsion[metriccovd][-ii2,-ii3,-ii1]-Torsion[metriccovd][-ii3,-ii2,-ii1]+Torsion[metriccovd][-ii1,-ii2,-ii3]))/2]
]
];

Backwards compatibility:

?ChristoffelToMetric

ChristoffelToMetric=ChristoffelToGradMetric;
Protect[ChristoffelToMetric];

14.1.4. ChristoffelToGradConformal

This simple function changes Christoffel tensors between the LeviCivita connections of two conformally related metrics by their expression in terms of derivatives of the conformal factor. We are not currently considering the possibility of having torsion.

ChristoffelToGradConformal::nomet="Covariant derivative `1` does not have an associated metric.";
ChristoffelToGradConformal[expr_,list_List,new_]:=Fold[ChristoffelToGradConformal[#1,#2,new]&,expr,list];
ChristoffelToGradConformal[expr_,old_,old_]:=expr;
ChristoffelToGradConformal[expr_,old_?CovDQ,new_]:=With[{metric=MetricOfCovD[old]},If[metric=!=Null,ChristoffelToGradConformal[expr,metric,new],Throw@Message[ChristoffelToGradConformal::nomet,old]]];
ChristoffelToGradConformal[expr_,old_,new_?CovDQ]:=With[{metric=MetricOfCovD[new]},If[metric=!=Null,ChristoffelToGradConformal[expr,old,metric],
Throw@Message[ChristoffelToGradConformal::nomet,new]]];
ChristoffelToGradConformal[expr_,old_?MetricQ,new_?MetricQ]:=With[{vb=-First[SlotsOfTensor[new]],oldcovd=CovDOfMetric[old],newcovd=CovDOfMetric[new]},With[{confactor=ConformalFactor[old,new],invnew=Inv[new],chr=Head[(Christoffel@@Sort[{oldcovd,newcovd}])[DummyIn[vb],-DummyIn[vb],-DummyIn[vb]]],sign=Order[oldcovd,newcovd]},
If[confactor===Null,
expr,
expr/.chr[c_,a_,b_]:>Module[{d=DummyIn[vb]},Expand[sign/2(delta[a,c]newcovd[b][confactor]+delta[b,c]newcovd[a][confactor]-new[a,b]invnew[c,d]newcovd[-d][confactor])/confactor]]
]
]
];
SetNumberOfArguments[ChristoffelToGradConformal,3];
Protect[ChristoffelToGradConformal];

Storage of the conformal factor and the full conformal relation:

ConformalFactor[x_,x_?MetricQ]:=1;
ConformalFactor[x_,y_]:=Switch[{MetricQ[x],MetricQ[y]},
{True,True},Throw@Message[ConformalFactor::unknown,"conformal relation of metric",x],
{True,False},Throw@Message[ConformalFactor::unknown,"metric",y],
{False,_},Throw@Message[ConformalFactor::unknown,"metric",x]
];
SetNumberOfArguments[ConformalFactor,2];
Protect[ConformalFactor];

ConformalRules[x_List,y_List]:=Inner[ConformalRules,x,y,Join];
ConformalRules[x_,x_]:={};
ConformalRules[x_,y_]:=Throw@Message[ConformalRules::unknown,"conformal relation of",x];
SetNumberOfArguments[ConformalRules,2];
Protect[ConformalRules];

Off[RuleDelayed::rhs];
SetConformalTo[metric_?MetricQ[-i1_,-i2_],{originalmetric_?MetricQ[-i1_,-i2_],confactor_}]:=Module[{prot=Unprotect[metric]},
metric/:ConformalFactor[metric,originalmetric]=confactor;
metric/:ConformalFactor[originalmetric,metric]=1/confactor;
metric/:ConformalRules[metric,originalmetric]={
metric[i1_,i2_]->confactor originalmetric[i1,i2],
Inv[metric][i1_,i2_]->1/confactor Inv[originalmetric][i1,i2],
Determinant[metric][]->confactor^DimOfVBundle[VBundleOfMetric[metric]] Determinant[originalmetric][]
};
metric/:ConformalRules[originalmetric,metric]=
Join[
If[FirstMetricQ[originalmetric],
{originalmetric[i1_?DownIndexQ,i2_?DownIndexQ]->1/confactor metric[i1,i2],
originalmetric[i1_?UpIndexQ,i2_?UpIndexQ]->confactor Inv[metric][i1,i2]},
{originalmetric[i1_,i2_]->1/confactor metric[i1,i2],
Inv[originalmetric][i1_,i2_]->confactor Inv[metric][i1,i2]}
],
{Determinant[originalmetric][]->Determinant[metric][]/confactor^DimOfVBundle[VBundleOfMetric[metric]]}
];
Protect[Evaluate[prot]];
];
On[RuleDelayed::rhs];

14.1.5. Determinant of metric in a given basis

Construct determinant of the metric on the fly, if it does not exit yet, defining its properties under derivations:

?Determinant

Formatting. We do not need to include the name of the basis in the output string of Determinant because the color of the basis will be indicated in the density tildes.

Determinant/:GiveSymbol[Determinant,metric_,AIndex]:=SymbolJoin["Det",metric];
Determinant/:GiveSymbol[Determinant,metric_,basis_]:=SymbolJoin["Det",metric,basis];
GiveOutputString[Determinant,metric_,basis_]:=PrintAs[metric];

Definition of the metric determinant (not of its inverse!). Note that we check that we are passing a single basis object. This definition will be later generalized in xCoba to take a list of two bases, so that each index of the tensor can be in a different basis. This is needed to take determinants of Jacobian matrices.

Determinant[metric_][]:=Determinant[metric,AIndex][];
Determinant[metric_,basis_?BasisQ][]:=With[{
cd=CovDOfMetric[metric],
dmb=GiveSymbol[Determinant,metric,basis],
vbundle=VBundleOfMetric[metric],
invmetric=Inv[metric]},
(* Define tensor *)
DefTensor[dmb[],Union[DependenciesOfTensor[metric],xAct`xCoba`DependenciesOfBasis[basis]],WeightOfTensor->2basis,Master->metric,PrintAs:>GiveOutputString[Determinant,metric,basis],DefInfo:>If[$DefInfoQ===False,False,{"weight +2 density","Determinant."}],TensorID->{Determinant,metric,basis},ProtectNewSymbol->False];
(* Derivatives of the determinant *)
If[TangentBundleQ[vbundle],
If[WeightedWithBasis[cd]===basis,
cd[a_][dmb[]]^:=0;
dmb/:TensorDerivative[dmb,cd,___]:=Zero]
];
der_?FirstDerQ[dmb[]]^:=dmb[]Module[{b1=DummyIn[vbundle],c1=DummyIn[vbundle]},invmetric[b1,c1]der[metric[-b1,-c1]]];
dmb/:TensorDerivative[dmb,covd_?CovDQ]:=Function[{ind},dmb[]Module[{b1=DummyIn[vbundle],c1=DummyIn[vbundle]},invmetric[b1,c1]TensorDerivative[metric,covd][-b1,-c1,ind]]];
(* Variational derivatives of the determinant *)
dmb/:VarD[invmetric[a_Symbol,b_Symbol],PD][dmb[],rest_]:=-rest metric[-a,-b]dmb[];dmb/:VarD[metric[-a_Symbol,-b_Symbol],PD][dmb[],rest_]:=rest invmetric[a,b]dmb[];
(* Remember result *)
xTagSet[{metric,Determinant[metric,basis]},dmb];
dmb[]
];
Protect[Determinant];

Extracted code, because it is redundant with the definition already given. Note that we use the derivative of the metric, and not the trace Christoffel.

PD[a_][dmb[]]^:=dmb[]Module[{c=DummyIn[vbundle],d=DummyIn[vbundle]}, Inv[metric][c,d]PD[a][metric[-c,-d]]];
covd_?CovDQ[a_][dmb[]]^:=Module[{b=DummyIn[vbundle]},2dmb[]Christoffel[CovDOfMetric[metric],xAct`xCoba`PDOfBasis[basis]][b,a,-b]];

Note that the determinant is constructed when we supply the empty pair of brackets [] and not simply with Determinant[metric,basis].

14.1.6. Examples

BeginExamples[]

DefManifold[M2,2,{A,B,C,D,F,G}]

First we define a flat metric on M2:

DefMetric[-1,gflat[-A,-B],CdF,{"|","∂"},FlatMetric->True]

xAct`xCoba`BasisColor[Polar]^=RGBColor[0,0,1];

gflat[A,{1,Polar}]

gflat[A,{1,-Polar}]

CdF[-A][CdF[-B][ChristoffelCdF[C,-D,-E]]]

UndefMetric[gflat]

We can define a flat metric using a "Cartesian" coordinate system:

Catch@DefMetric[-1,gflat[-A,-B],PD,{"|","∂"}]

Catch@DefMetric[-1,gflat[-A,-B],PD,{"|","∂"},FlatMetric->True]

DefMetric[-1,gflat[-A,-B],PD,{",","∂"},FlatMetric->True]

UndefMetric[gflat]

Generic metric:

UndefMetric[metricg]

DefMetric[-1,metricg[-A,-B],CdM,{"|","▽"},PrintAs->"g"]

EinsteinCdM[-A,-B]

DefTensor[T[-A,-B],M2]

CdM[-A][metricg[-B,-C]]

DefCovD[CD[-A],{"#","D"},Torsion->True]

Christoffel[CD,CdM][A,-B,-C]

xATP`$Christoffels//ColumnForm

?ChristoffelCDCdM

ChristoffelToGradMetric:

ChristoffelToGradMetric[ChristoffelCdM[A,-B,-C],metricg,PD]//ScreenDollarIndices

ChristoffelToGradMetric[ChristoffelCdM[A,-B,-C],metricg,CdM]//ScreenDollarIndices

ChristoffelToGradMetric[ChristoffelCdM[A,-B,-C],metricg,CD]

ChristoffelToGradMetric[ChristoffelCdM[A,B,-C],metricg]//ScreenDollarIndices

ChristoffelToGradMetric[ChristoffelCdM[A,B,C]]//ScreenDollarIndices

ChristoffelToGradMetric[ChristoffelCDCdM[A,-B,-C],metricg,PD]//ScreenDollarIndices

ChristoffelToGradMetric[ChristoffelCDCdM[A,-B,-C],metricg,CD]//ScreenDollarIndices

ChristoffelToGradMetric[ChristoffelCDCdM[A,-B,-C],metricg]//ScreenDollarIndices

ChristoffelToGradMetric[ChristoffelCDCdM[A,-B,-C]]//ScreenDollarIndices

ChristoffelToGradMetric[ChristoffelCdM[A,-B,-C],metricg]//ScreenDollarIndices

ChristoffelCdM[A,B,-C]//ChristoffelToGradMetric//Simplify//ScreenDollarIndices

ChristoffelCdM[A,B,C]//ChristoffelToGradMetric//Simplify//ScreenDollarIndices

GradMetricToChristoffel:

GradMetricToChristoffel[PD[-A][metricg[-B,-C]]]

%//ChristoffelToGradMetric//Expand

GradMetricToChristoffel[CD[-A][metricg[-B,-C]]]

%//ChristoffelToGradMetric//Expand

ChristoffelCDCdM[A,-B,-C]//ChristoffelToGradMetric//ScreenDollarIndices

%//GradMetricToChristoffel

MetricsOfVBundle[TangentM2]

PD[-A][metricg[B,C]]//ScreenDollarIndices

DefMetric[-1,gg[-A,-B],CDM,{"|","▽"}]

?Invgg

MetricsOfVBundle[TangentM2]

DefManifold[S2,{2,3},{a,b,c,d,e,f}]

?S2

?TangentS2

DefMetric[1,gamma[-a,-b],CdS,{":","▽"},PrintAs->"γ"]

?gamma

UndefMetric[gamma]

?gamma

?CdS

UndefMetric[gg]

?gg

UndefMetric[metricg]

VisitorsOf[M2]

?metricg

UndefTensor[T]

UndefCovD[CD]

EndExamples[]

14.2. Metric contraction and separation

14.2.0. Comments

Contraction with the deltas is automatic, but contraction with metrics is not. It must be explicitly executed by the user using the function ContractMetric.

ContractMetric works with basis-indices, even if there are derivatives.

14.2.1. SymmetryOfMetric and SMP

Now that when we work with spinors we need to manipulate antisymmetric metrics. The function SymmetryOfMetric returns a sign +1 if the metric is symmetric and -1 if the metric is antisymmetric. We assume that the metric is one of those. It could be a public function, but the information is already in SymmetryGroupOfTensor.

(* SymmetryOfMetric *)
SymmetryOfMetric[Null]=0;
SymmetryOfMetric[metric_]:=xUpSet[SymmetryOfMetric[metric],If[MemberQ[Last@SymmetryGroupOfTensor[metric],-1,{2}],-1,1]];
(* Important convention on the index positioning of an antisymmetric metric *)
SMP[metric_,_?UpIndexQ,_?DownIndexQ]:=1;
SMP[metric_,_?DownIndexQ,_?UpIndexQ]:=SymmetryOfMetric[metric];
SMP[metric_,a_,b_]:=(Message[SymmetryOfMetric::unknown,"symmetry of metric",metric[a,b]];1);

It is very important to understand the convention in SMP:
	g[-b, -a] T[a]   ->   SMP[g, -a, a] T[-b]
	g[b, a] T[-a]    ->   SMP[g, a, -a] T[b]
	T[a] g[-a, -b]   ->   SMP[g, a, -a] T[-b]
	T[-a] g[a, b]    ->   SMP[g, -a, a] T[b]
This is consistent with the choice of delta[-a, b] as original identity and delta[a, -b] as "metric-derived" identity.

QUESTION: Perhaps we should introduce a global variable controlling this convention, but this issue would probably get even more confusing than it is right now.

This function checks whether there is a metric on the vbundle of an index, and which type of symmetry it has. Note that it throws an error if there is no metric. This is because SymmetryOfIndex is always called from "non-standard" deltas, which only exist when a metric has been introduced. It is used in delta and Gdelta definitions only, and so it can be considered to be a "SymmetryOfdelta" function.

SymmetryOfIndex[ind_,tf_:True]:=SymmetryOfMetric@FirstMetricOfVBundle[VBundleOfIndex[ind],tf];

14.2.3. ContractMetric

ContractMetric is the user function that expands the argument and then calls ContractMetric0 / ContractMetric1 (checking that metric is actually a metric). When no metric is specified we call $NonFrozenMetrics and not the whole list $Metrics because if there are several metrics in a vbundle only the first one and its induced metrics are allowed to move up and down the indices. Frozen metrics cannot be contracted, and a message is thrown. Induced metrics are projectors and therefore their contraction on an already-projected tensor is trivial, but not on other tensors.

$NonFrozenMetrics:=DeleteCases[$Metrics,_?FrozenMetricQ];

This curious function detects induced metrics and returns the normal vector. If a frozen metric is given then it throws an error:

ContractMetric::frozen="Cannot contract frozen metric `1`.";
NormalVectorOf[metric_]:=Which[
FirstMetricQ[metric],Null,
InducedFrom[metric]=!=Null,VectorOfInducedMetric[metric],
True,Throw@Message[ContractMetric::frozen,metric]];

Main driver:

Options[ContractMetric]={AllowUpperDerivatives->False,OverDerivatives->False};
ContractMetric[expr_,metrics_List,options___]:=Fold[ContractMetric[#1,#2,options]&,expr,metrics];
ContractMetric[expr_,metric_Symbol?MetricQ,options:OptionsPattern[]]:=ContractMetric0[OptionValue[{OverDerivatives,AllowUpperDerivatives}],{metric,NormalVectorOf[metric]}][expr];
ContractMetric[expr_,metric_Symbol,options___]:=Throw@Message[ContractMetric::unknown,"metric",metric];
ContractMetric[expr_,options___?OptionQ]:=ContractMetric[expr,$NonFrozenMetrics,options];
SetNumberOfArguments[ContractMetric,{1,Infinity}];
Protect[ContractMetric];

14.2.4. ContractMetric1

This section seems to be dangerous with respect to basis-indices.

The first pair of brackets of ContractMetric1 contains:
	- od: OverDerivatives Boolean
	- aud: AllowUpperDerivatives Boolean. It acts on covariant derivatives to allow upper derivative-indices.
	- metric: the metric to be contracted (either a first-metric or an induced metric).
	- nv: normal vector of metric, if it is induced, or Null if it is a first-metric.
It is natural to put od, aud in a list because they come from the options, and it is natural to put metric, nv in another list because nv is a property of metric.

ContractMetric1 is the internal function that performs metric contraction. It must be defined on the different types. Before that we introduce a step expanding Times products (other products distribute automatically):

0) Expand products:

ContractMetric0[case__][expr_Times]:=ContractMetric1[case][MathInputExpand[expr]];
ContractMetric0[case__][expr_]:=ContractMetric1[case][expr];

1) First we have some definitions which do not perform any actual contraction, but refer to itself recursively:

(* Automatic threading *)
ContractMetric1[case__][expr_Plus]:=ContractMetric0[case]/@expr;
ContractMetric1[case__][expr_SeriesData]:=SeriesDataMap[ContractMetric0[case],expr];
ContractMetric1[case__][list_List]:=ContractMetric0[case]/@list;
ContractMetric1[case__][eq_Equal]:=ContractMetric0[case]/@eq;

2) Contraction through derivatives:

The function differentexpressionsQ does the following: when contracting through a derivative we want to know if the metric outside can be contracted with the expression inside the metric. What we do is comparing two lists: expr1 is the list of the metric and the expression inside and expr2 is the expression after trying to contract the metric. We shall only continue if these two (sorted!) lists are different.

differentexpressionsQ[expr1_Times,expr2_List]:=differentexpressionsQ[List@@expr1,expr2];differentexpressionsQ[expr1_List,expr2_List]:=UnsameQ[Sort[expr1],Sort[expr2]];
(* All other cases in which the LHS is a single object *)
differentexpressionsQ[expr1_,expr2_]:=True;

As noted by Guillaume, the definitions based on the use of FirstDerQ do not work with multiple parametric derivatives.  This is because we use a different (compacted) notation for multiple parametric derivatives, instead of the usual (expanded) notation for other types of derivatives. I don't see a simple way to solve this, except removing the compacted notation for parametric derivatives; need to think more.

We cannot allow recursion on products of the form g*D(g^-1) because they would give (g^-1)*Dg, which can be processed again with the same rule giving the original expression again, leading to infinite recursion. The following defintion simply prevents this particular case on first order derivatives of the (first or induced) metric. Recall that derivatives of first metrics with upper indices are automatically converted into derivatives of their lower-indices counterparts. That means that there is a canonical form for first-order derivatives of first-metrics, but not in other cases (like higher derivatives or any derivative of induced metrics).

(* Contraction metric*der[metric] is left untouched to avoid infinite recursion *)
(CM:ContractMetric1[{od_,aud_},{metric_,nv_}])[rest_. der_?FirstDerQ[metric_[a_,b_]]metric_[c_,d_]]:=CM[rest metric[c,d]]der[metric[a,b]]/;(PairQ[a,d]||PairQ[b,d]||PairQ[a,c]||pair[b,c]);

Note that in the following expression we only make use of the Leibnitz rule and therefore it is valid even if there are basis-indices in the expression. However, it could be wrong for an induced derivative if we try to contract a non-spatial index. However that would mean that the projected derivative is acting on an object with a non-projected index, and that is forbidden in our system. So, as long as that rule is kept, the following definition is correct:

(* Contractions inside first-derivatives. This is a complicated definition *)
(CM:ContractMetric1[{od_,aud_},{metric_,nv_}])[rest_. der_?FirstDerQ[expr_]met:metric_[b_,c_]]:=
Module[{dm=der[met],result},
If[(od||dm===0)&&differentexpressionsQ[result=CM[expr met],{expr,met}],
CM[rest der[result]]-CM[rest dm expr],
CM[rest met]der[expr]]
]/;(MemberQ[FindFreeIndices[expr],ChangeIndex[c]|ChangeIndex[b]]&&Head[expr]=!=metric);

There is one doubt: it could happen that the contraction is not possible and then we pass to the reduced case CM[rest met]. But, what if something else in rest could still be contracted with expr? This is a very special case, and perhaps that is why we have never seen it, but it is clearly a possibility. Perhaps there should be a condition check that CM[rest met] is actually different from rest met. Note that there is no danger because the result is still correct; it just fails to perform a possible contraction.

(* Code provided by Guillaume to contract through multiple parametric derivatives *)
(CM:ContractMetric1[{od_,aud_},{metric_,nv_}])[rest_. ParamD[param1_,params__][expr_] met:metric_[b_,c_]]:=Module[{dm=ParamD[param1][met],result},If[(od||dm===0)&&differentexpressionsQ[result=CM[ParamD[params][expr] met],{ParamD[params][expr],met}],CM[rest ParamD[param1][result]]-CM[rest dm ParamD[params][expr]],CM[rest met] ParamD[param1,params][expr]]]/;(MemberQ[FindFreeIndices[expr],ChangeIndex[c]|ChangeIndex[b]]&&Head[expr]=!=metric);

3) Induced metrics: If the switch nv (projection) is different from Null then contraction is allowed only if the tensor to be contracted is orthogonal to nv or if the derivative is the induced derivative:

(* nv=Null: allow contraction *)
PRJ[Null,__]:=True;
(* nv=!=Null: allow only valid cases: *)
(*          Contraction of projector on an spatial tensor *)
PRJ[nv_,tensor_?xTensorQ,indumetric_]:=OrthogonalToVectorQ[nv][tensor];
(*          Contraction of projector through its Levi-Civita connection *)
PRJ[nv_,covd_?CovDQ,indumetric_]:=CovDOfMetric[indumetric]===covd;

Note the particular case of passing an induced metric inside their associated projectors as full metrics. Example:   h[-a,-b] Projh[ T[b,c] ] = Projh[ g[-a,-b] T[b,c] ]  ,  where we have converted h into g when going inside. However, this cannot be done if both indices of the metric h are contracted, as in   h[-a,-b] Projh[ T[a,b] ].  I think this is a property of induced metrics and projectors, and not a generic property of induced metrics and inert-heads. Think about this!

Which metric we contract inside the inert-head depends on the type of metric and whether only one or both indices are contracted:

(* Non-induced metric: nothing to do *)
ContractMetric2[{od_,aud_},{metric_,Null,_}][expr_,met_]:=ContractMetric1[{od,aud},{metric,Null}][expr met];
(* Induced metric. Both indices are contracted: nothing to do *)
ContractMetric2[{od_,aud_},{metric_,nv_,True}][expr_,met_]:=ContractMetric1[{od,aud},{metric,nv}][expr met];
(* Induced metric. Other index not contracted: pass supermetric inside *)
ContractMetric2[{od_,aud_},{metric_,nv_,False}][expr_,met_]:=With[{supermetric=First@InducedFrom[metric]},ContractMetric1[{od,aud},{supermetric,Null}][expr supermetric@@met]];

4) Now we have the function which perform the actual contraction. There are four cases: tensors, covariant derivatives, brackets (the only three things in xTensor having abstract indices)and then inert-heads. We give two definitions per case, the first contracting the second index of the metric, and the second contracting the first index of the metric. This is to have full control on the order the indices are tried.

Comments:
	- There is external recursion in all cases, but there is no recursion in the internal expr of a covariant derivative. In those cases in which the Leibnitz derivative holds there is no problem, but in those cases in which it doesn't such recursion could be actually needed.

I don't like the use of Condition, but here there are so many things to check that any other type of coding would be much longer.

Explicit assumptions:
	- The "other index in the metric" is never a pattern, and that is why we use UpIndexQ and DownIndexQ instead upQ and downQ. Patterns could be dangerous here.

Tensors, covariant derivatives and products:

(* Second index of metric *)
(CM:ContractMetric1[{od_,aud_},{metric_,nv_}])[rest_. tensor_?xTensorQ[i1___,a_,i2___]metric_[b_,c_]]:=SMP[metric,c,a]CM[rest tensor[i1,b,i2]]/;PairQ[c,a]&&PRJ[nv,tensor,metric];
(CM:ContractMetric1[{od_,aud_},{metric_,nv_}])[rest_. covd_?CovDQ[i1___,a_,i2___][expr_]metric_[b_,c_]]:=SMP[metric,c,a]CM[rest covd[i1,b,i2][expr]]/;PairQ[c,a]&&(aud||DownIndexQ[b])&&PRJ[nv,covd,metric];
(CM:ContractMetric1[{od_,aud_},{metric_,nv_}])[rest_. prod_?ProductQ[left___,tensor_?xTensorQ[i1___,a_,i2___],right___]metric_[b_,c_]]:=SMP[metric,c,a]CM[rest prod[left,tensor[i1,b,i2],right]]/;PairQ[c,a]&&PRJ[nv,tensor,metric] &&ScalarsOfProduct[prod][metric[b,c]];


(* First index of metric *)
(CM:ContractMetric1[{od_,aud_},{metric_,nv_}])[rest_. tensor_?xTensorQ[i1___,a_,i2___]metric_[b_,c_]]:=SMP[metric,a,b]CM[rest tensor[i1,c,i2]]/;PairQ[a,b]&&PRJ[nv,tensor,metric];
(CM:ContractMetric1[{od_,aud_},{metric_,nv_}])[rest_. covd_?CovDQ[i1___,a_,i2___][expr_]metric_[b_,c_]]:=SMP[metric,a,b]CM[rest covd[i1,c,i2][expr]]/;PairQ[a,b]&&(aud||DownIndexQ[c])&&PRJ[nv,covd,metric];
(CM:ContractMetric1[{od_,aud_},{metric_,nv_}])[rest_. prod_?ProductQ[left___,tensor_?xTensorQ[i1___,a_,i2___],right___]metric_[b_,c_]]:=SMP[metric,a,b]CM[rest prod[left,tensor[i1,c,i2],right]]/;PairQ[a,b]&&PRJ[nv,tensor,metric] &&ScalarsOfProduct[prod][metric[b,c]];

We are assuming that the metric factors are outside the prod[...] expression and multiplied by Times. Only in that case we will absorb the metric.

Inert heads. I think this must be converted into some better notation for contraction of induced derivatives. Note that we pass the control to another function called ContractMetric2, defined before. April 2012: Removed SMP[metric, c, -c] from first definition and SMP[metric, -b, b] from the second one, because the sign is handled by ContractMetric2. Thanks to Thomas for catching the problem.

(* Second index of metric *)
(CM:ContractMetric1[{od_,aud_},{metric_,nv_}])[rest_. head_?InertHeadQ[expr_,z___]metric_[b_,c_]]:=CM[rest head[ContractMetric2[{od,aud},{metric,nv,IsIndexOf[expr,-b,metric]}][expr,metric[b,c]],contractz[{z},-c,b]]]/;IsIndexOf[head[expr,z],-c,metric];
(* First index of metric *)
(CM:ContractMetric1[{od_,aud_},{metric_,nv_}])[rest_. head_?InertHeadQ[expr_,z___]metric_[b_,c_]]:=CM[rest head[ContractMetric2[{od,aud},{metric,nv,IsIndexOf[expr,-c,metric]}][expr,metric[b,c]],contractz[{z},-b,c]]]/;IsIndexOf[head[expr,z],-b,metric];

Contraction in the indexed arguments (marked with IndexList):

(* Arrange change of indices in the additional z arguments *)
contractz[{},_,_]:=Sequence[];
contractz[zlist_List,index1_,index2_]:=Apply[Sequence,zlist/.IndexList[i1___,index1,i2___]->IndexList[i1,index2,i2]];

Finally we have the default case, which is used when none of the above definitions holds:

(* Default case *)
ContractMetric1[__][expr_]:=expr;

14.2.5. SeparateMetric. Old code

This is the opposite action to ContractMetric. We want to extract indices from tensor expressions using a metric, and hence changing the character of the index on the tensor. We need to introduce a new index, which could be an abstract index or a basis index for a given basis. The syntax is complicated because we need three pieces of information on top of the expression: SeparateMetric[metric, basis][expr, indices]

(* Shortcuts to 2+2 arguments and errors *)
SeparateMetric[][]:=Throw[];
SeparateMetric[][args__]:=SeparateMetric[Automatic,AIndex][args];
SeparateMetric[metric_][args__]:=SeparateMetric[metric,AIndex][args];
SeparateMetric[metric_,basis_][expr_,All]:=SeparateMetric[metric,basis][expr,IndicesOf[][expr]];
SeparateMetric[metric_,basis_][expr_,vb_?VBundleQ]:=SeparateMetric[metric,basis][IndicesOf[vb][expr]];
SeparateMetric[metric_,basis_][expr_,basis2_Symbol?BasisQ]:=SeparateMetric[metric,basis][expr,IndicesOf[basis2][expr]];
SeparateMetric[_,_,__][__]:=Throw[];
(* Thread over sums *)
SeparateMetric[metric_,basis_][expr_Plus,indices_]:=SeparateMetric[metric,basis][#,indices]&/@expr;
(* IndicesOf *)
SeparateMetric[metric_,basis_][expr_,f_IndicesOf]:=SeparateMetric[metric,basis][expr,f[expr]];
(* Indices not in their original character *)
SeparateMetric[metric_,basis_][expr_]:=SeparateMetric[metric,basis][expr,Automatic];
SeparateMetric[metric_,basis_][expr_,Automatic]:=With[{tensors=FindAllOfType[expr,Tensor],covds=FindAllOfType[expr,CovD]},SeparateMetric[metric,basis][expr,Flatten@Apply[IndexList,movedindices/@Join[tensors,covds]]]];
(* Expand list of indices *)
SeparateMetric[metric_,basis_][expr_,list_IndexList]:=Fold[SeparateMetric[metric,basis],expr,DeleteCases[list,_LI|-_LI]];

Note: Apply[Join,somelist] replaced by Flatten@Apply[IndexList,somelist] because if somelist is empty then we get List[], instead of the expected IndexList[]. This is because Join[] gives List[]. Thanks to Torsten for reporting this problem in the xAct group.

The function movedindices selects the indices which are not in their original character (given at definition time):

(* Tensors *)
movedindices[Basis[_,_]]:=IndexList[];
movedindices[delta[_,_]]:=IndexList[];
movedindices[tensor_?xTensorQ[inds___]]:=movedindices[tensor,IndexList[inds],SlotsOfTensor[tensor],SignedVBundleOfIndex/@{inds}];
movedindices[ih_?InertHeadQ[expr_,z___]]:=movedindices[expr];
movedindices[tensor_,inds_,slots1_,slots2_]:=If[Length[slots1]=!=Length[slots2],
Throw[Message[Validate::error,"Wrong number of indices of tensor "<>ToString[tensor]]],
inds[[Flatten[Position[Apply[samevbQ,Transpose[{slots1,slots2}],1],False]]]]];
samevbQ[vb_,vb_]:=True
samevbQ[vb_?VBundleQ,All]:=True;
samevbQ[All,vb_?VBundleQ]:=True;
samevbQ[-vb_?VBundleQ,-All]:=True;
samevbQ[-All,-vb_?VBundleQ]:=True;
samevbQ[_,_]:=False;
(* CovDs *)
movedindices[covd_?CovDQ[inds___][_]]:=Select[IndexList[inds],UpIndexQ];

From now on we always have an elementary situation of the form SeparateMetric[metric, basis][expr, index] , which means that in the expression expr we want to separate the given index using the given metric and introducing a new dummy index belonging to the given basis (by default it is AIndex, understood as the "basis" for abstract indices).
If the metric is Automatic then the first-metric of the vbundle of the index is used. In other cases we check consistency between the index and the metric. This is all done by the subsidiary function SeparateBasis1 with three arguments in the first bracket:

SeparateMetric[metric_,basis_][expr_,index_?GIndexQ]:=SeparateMetric1[basis,metric,FirstMetricOfVBundle[VBundleOfIndex[index]]][expr,index];

As noticed by Thomas, this does not work with induced metrics, and it should work.

SeparateMetric1[basis_,Automatic,metric1_][expr_,index_]:=SeparateMetric2[basis,metric1][expr,index];
SeparateMetric1[basis_,metric1_,metric1_][expr_,index_]:=SeparateMetric2[basis,metric1][expr,index];
SeparateMetric1[basis_,frozen_?FrozenMetricQ,metric1_][expr_,index_]:=SeparateMetric2[basis,frozen][expr,index]/;VBundleOfMetric[frozen]===VBundleOfMetric[metric1];

Now we know that the metric and the index are consistent. We pass to the function SeparateMetric2:

(* SeparateMetric *)
SeparateMetric2[basis_,metric_][expr_,index_]:=expr/.{tensor_?xTensorQ[i1___,index,i2___]:>With[{dummy=DummyAs[index,basis]},If[UpIndexQ[index],metric[index,dummy],metric[dummy,index]]tensor[i1,ChangeIndex[dummy],i2]],covd_?CovDQ[i1___,index,i2___][expr1_]:>With[{dummy=DummyAs[index,basis]},If[UpIndexQ[index],metric[index,dummy],metric[dummy,index]]covd[i1,ChangeIndex[dummy],i2][expr1]]}

14.2.5. SeparateMetric. New code

This is the opposite action to ContractMetric. We want to extract indices from tensor expressions using a metric, and hence changing the character of the index on the tensor. We need to introduce a new index, which could be an abstract index or a basis index for a given basis. The syntax is complicated because we need three pieces of information on top of the expression: SeparateMetric[metric, basis][expr, indices].

If we specify an index, the metric will be separated in that index, even if the action changes a slot from its natural character to its dual. If we do not specify indices, the default action is bringing all tensor slots to their natural characters.

SeparateMetric is a function that acts directly on individual objects, and hence the first thing we need to do is localizing its action on those objects.

(* Locate individual tensors *)
SeparateMetric[args1___][expr_Plus,args2___]:=SeparateMetric[args1][#,args2]&/@expr;
SeparateMetric[args1___][expr_SeriesData,args2___]:=SeriesDataMap[SeparateMetric[args1][#,args2]&,expr];
SeparateMetric[args1___][expr_Times,args2___]:=SeparateMetric[args1][#,args2]&/@expr;

(* Shortcuts to 2 arguments in the first pair of brackets *)
SeparateMetric[][args__]:=SeparateMetric[Automatic,AIndex][args];
SeparateMetric[metric_][args__]:=SeparateMetric[metric,AIndex][args];
(* Second argument of the second pair of brackets *)
SeparateMetric[metric_,basis_][expr_,All]:=SeparateMetric[metric,basis][expr,IndicesOf[][expr]];
SeparateMetric[metric_,basis_][expr_,vb_?VBundleQ]:=SeparateMetric[metric,basis][IndicesOf[vb][expr]];
SeparateMetric[metric_,basis_][expr_,basis2_Symbol?BasisQ]:=SeparateMetric[metric,basis][expr,IndicesOf[basis2][expr]];
SeparateMetric[metric_,basis_][expr_,f_IndicesOf]:=SeparateMetric[metric,basis][expr,f[expr]];
(* Default action of the second argument: Indices not in their original character *)
SeparateMetric[metric_,basis_][expr_]:=SeparateMetric[metric,basis][expr,Automatic];
SeparateMetric[metric_,basis_][expr_,Automatic]:=With[{tensors=FindAllOfType[expr,Tensor],covds=FindAllOfType[expr,CovD]},SeparateMetric[metric,basis][expr,Flatten@Apply[IndexList,movedindices/@Join[tensors,covds]]]];
(* Expand list of indices *)
SeparateMetric[metric_,basis_][expr_,list_IndexList]:=Fold[SeparateMetric[metric,basis],expr,DeleteCases[list,_LI|-_LI]];

(* Errors *)
SeparateMetric[___][]:=Throw[];
SeparateMetric[_,_,__][__]:=Throw[];
SeparateMetric[___][_,_,__]:=Throw[];

Note: Apply[Join,somelist] replaced by Flatten@Apply[IndexList,somelist] because if somelist is empty then we get List[], instead of the expected IndexList[]. This is because Join[] gives List[]. Thanks to Torsten for reporting this problem in the xAct group.

The function movedindices selects the indices which are not in their original character (given at definition time):

(* Tensors *)
movedindices[Basis[_,_]]:=IndexList[];
movedindices[delta[_,_]]:=IndexList[];
movedindices[tensor_?xTensorQ[inds___]]:=movedindices[tensor,IndexList[inds],SlotsOfTensor[tensor],SignedVBundleOfIndex/@{inds}];
(* TODO: I don't think we need this definition *)
movedindices[ih_?InertHeadQ[expr_,z___]]:=movedindices[expr];
movedindices[tensor_,inds_,slots1:{AnyIndices[vb_]},slots2_]:=movedindices[tensor,inds,Table[vb,{Length[slots2]}],slots2];
movedindices[tensor_,inds_,slots1:{l___,a_AnyIndices,r___},slots2_]:=With[{ll=Length[{l}],rl=Length[{r}],sl=Length[slots2]}, Join[
movedindices[tensor,inds,{l},Take[slots2,ll]],
movedindices[tensor,inds,{a},Take[slots2,{ll+1,sl-rl}]],
movedindices[tensor,inds,{r},Take[slots2,rl-sl]]
]
];
movedindices[tensor_,inds_,slots1_,slots2_]:=If[Length[slots1]=!=Length[slots2],
Throw[Message[Validate::error,"Wrong number of indices of tensor "<>ToString[tensor]]],
inds[[Flatten[Position[Apply[samevbQ,Transpose[{slots1,slots2}],1],False]]]]];
(* Special definition for Gdelta *)
Gdelta/:movedindices[gd_Gdelta]:=With[{il=IndexList@@gd,n=Length[gd]/2},
Join[Select[Take[il,n],UpIndexQ],Select[Drop[il,n],DownIndexQ]]
];
(* CovDs *)
movedindices[covd_?CovDQ[inds___][expr_]]:=Join[Select[IndexList[inds],UpIndexQ],movedindices[expr]];
(* Individual vbundles *)
samevbQ[vb_,vb_]:=True
samevbQ[vb_?VBundleQ,All]:=True;
samevbQ[All,vb_?VBundleQ]:=True;
samevbQ[-vb_?VBundleQ,-All]:=True;
samevbQ[-All,-vb_?VBundleQ]:=True;
samevbQ[_,_]:=False;

From now on we always have an elementary situation of the form SeparateMetric[metric, basis][expr, index] , which means that in the expression expr we want to separate the given index using the given metric and introducing a new dummy index belonging to the given basis (by default it is AIndex, understood as the "basis" for abstract indices).
If the metric is Automatic then the first-metric of the vbundle of the index is used. In other cases we check consistency between the index and the metric. This is all done by the subsidiary function SeparateBasis1 with three arguments in the first bracket:

SeparateMetric[metric_,basis_][expr_,index_?GIndexQ]:=SeparateMetric1[basis,metric,FirstMetricOfVBundle[VBundleOfIndex[index]]][expr,index];

As noticed by Thomas, this does not work with induced metrics, and it should work.

SeparateMetric1[basis_,Automatic,metric1_][expr_,index_]:=SeparateMetric2[basis,metric1][expr,index];
SeparateMetric1[basis_,metric1_,metric1_][expr_,index_]:=SeparateMetric2[basis,metric1][expr,index]/;VBundleOfMetric[metric1]===VBundleOfIndex[index];
SeparateMetric1[basis_,metric_,metric1_][expr_,index_]:=expr;

These two definitions have created much confusion. They now seem too dangerous to me, so I remove them from the package (Jose, 21 Feb 2021):

SeparateMetric1[basis_,metric_,metric1_][expr_,index_]:=SeparateMetric2[basis,metric]
SeparateMetric1[basis_,frozen_?FrozenMetricQ,metric1_][expr_,index_]:=SeparateMetric2[basis,frozen][expr,index]/;VBundleOfMetric[frozen]===VBundleOfMetric[metric1];

Now we know that the metric and the index are consistent. We pass to the function SeparateMetric2:

(* SeparateMetric *)
SeparateMetric2[AIndex,metric_][metric_[i1_,i2_],index_]:=metric[i1,i2];
SeparateMetric2[basis_,metric_][expr_,index_]:=expr/.{tensor_?xTensorQ[i1___,index,i2___]:>With[{dummy=DummyAs[index,basis]},If[UpIndexQ[index],metric[index,dummy],metric[dummy,index]]tensor[i1,ChangeIndex[dummy],i2]],covd_?CovDQ[i1___,index,i2___][expr1_]:>With[{dummy=DummyAs[index,basis]},If[UpIndexQ[index],metric[index,dummy],metric[dummy,index]]covd[i1,ChangeIndex[dummy],i2][expr1]]}

14.2.6. Examples

BeginExamples[]

DefMetric[-1,metricg[-A,-B],CdM,{"|","▽"},PrintAs->"g"]

DefTensor[T[A,B],M2]

ContractMetric[metricg[A,B]T[-C,-B]]

metricg[{-A,-Polar},-B]T[{A,Polar},{C,Polar}]//ContractMetric

metricg[-A,-B]CdM[-D][T[A,{C,Polar}]]//ContractMetric

ContractMetric[CdM[-F][CdM[-C][T[-B,-H]]]metricg[C,G],metricg]

ContractMetric[CdM[-F][CdM[-C][T[-B,-H]]]metricg[C,G],metricg,AllowUpperDerivatives->True]

ContractMetric[CdM[-D][T[A,B]]CdM[-F][CdM[-C][T[-B,-H]]]metricg[C,G],metricg]//InputForm

ContractMetric[metricg[F,G]metricg[-D,-A]PD[-F][T[B,A]],metricg]

ContractMetric[metricg[F,G]metricg[-D,-A]CdM[-F][T[B,A]],metricg]

xATP`ContractMetric1[{False,False},False,metricg][ LieD[T[A]][T[B]]metricg[-B,-C]]

CdM[-D][T[A,B]]CdM[-F][CdM[-B][T[-C,-H]]]metricg[C,G]

ContractMetric[%,metricg]

ContractMetric[T[A,B]metricg[C,-B],metricg]//InputForm

PD[-A][T[B,C]]metricg[-B,-D]//ContractMetric

ContractMetric[%,OverDerivatives->True]

PD[-A][LieD[T[A]][T[B,C]]]metricg[-B,-D]//ContractMetric

ContractMetric[%,OverDerivatives->True]

With bases. Do many more tests:

PD[-A][T[{B,Polar},C]]metricg[{-B,-Polar},-D]

%//ContractMetric

ContractMetric[%,OverDerivatives->True]

PD[-A][T[{B,Polar},C]]metricg[{-D,-Polar},-C]

%//ContractMetric

ContractMetric[%,OverDerivatives->True]

$CovDs

DefMetric[-1,gg[-A,-B],CD,{";","D"}]

?Invgg

ContractMetric[metricg[A,B]T[-B,-C],metricg]

Catch@ContractMetric[gg[A,B]T[-B,-C],gg]

metricg[-A,-B]metricg[A,C]

gg[-A,-B]gg[A,C]

%//ContractMetric

gg[-A,-B]metricg[A,C]

%//ContractMetric

UndefMetric/@{gg,metricg};

UndefTensor[T]

EndExamples[]

14.3. Induced metrics

14.3.0. Comments

This is an important and nontrivial part of xTensor, and perhaps it could even merit promotion to a separate package. I don't do it because I don't have a good name for it yet!

I thank much input and feedback on this area from Guillaume Faye, Alfonso Garcia-Parrado and Cyril Pitrou.

There are two different ways of doing ADM-type decomposition. We follow here Wald, as usual, in choosing expressions with indices on the ambient vbundles always, and using projectors into the subvbundles. The opposite choice would be using index splitting, which I think would be easier to use, and more powerful. I guess that in the future xTensor will handle both formalisms.

There are two index conventions here:

DefSign[$ExtrinsicKSign,"(Subscript[s, K])",1];
DefSign[$AccelerationSign,"(Subscript[s, A])",1];

Note: derivatives of inverse induced metrics are not automatically converted into derivatives of the induced metrics. QUESTION: is that a problem in the process of canonicalization of derivatives of metrics?

Note: a projector h[a,-b] is automatically contracted with projected tensors and projected derivatives, but not with objects surrounded by the Projectorh. That seems a bit inconsistent. That is also an exception to the rule of non-automatic metric contraction.

14.3.1. Definitions

This command is in charge of most of the definitions concerning induced metrics. It is called from DefMetric, and hence we assume that the tensor metric has already been defined.

Validate::nonproj="Induced derivative acting on the non-projected expression `1`."

DefInducedMetric[metric_[-ind1_,-ind2_],dependencies_,covd_,{vector_,supermetric_,superCD_},flat_]:=
With[{vbundle=VBundleOfIndex[ind1]},
With[{
extrinsicKname=GiveSymbol[ExtrinsicK,metric],
accelerationname=GiveSymbol[Acceleration,vector],
projectorname=GiveSymbol[Projector,metric],
epsilonname=GiveSymbol[epsilon,metric],
superepsilonname=GiveSymbol[epsilon,supermetric],
proj=ProjectWith[metric],
norm=Scalar@Simplify@ContractMetric[supermetric[-ind1,-ind2]vector[ind1]vector[ind2],supermetric],
indexlist=GetIndicesOfVBundle[vbundle,3]},

With[{i1=indexlist[[1]],i2=indexlist[[2]],i3=indexlist[[3]]},

(* Register pair metric/vector *)
xUpSet[VectorOfInducedMetric[metric],vector];

(* Define associated tensors *)
DefTensor[extrinsicKname[i1,i2],dependencies,Symmetric[{1,2}],
PrintAs:>GiveOutputString[ExtrinsicK,metric],
OrthogonalTo->{vector[-i1]},
ProjectedWith->{metric[i3,-i2]},
ProtectNewSymbol->False,
Master->metric,
DefInfo->{"extrinsic curvature tensor","Associated to vector "<>ToString[vector]},
TensorID->{ExtrinsicK,metric}];
DefTensor[accelerationname[i1],dependencies,
PrintAs:>GiveOutputString[Acceleration,vector],
OrthogonalTo->{vector[-i1]},
ProjectedWith->{metric[i2,-i1]},
ProtectNewSymbol->False,
Master->metric,
DefInfo->{"acceleration vector","Associated to vector "<>ToString[vector]},
TensorID->{Acceleration,vector}];
(* Relations among them and the derivatives. Improved by Thomas, to use HasOrthogonalIndexQ *)
GradNormalToExtrinsicKRules[metric]={
superCD[a_][vector[b_]]:>$ExtrinsicKSign extrinsicKname[a,b]+$AccelerationSign vector[a]accelerationname[b],vector[-a_]superCD[b_][expr_]:>-superCD[b][vector[-a]]expr/;HasOrthogonalIndexQ[expr,vector[-a]],
vector[a_]superCD[b_][expr_]:>-superCD[b][vector[a]]expr/;HasOrthogonalIndexQ[expr,vector[a]],LieD[vector[_]][expr_]vector[-a_]:>-$AccelerationSign norm accelerationname[-a]expr/;HasOrthogonalIndexQ[expr,vector[-a]](*,LieD[vector[_]][expr_]vector[a_]:>0/;HasOrthogonalIndexQ[expr,vector[a]]*)
};
ExtrinsicKToGradNormalRules[metric]=extrinsicKname[a_,b_]:>Module[{c=DummyIn@vbundle},$ExtrinsicKSign (supermetric[a,c]superCD[-c][vector[b]]-$AccelerationSign vector[a]accelerationname[b])];
(* Projectors and metrics *)
ProjectorToMetricRules[metric]=metric[i1_,i2_]->supermetric[i1,i2]-vector[i1]vector[i2]/norm;
MetricToProjectorRules[metric]=supermetric[i1_,i2_]->metric[i1,i2]+vector[i1]vector[i2]/norm;

(* Define projector inert-head *)
DefInertHead[projectorname,
LinearQ->True,
Master->metric,
PrintAs:>GiveOutputString[Projector,metric],
ProtectNewSymbol->False,
DefInfo->{"projector inert-head",""}];
projectorname[supermetric[a_,b_]]:=metric[a,b];
(* The metric, but not the supermetric, can be contracted through the projector *)
xTagSet[{projectorname,ContractThroughQ[projectorname,metric]},True];
(* The supermetric is converted into metric when contracted with the projector or covd *)
xTagSetDelayed[{projectorname,supermetric[i1_,i2_]projectorname[expr_]},metric[i1,i2]projectorname[expr]/;Or[IsIndexOf[expr,-i1,metric],IsIndexOf[expr,-i2,metric]]];
xTagSetDelayed[{covd,supermetric[i1_,i2_]covd[i3_][expr_]},metric[i1,i2]covd[i3][expr]/;Or[IsIndexOf[covd[i3][expr],-i1,metric],IsIndexOf[covd[i3][expr],-i2,metric]]];
(* Projection rule with vector *)
xTagSetDelayed[{projectorname,vector[i_]projectorname[expr_]},0/;IsIndexOf[expr,-i,metric]];
(* Particular cases *)
projectorname[1]:=1;
projectorname[rest_. x_?ScalarQ]:=Scalar[x]projectorname[rest];
projectorname[vector[i_]expr_.]:=0/;Not@IsIndexOf[expr,-i,supermetric];
projectorname[projectorname[expr_]]:=projectorname[expr];
projectorname[tensor_?xTensorQ[inds__]]:=tensor[inds]/;OrthogonalToVectorQ[vector][tensor];
projectorname[covd[k_][expr_]]:=covd[k][expr];
ProjectDerivativeRules[covd]={covd[i_][expr_]:>If[IsIndexOf[expr,-i],
With[{dummy=DummyAs[i]},metric[i,-dummy]projectorname[superCD[dummy][expr]]],
projectorname[superCD[i][expr]]
]};

Module[{prot=Unprotect[covd]},
(* Leibnitz rule. Three cases considered *)
covd[i1_][x_Scalar y_Scalar]:=x covd[i1][y]+y covd[i1][x];
(* Special definitions suggested by Cyril *)
covd[i1_][supermetric[a_?AIndexQ,b_?AIndexQ]]:=0;
(*    Cyril suggests removing the OrthogonalToVectorQ check to handle the many-supermetrics case *)
covd[i1_][x_ supermetric[a_?AIndexQ,b_?AIndexQ]]:=metric[a,b]covd[i1][x]/;OrthogonalToVectorQ[vector][x];
covd[i1_][x_ delta[a_?AIndexQ,b_?AIndexQ]]:=metric[a,b]covd[i1][x]/;OrthogonalToVectorQ[vector][x];
covd[i1_][vector[a_?AIndexQ]vector[b_?AIndexQ]x_.]:=0/;And[!IsIndexOf[x,ChangeIndex@a],!IsIndexOf[x,ChangeIndex@b],!PairQ[a,b]];
(* Product of two, perhaps contracted, expressions *)
covd[i1_][x_ y_]:=Module[{res},
res=Which[
(* Both are orthogonal in all their indices. We can use the Leibnitz rule *)
OrthogonalToVectorQ[vector][x]&&OrthogonalToVectorQ[vector][y],
covd[i1][x]y+covd[i1][y]x,
(* The expression is not globally orthogonal: complain and return unevaluated *)
Not@OrthogonalToVectorQ[vector][x y],
Message[Validate::nonproj,x y];$Failed,
(* Expression is orthogonal, but factors are not. Avoid infinite recursion with this hack *)
FreeQ[{x,y},vector],
covd[i1][Expand@GradNormalToExtrinsicK@Expand[InducedDecomposition[x,{metric,vector}]InducedDecomposition[y,{metric,vector}]]],
(* This should never happen *)
True,
$Failed
];
res/;res=!=$Failed
];
(* Induced derivatives of non-spatial objects are not accepted, not even divergencies *)
covd[_?GIndexQ][expr_]:=$Failed/;Not@isProductQ[Head[expr],Times]&&Not@OrthogonalToVectorQ[vector][expr]&&Message[Validate::nonproj,expr];
Protect[Evaluate[prot]];
];

(* Special definitions *)
metric/:LieD[vector[_]][metric[-a_Symbol,-b_Symbol]]:=$ExtrinsicKSign(extrinsicKname[-a,-b]+extrinsicKname[-b,-a]);
metric/: LieD[vector[_]][metric[a_Symbol,-b_Symbol]]:=-$AccelerationSign accelerationname[-b]vector[a];
metric/: LieD[vector[_]][metric[-a_Symbol,b_Symbol]]:=-$AccelerationSign accelerationname[-a]vector[b];
metric/:LieD[vector[_]][metric[a_Symbol,b_Symbol]]:=-$ExtrinsicKSign(extrinsicKname[a,b]+extrinsicKname[b,a])-$AccelerationSign(vector[a]accelerationname[b]+vector[b]accelerationname[a]);
vector/: LieD[vector[_]][vector[a_Symbol]]:=0;
vector/: LieD[vector[_]][vector[-a_Symbol]]:=$AccelerationSign norm accelerationname[-a];
Module[{prot=Unprotect[{superepsilonname,epsilonname}]},
superepsilonname/: LieD[vector[_]][superepsilonname[inds__?DownIndexQ]]:=Module[{dummy=DummyIn[vbundle]},$ExtrinsicKSign extrinsicKname[dummy,-dummy]superepsilonname[inds]];
superepsilonname/: LieD[vector[_]][superepsilonname[inds__?UpIndexQ]]:=Module[{dummy=DummyIn[vbundle],first=First[{inds}]},-$ExtrinsicKSign extrinsicKname[dummy,-dummy]superepsilonname[inds]];
epsilonname/: LieD[vector[_]][epsilonname[inds__?DownIndexQ]]:=Module[{dummy=DummyIn[vbundle]},$ExtrinsicKSign extrinsicKname[dummy,-dummy]epsilonname[inds]];
epsilonname/: LieD[vector[_]][epsilonname[inds__?UpIndexQ]]:=Module[{dummy=DummyIn[vbundle],first=First[{inds}]},-$ExtrinsicKSign extrinsicKname[dummy,-dummy]epsilonname[inds]+$AccelerationSign norm accelerationname[-dummy]superepsilonname[dummy,inds]];
Protect[Evaluate[prot]]
];
];

(* Gauss Codazzi rule, for abstract indices. Only for Riemann. Norms are wrong *)
With[{riemann=Riemann[covd],superRiemann=Riemann[superCD],superRicci=Ricci[superCD],superRicciScalar=RicciScalar[superCD],K=extrinsicKname,AA=accelerationname},
GaussCodazziRules[metric]:={superRiemann[a_?AIndexQ,b_?AIndexQ,c_?AIndexQ,d_?AIndexQ]:>Module[{e=DummyIn@vbundle,PDK},
PDK[x_,y_]:=projectorname[vector[e] superCD[-e]@K[x,y]];
riemann[a,b,c,d]+$RiemannSign(-K[a,c] K[b,d]/norm+K[a,d] K[b,c]/norm-AA[b] AA[d] vector[a] vector[c]/norm-K[b,e] K[d,-e] vector[a] vector[c]/norm^2+AA[a] AA[d] vector[b] vector[c]/norm+K[a,e] K[d,-e] vector[b] vector[c]/norm^2+AA[b] AA[c] vector[a] vector[d]/norm+K[b,e] K[c,-e] vector[a] vector[d]/norm^2-AA[a] AA[c] vector[b] vector[d]/norm-K[a,e] K[c,-e] vector[b]vector[d]/norm^2+$ExtrinsicKSign (vector[b] vector[c]PDK[a,d]/norm^2+vector[a] vector[d]PDK[b,c]/norm^2-vector[a] vector[c]PDK[b,d]/norm^2-vector[b] vector[d]PDK[a,c]/norm^2 +vector[d] covd[a]@K[b,c]/norm-vector[c] covd[a]@K[b,d]/norm-vector[d] covd[b]@K[a,c]/norm+vector[c] covd[b]@K[a,d]/norm+vector[b] covd[c]@K[a,d]/norm-vector[a] covd[c]@K[b,d]/norm-vector[b] covd[d]@K[a,c]/norm+vector[a] covd[d]@K[b,c]/norm)+$AccelerationSign (vector[b] vector[d] covd[c]@AA[a]/norm-vector[a] vector[d] covd[c]@AA[b]/norm-vector[b] vector[c] covd[d]@AA[a]/norm+vector[a] vector[c] covd[d]@AA[b]/norm))],
superRicci[a_?AIndexQ,b_?AIndexQ]:>Module[{c=DummyIn@vbundle},ReleaseHold[Hold[superRiemann[a,-c,b,c]]/.GaussCodazziRules[metric]]],
superRicciScalar[]:>Module[{a=DummyIn@vbundle,b=DummyIn@vbundle},Expand[(metric[a,b]+vector[a]vector[b]/norm)ReleaseHold[Hold[superRicci[-a,-b]]/.GaussCodazziRules[metric]]]]}
];

If[$ProtectNewSymbols,Protect[extrinsicKname,accelerationname,projectorname]];

]
];
VectorOfInducedMetric[metric_Symbol?MetricQ]:=Null;
VectorOfInducedMetric[x_]:=Throw@Message[VectorOfInducedMetric::unknown,"induced metric",x];
SetNumberOfArguments[VectorOfInducedMetric,1];
Protect[VectorOfInducedMetric];

14.3.3. More on induced metrics

deflistableCovDs[ProjectDerivative];

deflistableMetrics[function_]:=With[{rules=SymbolJoin[function,"Rules"]},
function[expr_]:=function[expr,$Metrics];
function[expr_,list_List]:=Fold[function,expr,list];
function[expr_,metric_Symbol?MetricQ]:=expr/.rules[metric];
SetNumberOfArguments[function,{1,2}];
Protect[function];]
deflistableMetrics/@{MetricToProjector};

$Projectors:=Select[$Metrics,(InducedFrom[#]=!=Null)&]

deflistableProjectors[function_]:=With[{rules=SymbolJoin[function,"Rules"]},
function[expr_]:=function[expr,$Projectors];
function[expr_,list_List]:=Fold[function,expr,list];
function[expr_,metric_Symbol?MetricQ]:=expr//.rules[metric];
SetNumberOfArguments[function,{1,2}];
Protect[function];]
deflistableProjectors/@{ExtrinsicKToGradNormal,GradNormalToExtrinsicK,ProjectorToMetric,GaussCodazzi};

Note that deflistableProjects uses //. while deflistableMetrics and deflistableCovDs use /.

MetricToProjectorRules[_]:={};
ProjectorToMetricRules[_]:={};
ExtrinsicKToGradNormalRules[_]:={};
GradNormalToExtrinsicKRules[_]:={};
ProjectDerivativeRules[_]:={};

project[projector_][expr_,index_]:=Module[{dummy=DummyAs[index]},projector[index,-dummy]ReplaceIndex[expr,index->dummy]]

ProjectWith[projector_][0]:=0;
ProjectWith[projector_][expr_]:=Expand@Fold[project[projector],expr,List@@FindFreeIndices[expr]];
Protect[ProjectWith];

14.3.4. InducedDecomposition

This rather complicated construction decomposes all tensors in a given expression in their projected and orthogonal parts. The main idea is that in the pairs n[a]n[b] one of the vectors will be finally inside a projector and the other one will be outside the projector. The inout constructs contain two indices: the index of n inside the projector and the index of n outside the projector.

(* Pair of indices for the pair vector[.]vector[.] *)
pair[index_]:={1,inout[index,DummyAs[index]]};
(* vectors inside the projector *)
inside[inouts_,vector_]:=inouts/.inout[_,index_]:>vector[ChangeIndex@index];
(* vectors outside the projector *)
outside[inouts_,vector_]:=inouts/.inout[index_,_]->vector[index];
(* Index rules to change indices of expr *)
inoutrules[1]:={};
inoutrules[inouts_]:=ListOfFactors[inouts]/.inout->Rule;
(* Construct expression inside the projector *)
inoutproject[expr_,inouts_,vector_]:=ReplaceIndex[expr,inoutrules[inouts]]inside[inouts,vector]
(* Construct a term v*v*...*projector[v*v*...*expr] *)
inoutlength[1]:=0;
inoutlength[_inout]:=1;
inoutlength[list__Times]:=Length[list];
inoutall[expr_,projector_,vector_,norm_][inouts_]:=projector[inoutproject[expr,inouts,vector]]outside[inouts,vector]/norm^(inoutlength[inouts])

User driver (metric is the induced metric):

InducedDecomposition[expr_,{metric_,vector_}]:=
inducedDecomposition[Expand[expr],{Projector[metric],vector,normofvector[vector,metric]}];
SetNumberOfArguments[InducedDecomposition,{2,Infinity}];
Protect[InducedDecomposition];

Internal functions for decomposition:

normofvector[vector_,metric_]:=With[{vbundle=VBundleOfMetric[metric]},Module[{dummy1=DummyIn[vbundle],dummy2=DummyIn[vbundle]},Scalar[ContractMetric[FirstMetricOfVBundle[vbundle][-dummy1,-dummy2]vector[dummy1]vector[dummy2]]]]];

(* Recursive *)
inducedDecomposition[expr_Plus,struct_]:=inducedDecomposition[#,struct]&/@expr;
inducedDecomposition[expr_SeriesData,struct_]:=SeriesDataMap[inducedDecomposition[#,struct]&,expr];
inducedDecomposition[expr_Times,struct_]:=inducedDecomposition[#,struct]&/@expr;
inducedDecomposition[expr:_?ProductQ[___],struct_]:=inducedDecomposition[#,struct]&/@expr;
(* Perform actual decomposition *)
inducedDecomposition[expr:_?xTensorQ[__],struct_]:=inducedDecompositionObject[expr,struct];
inducedDecomposition[expr:_?InertHeadQ[_,z___],struct_]:=inducedDecompositionObject[expr,struct];
inducedDecomposition[expr:_?FirstDerQ[_],struct_]:=inducedDecompositionObject[expr,struct];
(* Other cases *)
inducedDecomposition[expr_,struct_]:=expr;

inducedDecompositionObject[expr_,{projector_,vector_,norm_}]:=Module[{frees=FindFreeIndices[expr]},If[frees===IndexList[],expr,
Plus@@Map[inoutall[expr,projector,vector,norm],Flatten@Outer[Times,Sequence@@(pair/@frees)]]]];

It is not clear how to use this function on subexpressions (Apr 2011, added LieD as suggested by Cyril):

ToInducedDerivative[expr_,supercd_,cd_]:=
With[{indmetric=MetricOfCovD[cd]},With[{vector=Last@InducedFrom[indmetric]},expr/.supercd[ind_][expr1:(_?xTensorQ[___]|_?InertHeadQ[___]|cd[_][_]|LieD[_][_])]:>With[{frees=FindFreeIndices[expr1],norm=normofvector[vector,MetricOfCovD[supercd]]},cd[ind][expr1]+With[{dummy=DummyAs[ind]},vector[ind]/norm DirCovDToLieD[vector[-dummy] supercd[dummy][expr1],vector]]-$ExtrinsicKSign/norm Plus@@(With[{dummy2=DummyAs[#]},vector[#]ExtrinsicK[indmetric][ind,-dummy2]ReplaceIndex[expr1,#->dummy2]]&/@frees)/;OrthogonalToVectorQ[vector][expr1]
]
]
];
SetNumberOfArguments[ToInducedDerivative,3];
Protect[ToInducedDerivative];

14.3.5. Examples

BeginExamples[]

$Tensors

DefTensor[T[A,B],M2]

DefMetric[-1,metricg[-A,-B],CD,{";","D"}]

DefTensor[u[A],M2,FrobeniusQ->True,ProtectNewSymbol->False]

Normalization:

u/:u[A_]u[-A_]:=hello

u/:metricg[-A_,-B_]u[A_]u[B_]:=hello

Induced metric:

DefMetric[1,h[-A,-B],cd,{"|","D"},InducedFrom->{metricg,u}]

Decompositions:

InducedDecomposition[T[A,B,C],{h,u}]//ScreenDollarIndices

u[-A]%//Expand

u[-B]%//Expand

u[-C]%//Expand

%/.hello->1

However, this is not terribly smart (though the expression is syntactically incorrect):

Projectorh[T[A,B]u[-A]]u[-A]

Any product is decomposed into a sum of products of vectors and projected objects. Note that scalars are wrapped with Scalar and not with the projector inert-head:

(InducedDecomposition[T[-B,-A]T[B],{h,u}]//Expand//ScreenDollarIndices)/.hello->1

(InducedDecomposition[u[A],{h,u}]//Expand//ScreenDollarIndices)/.hello->1

(InducedDecomposition[T[A,C]u[B],{h,u}]//Expand//ScreenDollarIndices)/.hello->1

Catch@cd[-B][%]

Note this:

Catch@cd[-A][T[B]T[C]]

hello=1;

TODO: Solve this recursion problem:

cd[-A][T[B]T[-B]]//ScreenDollarIndices

ServantsOf[h]

UndefMetric[h]

UndefMetric[metricg]

UndefTensor/@{T,u};

Remove[hello];

EndExamples[]

14.3.7. Contraction with induced metrics

BeginExamples[]

Use Choptuik's conventions:

$ExtrinsicKSign=+1;
$AccelerationSign=-1;

DefMetric[-1,metricg[-A,-B],CD,{";","▽"},PrintAs->"g"]

DefTensor[u[A],M2,FrobeniusQ->True,ProtectNewSymbol->False]

AutomaticRules[u,MakeRule[{metricg[-A,-B]u[A]u[B],-1}]]

u/:u[A_]u[-A_]:=-1

DefMetric[1,h[-A,-B],cd,{"|","D"},InducedFrom->{metricg,u}]

?Accelerationu

Riemanncd[A,B,C,-A]//ContractMetric

h[-A,B]

ExtrinsicKh[A,B]u[-B]

Riemanncd[-A,-B,-C,-D]u[D]

CD[-A][u[B]]

%//GradNormalToExtrinsicK

h[-B,-D]h[-C,A]%//ContractMetric

%//ExtrinsicKToGradNormal//ScreenDollarIndices

%//ContractMetric

h[A,B]

ProjectorToMetric[%,h]

MetricToProjector[%,h]

cd[-A][ExtrinsicKh[-B,-C]]

ProjectDerivative[%,cd]

%/.Projectorh->ProjectWith[h]//ScreenDollarIndices

%//ProjectorToMetric

%//Expand

InducedDecomposition[cd[-A][ExtrinsicKh[-B,-C]],{h,u}]

We define two spatial vectors:

DefTensor[v[-A],M2,OrthogonalTo->{u[A]}]

DefTensor[w[-A],M2,OrthogonalTo->{u[A]}]

v[A]u[-A]

v[-A]u[A]

First derivatives:

ProjectWith[h][CD[-A][v[-B]]]//ProjectorToMetric//Expand//GradNormalToExtrinsicK//Expand//ScreenDollarIndices

-%+CD[-A][v[-B]]-u[-B]v[-C]CD[-A][u[C]]+u[-A]u[C]CD[-C][v[-B]]-u[-A]u[-B]v[-C]Accelerationu[C]//GradNormalToExtrinsicK//Expand

Second derivatives:

Projectorh[CD[-D][CD[-C][v[-B]]]]-cd[-D][cd[-C][v[-B]]]//ProjectDerivative//ProjectDerivative

%/.Projectorh->ProjectWith[h]//ScreenDollarIndices

%//ProjectorToMetric//Expand

%//GradNormalToExtrinsicK//Expand//ContractMetric//ScreenDollarIndices

UndefMetric[h]

UndefTensor/@{u,v,w};

UndefMetric[metricg]

$Tensors

EndExamples[]

14.4. Derivatives on metrics

14.4.1. ZeroDerOnMetricQ

Construct a metric tensor:

buildmetric[metric_]:=Apply[metric,-IndicesOfVBundle[VBundleOfMetric@metric][[1,{1,2}]]];

First we need a function which tells us if a derivative anihilates a metric or not. We define it with remembered values (upvalues for the metric). This function seems redundant with ZeroDerivativeQ and hence should be eliminated, leaving only an adequate mixture, but seems quite some work.

(* Safety definition *)
ZeroDerOnMetricQ[der_,Null]:=(Print["Checking ",der," on metric Null"];True);
(* Parametric derivatives. Different parameters commute *)
ZeroDerOnMetricQ[OverDot,metric_]:=xTagSet[{metric,ZeroDerOnMetricQ[OverDot,metric]},SameQ[OverDot[buildmetric[metric]],0]];
ZeroDerOnMetricQ[ParamD[par_],metric_]:=xTagSet[{metric,ZeroDerOnMetricQ[ParamD[par],metric]},SameQ[ParamD[par][buildmetric[metric]],0]];
ZeroDerOnMetricQ[ParamD[pars__],metric_]:=Apply[Or,ZeroDerOnMetricQ[ParamD[#],metric]&/@{pars}];
(* Lie derivatives *)
ZeroDerOnMetricQ[LieD[canv_],metric_]:=xTagSet[{metric,ZeroDerOnMetricQ[LieD[canv],metric]},SameQ[LieD[canv][buildmetric[metric]],0]];
(* Covariant derivatives with CD-indices: store index *)
ZeroDerOnMetricQ[covd_?CovDQ[ind__?CDIndexQ],metric_]:=ZeroDerOnMetricQ[derwithindex[covd,ind],metric];
ZeroDerOnMetricQ[derwithindex[covd_,ind__],metric_]:=xTagSet[{metric,ZeroDerOnMetricQ[derwithindex[covd,ind],metric]},SameQ[CheckZeroDerivative[covd[ind][buildmetric[metric]]],0]];
(* Other covariant derivatives: store vbundle *)
ZeroDerOnMetricQ[covd_?CovDQ[ind_?ABIndexQ],metric_]:=ZeroDerOnMetricQ[deronvbundle[covd,VBundleOfIndex[ind]],metric];
ZeroDerOnMetricQ[deronvbundle[covd_,vbundle_],metric_]:=xTagSet[{metric,ZeroDerOnMetricQ[deronvbundle[covd,vbundle],metric]},True]/;SameQ[CovDOfMetric[metric],covd];
ZeroDerOnMetricQ[deronvbundle[covd_,vbundle_],metric_]:=With[{tmpmetric=changetoinducedmetric[covd,metric]},xTagSet[{metric,ZeroDerOnMetricQ[deronvbundle[covd,vbundle],metric]},ZeroDerOnMetricQ[deronvbundle[covd,vbundle],tmpmetric]]/;tmpmetric=!=metric];
ZeroDerOnMetricQ[deronvbundle[covd_,vbundle_],metric_]:=xTagSet[{metric,ZeroDerOnMetricQ[deronvbundle[covd,vbundle],metric]},SameQ[CheckZeroDerivative[covd[-DummyIn[vbundle]][buildmetric[metric]]],0]];
(* Multi-index derivative *)
ZeroDerOnMetricQ[covd_?CovDQ[inds__],metric_]:=SameQ[CheckZeroDerivative[covd[inds][buildmetric[metric]]],0];

It might happen that we are comparing an induced derivative with the corresponding ambient metric. In that case we change to the induced metric. I don't remember why we do this.

changetoinducedmetric[covd_,metric_]:=changetoinducedmetric[covd,metric,MetricOfCovD[covd]];
changetoinducedmetric[covd_,metric_,Null]:=metric;
changetoinducedmetric[covd_,metric_,metric2_]:=changetoinducedmetric[covd,metric,metric2,InducedFrom[metric2]];
changetoinducedmetric[covd_,metric_,metric2_,{metric_,_}]:=metric2;
changetoinducedmetric[covd_,metric_,metric2_,_]:=metric;

Internal notation for the downvalues of ZeroDerOnMetricQ:

sortder[OverDot]:=OverDot;
sortder[ParamD[pars__]]:=ParamD[pars];
sortder[LieD[v_]]:=LieD[ToCanonicalDir[v]];
sortder[covd_?CovDQ[ind_?CDIndexQ]]:=derwithindex[covd,ind];
sortder[covd_?CovDQ[ind_]]:=deronvbundle[covd,VBundleOfIndex[ind]];

This is the main function, which decides whether we must be careful with derivatives when canonicalizing an expression. There are currently no options. With $MixedDers=False the careQ check is not done.

$MixedDers=True;

DersIn[sortedexpr_Object]:=Union[sortder/@Cases[sortedexpr,MyDer[der_]->der,{0,Infinity}]];
MetricsIn[sortedexpr_Object]:=FirstMetricOfVBundle/@Select[Union[VBundleOfIndex/@Apply[List,First@Last[sortedexpr]]],MetricEndowedQ];
riskydermetricQ[der_,metric_]:=If[ZeroDerOnMetricQ[der,metric],Null,risk[der,metric]];
BasesIn[sortedexpr_Object]:=Union[Cases[sortedexpr,({_,_.basis_?BasisQ}):>basis,{0,Infinity}]];
riskyderbasisQ[derwithindex[der_,_],basis_]:=riskyderbasisQ[der,basis];
riskyderbasisQ[der_,basis_]:=If[der===xAct`xCoba`PDOfBasis[basis],Null,risk[der,basis]];
RiskyDers[sortedexpr_Object]:=With[{dersin=DersIn[sortedexpr]},
Cases[Union@Join[
Flatten@Outer[riskydermetricQ,dersin,MetricsIn[sortedexpr]],Flatten@Outer[riskyderbasisQ,dersin,BasesIn[sortedexpr]]
],_risk]
];

careQ[sortedexpr_Object,options___]:=RiskyDers[sortedexpr]=!={};

Feb 2013. Dietmar Theiss has reported this problem. I extend RiskyDers to handle bases, but it is not enough. This needs a deeper fix in the canonicalizer.

DefTensor[T[-a,b],M]

T[-e,{f,chart}]T[{-f,-chart},i]PD[-g][T[-h,-i]]

ToCanonical[%]

14.5. Correcting characters

A simpler form of SeparateMetric is SetCharacters, which corrects the characters of the indices of a tensor:

SetCharacters[expr_,tensor_?xTensorQ,chars_List]:=expr/.rest_. tensor[inds__]:>setcharacters[rest,tensor[inds],chars/.{Up->1,Down->-1}];
SetCharacters[expr_,tensor_?xTensorQ]:=SetCharacters[expr,tensor,SlotsOfTensor[tensor]/.{-_Symbol->-1,_Symbol->1}];
SetCharacters[expr_,list_List]:=Fold[SetCharacters,expr,list];
SetCharacters[expr_]:=SetCharacters[expr,Head/@FindAllOfType[expr,Tensor]];
SetNumberOfArguments[SetCharacters,{1,3}];
Protect[SetCharacters];

setcharacters[rest_,tensor_[inds__],chars_]:=Module[{deltas,newinds=chars (DummyIn[VBundleOfIndex[#]]&/@{inds})},
deltas=Inner[delta,IndexList[inds],ChangeIndex/@IndexList@@newinds,Times];
ContractMetric[rest deltas]tensor@@newinds]

15. Symmetries and canonicalization. Continue here with SeriesData

(****************** 15.Symmetries and canonicalization ****************)

{TimeUsed[],SessionTime[],TimeUsed[]/SessionTime[]}

15.0. Comments

If[$ReadingVerbose,Print["Reading section 15: Symmetries and canonicalization."],Null,Null]

Main ideas:

As usual, it is important to distinguish between the processes of canonicalization and simplification. The former is well defined once a canonical form has been decided for a generic expression, while the latter is largely subjective. There is no distinction, however, in Mathematica, which only gives the command Simplify. In xTensor we construct ToCanonical, adding the canonicalization algorithms for tensors, and then construct 
	Simplification[ expr ] := Simplify[ ToCanonical[ expr ] ].
The main objective of this section is actually constructing ToCanonical, by far the most powerful and complex function in the system. That will be done in three steps, whose combination forms the basic structure of ToCanonical:

1) First, we have to define some ordering for general expressions, regardless of the indices in that expression. That requires defining the most general expression we shall work with:
	- An expression is assumed to be formed by a sum of (maybe one) terms, each one to be canonicalized independently, but sharing first the same dummies.
	- Each term is assumed to be a product of (maybe one) monomials, each one to be canonicalized independently.
	- A monomial is assumed to be a product of (maybe one) objects (tensors, forms, covariant derivatives, Lie derivatives, variational derivatives or inert heads), which can be contracted among them. Of course, scalar functions, Scalar expressions, constant symbols and parameters cannot be contracted and hence they form monomials. Objects can be "commuting" if they are "equal" under the sorting algorithm.

Since version 1.1.0 we can have several different products, and we need to sort them and their factors following the properties of those products.

A question pointed out by Bernd Brügmann is whether it is possible to canonicalize an expression without expanding it first. I don't really know. My impression is that it wouldn't be possible to canonicalize a whole expression, but perhaps it is possible to ensure canonicalization at some lower local level.

The function responsible for expression sorting is called xSort.

2) Once we have sorted the expression, we number its slots and construct a strong generating set for the slot-symmetries of the expression. This is done by the function SymmetryOf. There is still the big problem of the meaning of the symmetry of a sum of expressions.

3) Finally, given the actual configuration of indices, the canonical order for those indices (use IndexSort) and the slot-symmetries and dummy-symmetries of the expression, we can reorder the indices to construct the canonical form of that expression under the monoterm symmetries. This is done by the function ToCanonicalOne, which calls CanonicalPerm in xPerm, the hard part of the index canonicalization.

There is a final minor step reducing the number of different dummy indices in the (sum) expression to a minimum (with SameDummies).

Comments:

1) One of the most confusing things here is the order of application of permutations. We shall assume the following convention. Given a set of indices, we shall assume that IndexSort gives the Canonical Configuration (CC) of indices. Those indices can be the indices of a tensor, ordered in some particular way, that we shall call the Actual Configuration (AC). There is a permutation g such that
					CC . g = AC
(Note that the permutation acts on the right of CC). We can think of two different sets: the set of indices (names) and the set of slots (numbers). A given permutation g gives how the indices must be assigned to the set of slots. In this sense CC lives in the world of indices, while AC lives in the world of slots. We could assign g dimensions of slots / indices. The group of symmetries of slots (what we usually call S) is a mapping from slots to slots and the group of symmetries of indices (what we usually call D) is a mapping from indices to indices. That means that the right way to order permutations is DgS, which is precisely the opposite to that used by Renato. Bad luck! This used to be also the convention in xPerm, but starting version 0.6 xPerm has changed to Renato's convention. This has several advantages (the documentation of xPerm is now easier to read, the comparison with the papers is simpler, and the code in xPerm is actually simpler). There are simply two InversePerm at the input and the output of the only call to CanonicalPerm in xTensor to correct this point.

2) A generic expression may involve many objects with indices in several vbundles, with several metrics and different derivatives. It may also have bases on those vbundles, or directions. It is clear that canonicalizing the whole thing is a tough task. General comments:
	- Having several metrics on the same vbundle is not a problem. All but the first metrics are frozen and can be considered as any other tensor. Hence, from the point of view of canonicalization, having more metrics is not a problem, as long as we follow the rules for frozen metrics.
	- Concerning bases and directions, we should be able to detect when there are potential problems. In those cases we shall separate bases and directions, letting the expression to expand. Still, there are basis or component indices in Basis expressions, but I guess those will not be problematic because they will be multiplying expressions, and the canonicalizer will not want to move them to objects other than Basis. Note that if there are multiple derivatives of a Basis object, we will need to separate basis indices several times.
	- It is not clear to me whether we can let a metric of a vbundle to be a scalar field on other vbundles. Currently this is not allowed.
	- The main problem is then that of derivatives which do not anihilate a metric. The function ZeroDerOnMetricQ has been introduced to handle that point.
	- In general this section works with all types of indices. There could be problems with basis-indices and the symmetries of derivatives. The function STFPart does not worry about basis-indices (there is an AIndexQ selection) or non-metric derivatives.

15.1. Sorting objects

15.1.0. Comments

We start by defining a parser from the user notation to the internal notation which will be used for canonicalization. Most of this is actually redundant with previous parts of the code (for example the recollection of indices is not done using FindIndices, etc). This serves a double purpose: first, we want to immediately deconstruct the expressions into symbols so that the user cannot access them anymore, to avoid interferences during the canonicalization process. Second, we want to have something efficient, and this new type of coding avoids recomputation of the internal structure of the objects involved. Note that Identify is also acting as a validation routine and actually we throw some messages, associating them to Validate.

The parser produces two types of descriptions:
	- a characterization for object ordering independent of indices,
	- a characterization of the index structure of the object.
The Object structure is
	Object[object, {type, symorder, name}, {allindices, frees, dummies, blocked, metricstates}]

There are these types, sorted alphabetically:
	Constant
	ConstantSymbol
	Parameter
	Scalar
	Tensor
The integer symorder gives the order of the group of slot-symmetries, and name is a unique name for the expression, not containing indices.

Concerning indices, we need this information on the slots of the tensor (called the "metric-state" of the index):
	- The vbundle of the index in the slot.
	- Whether there is a metric in that vbundle.
	- Whether there is a derivative (or an inert-head) blocking the action of that metric.
The vbundle will be, say, -TangentM4. Then we store the metric: {-TangentM4, g} or {-TangentM4, Null} if there is no metric. Then we have to store the blocking derivative: {-TangentM4, g, PD[-i]}. This information will be used to check whether two objects are really commuting or not, and to check whether we can freely move indices up and down, or else we need to use a more cautious algorithm for canonicalization.

There are elements which must be canonicalized at some point. These are either scalars (in Scalar expressions or scalar-functions) or directions (Dir-indices or directions in Lie-derivatives or Lie-brackets):

Products can have different commutativity properties. This is important for two reasons:

1) Factors must be reordered into a canonical form. Exchanging pairs may lead to a sign. We need a function that is able to determine those signs.

2) The presence of commutativiy properties in the products of indexed quantities induces new index symmetries in the expressions.

15.1.1. Scalars, vectors and Dir indices

These are three private special forms of ToCanonical, to canonicalize isolated indexed expressions. The functions ToCanonicalScalar and ToCanonicalDir functions require options, and to avoid having options in Identify we pass them through a blocked global variable $TCOptions from xSort. Note that these three special cases replace the dummy indices by proper user-defined indices. The ultraindex is always replaced by the first of the user-defined indices (considered the “nicest” index).

(* Default for $TCOptions *)
$TCOptions={};
(* Canonical form for a scalar (with or without Scalar head) *)
ToCanonicalScalar[Scalar[expr_]]:=Scalar[ToCanonicalScalar[expr]];
ToCanonicalScalar[expr_]:=ReplaceDummies[ToCanonical[expr,$TCOptions],IndexList@@$AbstractIndices];
(* Canonical form for a direction (with or without Dir head) *)
ToCanonicalDir[Dir[expr_]]:=Dir[ToCanonicalDir[expr]];
ToCanonicalDir[expr_]:=With[{indices=IndexList@@$AbstractIndices,index=UltraindexOf[expr]},
Simplify@ReplaceIndex[
ReplaceDummies[ToCanonical[expr,$TCOptions],Rest[indices]],index:>If[UpIndexQ[index],UpIndex,DownIndex][First[indices]]
]
];
(* Canonicalize Dir indices in the expression *)
ToCanonicalIndex[expr_]:=expr/.v_Dir:>ToCanonicalDir[v];

15.1.2. Identify elementary objects

The key idea is to convert expr into Object[expr, info] were the info will be later used to give the expr a canonical form. More precisely an Object has the form:

	Object[ expr, {type, sym, name}, index-info ]

The function Identify accepts any input and returns an Object. The expr in the first argument of Object has the products deactivated using VerbatimProduct[prod][ exprs ] instead of prod[ exprs ], in order to hide the attributes and definitions of the product. Factors that can commute are also marked with CommutingObjects[prod][ exprs ]. Identify replaces Plus by VerbatimPlus sum of those, again to avoid Plus to work too early.

isProductQ[prod_,prod_]:=True;
isProductQ[VerbatimProduct[prod_],prod_]:=True;
isProductQ[CommutingObjects[prod_],prod_]:=True;
isProductQ[_,prod_]:=False;

0) "Metric-state" of indices. This function returns the (signed) vbundle of the slot of the index, with the metric which could make it change character, or Null if there is no metric. Derivatives that may block the action of the metric are appended. Inert heads (like Perturbation in xPert) can also block the action of a metric.

(* Metric state of an index *)
metricstate[index_]:=metricstate1[SignedVBundleOfIndex[index]];
metricstate1[vbundle_]:={vbundle,FirstMetricOfVBundle[vbundle,False]};
(* Modification induced by a derivative *)
metricderstate[{vbundle_,Null},der_]:={vbundle,Null};
metricderstate[{vbundle_,metric_},der_]:=If[ZeroDerOnMetricQ[der,metric],{vbundle,metric},{vbundle,metric,der}];
metricderstate[{vbundle_,metric_,other__},der_]:={vbundle,metric,other,der};

As a result we can get:
	- {vbundle, Null}: there is no metric. Index cannot be moved.
	- {vbundle, metric}: there is a metric. Index can be moved.
	- {vbundle, metric, der1, ...}: there is a metric, but the index cannot be moved because a derivative is blocking the expression. der1 can also be an inert head.

Shortcut. Recall the notation for lists of indices { all, frees, dummies, blocked, all_states }

EmptyILs:={IndexList[],IndexList[],IndexList[],IndexList[],IndexList[]};

1) Numeric quantities and strings:

Identify[x_?NumericQ]:=Object[x,{Constant,1,x},EmptyILs];
Identify[x_String]:=Throw@Message[Validate::nouse,"Identify",x];

Identify threads over lists:

Identify[list_List]:=Identify/@list;

2) Basic structures to identify: tensors, constants, parameters. We already canonicalize D-indices, and the tensor heads, which could contain arbitrarily complicated expressions. Currently we pay no attention to the index-free (say grade) properties.

Identify[tensor_?xTensorQ[]]:=With[{t=ToCanonicalTensorHead[tensor]},Object[t[],{Tensor,1,t},EmptyILs]];
Identify[tensor_?xTensorQ[inds__]]:=
With[{ilist=ToCanonicalIndex[IndexList[inds]],t=ToCanonicalTensorHead[tensor]},
With[{free=TakeFrees[ilist],dum=TakeEPairs[ilist]},
Object[t@@ilist,{Tensor,OrderOfGroup@SymmetryGroupOfTensor[t[inds]],t},{ilist,free,dum,Complement[ilist,free,dum],metricstate/@ilist}]
]
];
Identify[cs_Symbol?ConstantSymbolQ]:=Object[cs,{ConstantSymbol,1,cs},EmptyILs];
Identify[p_Symbol?ParameterQ]:=Object[p,{Parameter,1,p},EmptyILs];

3) Derivatives (first part). Even though the derivatives obey the Leibnitz rule, it is reasonable to assume that Identify[expr] in the following lines could return a generic expression (with heads Object, VerbatimProduct[prod] or Plus), and so we must use Identify as well. We canonicalize the direction of the Lie derivative and the possible directional index in the covariant derivative:

Identify[covd_?CovDQ[ind__][expr_]]:=addderivative[ToCanonicalIndex[covd[ind]],Identify[expr]];
Identify[OverDot[expr_]]:=addderivative[OverDot,Identify[expr]];
Identify[ParamD[ps__][expr_]]:=addderivative[ParamD[ps],Identify[expr]];
Identify[LieD[v_][expr_]]:=addderivative[LieD[ToCanonicalDir[v]],Identify[expr]];

4) Manipulation of indices. There is no canonicalization here. This function appends a single index to the lists of indices:

appendindex[ind_,{allinds_,frees_,dummies_,blocked_,mstates_}]:=With[{cind=ChangeIndex[ind]},
Which[
(* Pair in free indices: add to dummies *)
MemberQ[frees,cind],
{Append[allinds,ind],DeleteCases[frees,cind],Append[Append[dummies,cind],ind],blocked,Append[mstates,metricstate[ind]]},
(* Traceable index: add to frees *)
EIndexQ[ind],
{Append[allinds,ind],Append[frees,ind],dummies,blocked,Append[mstates,metricstate[ind]]},
(* Blocked index: add to blocked *)
BlockedQ[ind],
{Append[allinds,ind],frees,dummies,Append[blocked,ind],Append[mstates,metricstate[ind]]},
True,
Throw@Message[ToCanonical::nouse,"appendindex",ind]
]
];

Combine indices in products and sums. Note that we say that the indices of T[a,b,-b]+V[a,c,-c] are {a,b,-b,c,-c}.

(* Combine indices in products *)
TimesIndices[{alls_,frees_,dums_,bls_,mss_}]:=
With[{free=Join@@frees},
If[DuplicateFreeQ[free],
With[{all=Join@@alls,newfree=TakeFrees[free],blocked=Join@@bls},
{all,newfree,Complement[all,newfree,blocked],blocked,Union@@mss}
],
Throw@Message[Validate::repeated,Complement[free,DeleteDuplicates[free]]]]
];

(* Combine indices in sums *)
PlusIndices[{alls_,frees_,dums_,bls_,mss_}]:=
If[SameQ@@(Sort/@frees),
{Union@@alls,First@frees,Union@@dums,Union@@bls,Union@@mss},
Throw@Message[Validate::inhom,"indices",frees]
];

This function finds all free indices of an expression returned by xSort. It is only used by ObjectSort, to compute the $FreesForSorting. There we cannot use the corresponding argument of Object because we need to sort before the Object is constructed!

freeindices[Object[_,_,{_,frees_,_,_,_}]]:=frees;
freeindices[CommutingObjects[_][exprs___]]:=TakeFrees[Join@@(freeindices/@{exprs})];
freeindices[VerbatimProduct[_][exprs___]]:=TakeFrees[Join@@(freeindices/@{exprs})];
freeindices[expr_VerbatimPlus]:=freeindices[First[expr]];

5) Derivatives (second part). Note that we do not change the symmetry order of the objects when adding derivatives. Now that has been changed, after the bug found by Cyril. The previous sym has been replaced by Flatten@..., which now gives a list of orders instead of an order only. This complicates things for products, sums and Lie brackets below.

dername[covd_?CovDQ[ind__]]:=covd;
dername[der_LieD]:=der;
dername[der_ParamD]:=der;
dername[OverDot]:=OverDot;
addderivative[der_,Object[object_,{type_,sym_,name_},inds_]]:=Object[
der[object],
{type,
Flatten@{sym,OrderOfGroup@Last@SymmetryOf[der[object]]},
{dername[der],name,MyDer[der]}
},
appendderindex[der,recheckmetricstates[der,inds]]
];

When appending a derivative we also need to check whether the metric-states of the indices have changed:

recheckmetricstates[der_,{allinds_,frees_,dummies_,blocked_,mstates_}]:={allinds,frees,dummies,blocked,metricderstate[#,der]&/@mstates};
appendderindex[covd_?CovDQ[ind_],inds_]:=appendindex[ind,inds];
appendderindex[covd_?CovDQ[ind_,other__],inds_]:=appendderindex[covd[other],appendindex[ind,inds]];
appendderindex[der_,inds_]:=inds;

6) Inert-heads and scalar-functions. We add the head Scalar. We consider the possibility of inert-heads with any number of arguments, but only the first one is tensorial. The expression is broken into pieces and therefore if the inerthead has a hold attribute then its argument is allowed to evaluate here (very bad... QUESTION: How can we solve this?). That is why we need to keep the whole expression all along (the first argument, x). But then the scalars of the scalarfunctions are not canonicalized... Right now we do not seem to use the x argument anyway.

SetAttributes[{addhead1A,addhead1B,addheadnA,addheadnB},HoldFirst];

The additional arguments of an inert-head could have IndexList elements, which must be canonicalized.

(* Inert-head *)
Identify[x:(ih_?InertHeadQ[expr_,z___])]:=Module[{canonz={z}/.list_IndexList:>ToCanonicalIndex[list],head},addhead1A[x,Function@@{head[#,Sequence@@canonz]}/.head->ih,expr]];
(* Scalar-function of a single argument *)
Identify[x:(sf_?ScalarFunctionQ[expr_])]:=addhead1A[x,sf,Scalar[expr]];
Identify[x:(Derivative[der_Integer][sf_?ScalarFunctionQ][expr_])]:=addhead1A[x,Derivative[der][sf],Scalar[expr]];
(* Scalar-function of several arguments *)
Identify[x:(sf_?ScalarFunctionQ[exprs___])]:=addheadnA[x,sf,Scalar/@{exprs}];
Identify[s:(Derivative[ders__Integer][sf_?ScalarFunctionQ][exprs__])]:=addheadnA[x,Derivative[ders][sf],Scalar/@{exprs}];

The metric-states of the indices of an inert-head could change due to the inert-head. That is not taken into account right now. TODO. This must be done using the ContractThrough option of the inert-head.

(* One argument. Note that the x expressions are ignored in the B step *)
addhead1A[x_,head_,expr_]:=addhead1B[x,head,Identify[expr]];
addhead1B[x_,head_,Object[object_,{type_,sym_,name_},inds_]]:=Object[head[object],{type,sym,{head,name}},inds];
(* Several arguments. The result has type1 and inds1 *)
addheadnA[x_,head_,exprs_List]:=addheadnB[x,head,Identify/@exprs];
addheadnB[x_,head_,objects:{Object[_,{type1_,sym1_,_},inds1_],__}]:=Object[head@@(First/@objects),{type1,sym1,{head,Sequence@@(objects[[All,2,-1]])}},inds1];

7) Scalar structures. Note that Scalar has type Scalar and not the type of its expression inside.

Identify[expr_Scalar]:=With[{expr1=ToCanonicalScalar[expr]},
Object[expr1,{Scalar,1,expr1},EmptyILs]
];

8) Definitions on compound expressions.

Identify[expr_Plus]:=ToObject[Identify/@VerbatimPlus@@expr];

(* Products. Identify always acts on original expressions, never on Object or VP expressions *)
Identify[expr_Times]:=ToObject[ObjectSort[Identify/@VerbatimProduct[Times]@@expr]];
Identify[expr:prod_?ProductQ[__]]:=ToObject[ObjectSort[Identify/@VerbatimProduct[prod]@@expr]];
Identify[expr:VerbatimProduct[prod_][___]]:=Throw@Message[xSort::error,"Identify on a VP. This should not happen."];

9) Default definition. Note that the error message is not thrown:

ToCanonical::noident="Unknown expression not canonicalized: `1` .";
Identify[expr_]:=(Message[ToCanonical::noident,expr];Object[expr,{ABBA,1,expr},EmptyILs]);

15.1.3. ToObject: combine objects

The function ToObject is in charge of converting products and sums of objects into an Object expression.

(* Combine symmetry orders using the *flat* operator op, Times for products or GCD for sums *)
makeList[list_List]:=list;
makeList[x_]:={x};
symListCombine[{},op_]:=Throw["Error in symListCombine"];
symListCombine[{a_},op_]:=a;
symListCombine[list_List,op_]:=With[{llist=makeList/@list},
With[{length=Max[Length/@llist]},
op@@(PadRight[#,length,1]&/@llist)
]
];

(* Handle signs *)
ToObject[AddedSign[1,expr_]]:=ToObject[expr];
ToObject[AddedSign[-1,expr_]]:=MapAt[VerbatimProduct[Times][-1,#]&,ToObject[expr],1];
ToObject[AddedSign[0,expr_]]:=Identify[0];
(* Products of objects *)
ToObject[vprod:(VerbatimProduct|CommutingObjects)[prod_][objects__Object]]:=Object[
vprod,
With[{list=Transpose[{objects}[[All,2]]]},
{
{prod,list[[1]]},
symListCombine[list[[2]],Times],
{prod,list[[3]]}
}
],
TimesIndices[Transpose[{objects}[[All,3]]]]
];
ToObject[expr:(VerbatimProduct|CommutingObjects)[prod_][___]]:=(Print["INFO: ToObject acting on a VP with not all Objects."];ToObject[ToObject/@expr]);
(* Sum (VerbatimPlus) of objects. Note that the first argument contain full objects *)
ToObject[expr:VerbatimPlus[objects__Object]]:=Object[
expr,
With[{list=Transpose[{objects}[[All,2]]]},
{
{Plus,list[[1]]},
symListCombine[list[[2]],GCD],
{Plus,list[[3]]}
}
],
PlusIndices[Transpose[{objects}[[All,3]]]]
];
ToObject[expr_VerbatimPlus]:=(Print["INFO: ToObject acting on a VPlus with not all Objects."];ToObject[ToObject/@expr]);
(* Other cases *)
ToObject[expr_]:=Throw@Message[xSort::error1,"INFO: ToObject: I don't know what to do with",expr];

15.1.4. ObjectOrder

ObjectOrder decides whether two consecutive arguments in a product are sorted or not. In principle this operation is independent of the actual product we are using, but it is conceivable that we might want to have different ordering rules in different products. In any case, this subsection describes the default option for ObjectOrder, called AutomaticObjectOrder, which is indeed independent of the product. The user can define his/her own ordering using the option xSortOrder of DefProduct.

The rules for the AutomaticObjectOrder are:
	- we first sort the types
	- then we sort the symorder, having less symmetric objects first
	- then we sort objects by names
	- then lengths of all indices, having less indices first
	- then lengths of free indices (of the whole expression), having more free indices first
Note the need to specify the free indices, to avoid for example saying that lie[v[a], v[b]] is zero for a lie bracket.

There are two uses of ObjectOrder, and they must treat the indices differently. I need to discuss this in more detail.

symnds[sym_,nds_]:=Reverse@PadLeft[Flatten[{sym}],nds,1]

(* Information used to sort with the AutomaticObjectOrder *)
ObjectOrderItems[False][Object[object_,{type_,sym_,name_},{all_,free_,dum_,bl_,ms_}],nds_]:=With[{frees=Intersection[free,$FreesForSorting]},{xSortPrecedence[name],type,symnds[sym,nds],SortingName[name],Length[all],-Length[frees],mstate/@ms}];
ObjectOrderItems[True][Object[object_,{type_,sym_,name_},{all_,free_,dum_,bl_,ms_}],nds_]:=With[{frees=Intersection[free,$FreesForSorting]},{xSortPrecedence[name],type,symnds[sym,nds],SortingName[name],Length[all],-Length[frees],mstate/@ms,bl,IndexSort[free]}];

As suggested by Thomas, we introduce a function overwriting precedences if needed. By default all expressions have the same precedence:

Sort[{10000,{1000,10},{1000000}}]

xSortPrecedence[_]:=100;
SetNumberOfArguments[xSortPrecedence,1];
Protect[xSortPrecedence];

Name for sorting. It must be uniquely defined, and without indices. Ideally, this would be an index-free representation of the tensor. There is work to do here, improving the name argument of the Objects.

SortingName[name_List]:=name/.MyDer[covd_?CovDQ[_]]:>MyDer[covd];
SortingName[name_Symbol]:=name;

The function mstate decides the information that must be extracted from the metric-state expression of a given index. QUESTION: Why didn’t we have this from the very beginning?

(* Final metric-state *)
mstate[{-vbundle_,__}]:=vbundle;
mstate[{vbundle_,__}]:=vbundle;

Main definitions:

AutomaticObjectOrder[freesQ_][object1_Object,object2_Object]:=With[{nds=Max[1,Length[object1[[2,2]]],Length[object2[[2,2]]]]},
Order[ObjectOrderItems[freesQ][object1,nds],ObjectOrderItems[freesQ][object2,nds]]
];

Default choice of ObjectOrder, which is independent of the product. Users can define their own ObjectOrder functions using the xSortOrder option of DefProduct.

ObjectOrder[prod_,freesQ_]:=AutomaticObjectOrder[freesQ];

15.1.5. ObjectSort

ObjectSort sorts the Object expressions in a VerbatimProduct[prod][ objects ], paying much attention to the properties of the product prod. It may add CommutingObjects[prod] heads: it will be the head of the result if the product has two arguments, and it will be the head of one of the final arguments if the product has more than two arguments and is associative. If it has more than two arguments and is not associative then commutation adds nothing. Think of CircleTimes[ v[a], v[b] ] epsilon[-a, -b] for a vector-valued form v. That is CircleTimes[ v[1], v[2] ] - CircleTimes[ v[2], v[1] ], which is not zero in general.

ObjectSort[expr:VerbatimProduct[prod_][__Object]]:=Block[{$FreesForSorting=freeindices[expr]},
With[{com=CommutativityOfProduct[prod]},
ProductSplit[com][ProductSort[expr,com]]
]
];

Perform the actual sorting, depending on the properties of the product. The job is separated in two parts: first ProductSort will put factors in order, wrapping the expression with AddedSign, in case a sign has been produced during the reordering. Then ProductSplit will detect symmetries and add the information, to be used later by SymmetryOf. The next three ObjectOrder commands had True before, but I’ve put False now.

(* No symmetry. Nothing to do *)
ProductSort[expr:VerbatimProduct[prod_][__Object],None]:=AddedSign[1,expr];

(* Commutative product. Move everything freely *)
ProductSort[expr:VerbatimProduct[prod_][__Object],"Commutative"]:=AddedSign[1,Sort[expr,ObjectOrder[prod,False][#1,#2]≥0&]];

(* Two arguments *)
ProductSort[expr:VerbatimProduct[prod_][x_Object,y_Object_],com_]:=Module[{order,sign},
Which[
order=ObjectOrder[prod,com=!="Commutative"][x,y];
order===1, (* x and y correctly sorted. Do nothing *)
	AddedSign[1,expr],
sign=CommutativitySign[prod,com][UxSort[x],UxSort[y]];
order===-1, (* x and y incorrectly sorted. Reverse them and add the sign *)
	AddedSign[sign,Reverse[expr]],
order===0&&sign===1, (* x and y identical, but product is commutative. Do nothing *)
	AddedSign[1,expr],
order===0&&sign===-1, (* x and y identical and produc is anticommutative. Expression is 0 *)
	AddedSign[0,expr]
]
];
(* Associative case *)
nonzeroQ[0]:=False;
nonzeroQ[_]:=True;
ProductSort[expr:VerbatimProduct[prod_][__Object],com_]:=Module[{uxsort},
uxsort[object_]:=uxsort[object]=UxSort@First[object];
ReplaceRepeated[
AddedSign[1,expr],
AddedSign[s_?nonzeroQ,head_[left___Object,x_Object,y_Object,right___Object]]:>Module[{order,sign},
order=ObjectOrder[prod,com=!="Commutative"][x,y];
sign=CommutativitySign[prod,com][uxsort[x],uxsort[y]];
AddedSign[
If[order===0&&sign==-1,0,s sign],
head[left,y,x,right]
]/;(order<0||(order===0&&sign===-1))
]
]
];

This function introduces the head CommutingObjects[prod]. Note that it is actually independent of com, except for the fact that when com==None there is nothing to do:

ProductSplit[None][expr_]:=expr;
ProductSplit[com_][AddedSign[sign_,expr:VerbatimProduct[prod_][x_Object,y_Object]]]:=AddedSign[sign,If[ObjectOrder[prod,False][x,y]===0,CommutingObjects[prod][x,y],expr]];
ProductSplit[com_][AddedSign[sign_,expr:VerbatimProduct[prod_][__Object]]]:=AddedSign[sign,ApplyCommutingObjects/@Split[expr,ObjectOrder[prod,False][#1,#2]===0&]];
ApplyCommutingObjects[VerbatimProduct[prod_][x_Object]]:=x;
ApplyCommutingObjects[VerbatimProduct[prod_][x__Object]]:=ToObject[CommutingObjects[prod][x]];

Signs will be placed at intermediate places, and then the products will have to extract those signs to more external expressions. Can we avoid that?

15.1.6. xSort, UxSort

Global driver in charge of sorting tensors in products in a unique way. The main idea is that Identify will convert a given elementary expr into an Object[expr, info], where info will be used for sorting, and then a product prod are replaced by VerbatimProduct[prod], so hide its attributes or any other automatic action. It may happen that the product is an argument of some other construction, like an inert head or another product. Then we need to recurse and convert that product into another Object[prodexpr, info], using the function ToObject. It is then when the properties of the combined object are computed.

xSort inmediately changes to the internal function Identify. It just prepare the global options variable $TCOptions for ToCanonicalDir and ToCanonicalScalar in Identify. That is, xSort and Identify are essentially the same function, except for this little detail.

?xSort

xSort[expr_,options:OptionsPattern[]]:=Block[{$TCOptions=CheckOptions[options]},Identify[expr]];
SetNumberOfArguments[xSort,{1,Infinity}];
Protect[xSort];

Inverse function.

UxSort[expr_]:=ReleaseHold[Hold[expr]//.{Object[expr1_,__]:>expr1,VerbatimProduct[prod_]:>prod,CommutingObjects[prod_]:>prod,VerbatimPlus->Plus}];
SetNumberOfArguments[UxSort,1];
Protect[UxSort];

Format the Object expressions:

MakeBoxes[Object[expr_,rest__],StandardForm]:=TagBox[TooltipBox[UnderscriptBox[MakeBoxes[expr,StandardForm],"_"],MakeBoxes["Object"[expr,rest],StandardForm]],#&];
MakeBoxes[VerbatimProduct[prod_],StandardForm]:=TagBox[TooltipBox[UnderscriptBox[MakeBoxes[prod,StandardForm],"_"],MakeBoxes["VerbatimProduct"[prod],StandardForm]],#&];
MakeBoxes[CommutingObjects[prod_],StandardForm]:=TagBox[TooltipBox[UnderscriptBox[MakeBoxes[prod,StandardForm],"_"],MakeBoxes["CommutingObjects"[prod],StandardForm]],#&];
MakeBoxes[VerbatimPlus[exprs___],StandardForm]:=MakeBoxes["VerbatimPlus"[exprs],StandardForm];
MakeBoxes[MyDer[der_],StandardForm]:=MakeBoxes["MyDer"[der],StandardForm];

15.1.7. Examples

BeginExamples[]

We need this definition for the examples:

xAct`xTensor`Private`ToCanonicalTensorHead[head_]:=head;

DefTensor[T[A],M2]

DefCovD[CD[-A],{";","D"}]

xATP`Identify[5]

xAct`xCoba`VBundleOfBasis[Polar]^=TangentM2;
xAct`xCoba`VBundleOfBasis[-x_]=xAct`xCoba`VBundleOfBasis[x];
xAct`xCoba`BasisColor[Polar]^=RGBColor[0,0,1];
$CovDFormat="Postfix";

xATP`Identify[T[A,B,C,-B,{1,Polar},{1,-Polar}]]

xATP`Identify[CD[-A][T[B,C]]]

xATP`Identify[CD[-A][T[B,A]]]

xATP`Identify[CD[-B][CD[-A][T[B,A]]]]

xATP`Identify[CD[{-D,-Polar}][T[B,A]]]

xATP`Identify[-CD[{1,-Polar}][T[B,A]]]

xATP`Identify[Bracket[T[B],T[C]][A]]

DefConstantSymbol[Mass]

xATP`Identify[Mass^2+4Mass+5]

xATP`Identify[1/(Mass^2+4Mass+5)]

xATP`Identify[1/(Mass^2+4Mass+5T[A]T[-A])]

xATP`Identify[1/(Mass^2+4(Mass+Mass^2)+5T[A]T[-A])]

UndefConstantSymbol[Mass]
UndefTensor[T]
UndefCovD[CD]

More examples:

DefTensor[v[A],M2]
DefTensor[T[A,B,C],M2,Symmetric[{1,2,3}]]

DefConstantSymbol[Mass]

xSort[1]

xSort[v[A]]

xSort[1+v[A]v[-A]]

xSort[T[A,B,C]v[-B]v[-C]]

xSort[T[A,B,C]T[D,-B,-C]]

Note the influence of the presence of a metric:

xUpSet[MetricsOfVBundle[TangentM2],{metricg}];

xSort[T[A,B,C]T[D,-B,-C]]

xUpSet[MetricsOfVBundle[TangentM2],{}];

xSort[7Mass v[A]v[B]]

$CommuteFreeIndices=False

xSort[T[A,B,C]T[D,-B,-C]]

$CommuteFreeIndices=True

xSort[1/(2Mass v[]-v[]^2)]

UndefConstantSymbol[Mass]

UndefTensor/@{v,T};

Remove[metricg];

EndExamples[]

Examples with derivatives and metrics:

BeginExamples[]

DefTensor[T[A,B,C],M2]

DefCovD[CD[-A],{";","D"}]

xSort[T[A,B,C]CD[-A][T[-B,-C]]]

xATP`careQ[%]

DefMetric[-1,metric[-A,-B],cd,{"#","D"}]

xSort[T[A,B,C]CD[-A][T[-B,-C]]]

xATP`careQ[%]

xSort[T[A,B,C]cd[-A][T[-B,-C]]]

xATP`careQ[%]

xSort[OverDot[T[A,B,C]]cd[-A][T[-B,-C]]]

xATP`careQ[%]

Note that we use strange patterns in the metric definitions:

?metric

These definitions seem redundant, as we said:

UpValues[metric][[First/@Position[UpValues[metric],xAct`xTensor`Private`ZeroDerOnMetricQ]]]

UpValues[metric][[First/@Position[UpValues[metric],xAct`xTensor`Private`ZeroDerivativeQ]]]

UndefTensor/@{T,metric};

UndefCovD[CD]

EndExamples[]

15.2. SymmetryOf

15.2.0. Comments

It would be more reasonable to starting defining xSort. However we need to know the symmetries of the objects in order to sort them (see ObjectOrder). And then we need xSort to define the symmetry of a product. That is why we need to define SymmetryOf in two stages, with the definition of xSort in between.

The function SymmetryOf will give the SLOT-symmetries of an arbitrary expression. The output is a Symmetry expression with four arguments:
	- an integer with the number of slots in the expression,
	- the expression with all indices replaced by slot numbers,
	- a list of rules of the form slot[5]->index,
	- a STRONG GENERATING SET for the symmetry group of the expression.

The head Symmetry does not perform any action. It just holds all the information required to canonicalize a term. We can protect it already:

Protect[Symmetry];

This is a typical Symmetry structure:

We define the EmptySymmetry structure:

EmptySymmetry[x_]:=Symmetry[0,x,{},StrongGenSet[{},GenSet[]]];
EmptySymmetry[x_,inds_List]:=Symmetry[Length[inds],x,MapIndexed[Rule[slot@First[#2],#1]&,inds],StrongGenSet[{},GenSet[]]];

Note that Symmetry and EmptySymmetry are xTensor heads, and not xPerm heads.

15.2.1. Slots

The expression will have the five kinds of g-indices. Indices (abstract- or basis-) and named patterns cannot be repeated, but blanks, label-indices, basis-integers and directions can be repeated. Therefore it is not possible to identify slots with the g-index which is actually there. We must identify slots numerically somehow. That is why we use the slot[5] notation.

The first step is replacing all g-indices by slots. This is the output format ($slotSymbol has been randomly chosen):

$slotSymbol="●";
Format[slot[n_Integer]]:=$slotSymbol<>ToString[n];
Unprotect[IndexForm];
IndexForm[slot[n_Integer]]:=$slotSymbol<>ToString[n];
Protect[IndexForm];

slot[4]

We need to update a few functions because, in some sense, slot is another kind of g-index:

slot/:UpIndex[x_slot]:=x;
slot/:NoDollar[x_slot]:=x;

No more definitions will be associated to slot:

Protect[slot];

This function generates a list (head List, and not IndexList) of rules of the form slot[i]->index, assuming that there are already n slots (hence, starting at n+1). Recall that {}+1 is {}, without getting any warning or error.

ToSlotRules[n_Integer,indices_IndexList]:=List@@MapIndexed[Rule[slot@@(n+#2),#1]&,indices];

BeginExamples[]

xATP`ToSlotRules[3,IndexList[a,-b,c_,_,Dir@v@k,Dir@v@k]]

InputForm[%]

xATP`ToSlotRules[3,IndexList[]]

Remove[k,v]

EndExamples[]

The function DisplaceSlots moves the points of the permutations by an integer amount (positive, negative or zero). Note that it only works on Cycles notation, and actually converts the generating sets to Cycles notation.

DisplaceSlots[GS_GenSet,d_Integer]:=TranslatePerm[GS,xAct`xPerm`Cycles]/.xAct`xPerm`Cycles[cycs__]:>xAct`xPerm`Cycles@@({cycs}+d);
DisplaceSlots[StrongGenSet[base_List,GS_GenSet],d_Integer]:=StrongGenSet[base+d,DisplaceSlots[GS,d]];
DisplaceSlots[Symmetric[list_],d_Integer]:=Symmetric[list+d];
DisplaceSlots[Antisymmetric[list_],d_Integer]:=Antisymmetric[list+d];

DisplaceSlots[Symmetry[n_,expr_,slotlist_,SGS_],d_Integer]:=Symmetry[n+d,expr/.slot[x_]->slot[x+d],slotlist/.slot[x_]->slot[x+d],DisplaceSlots[SGS,d]];

This definition is extremely cautious. It is used on expressions and rules.

addonetolast[{x___,0}]:={x,1};
DisplaceSlots[expr_,d_Integer]:=xEvaluateAt[expr/.slot[x_]->slot[x+d],addonetolast/@Position[expr,slot]];

Examples:

BeginExamples[]

xATP`DisplaceSlots[GenSet[xAct`xPerm`Cycles[{1,2,3}],xAct`xPerm`Cycles[{3,4}]],3]

xATP`DisplaceSlots[StrongGenSet[{1,2,3,4},GenSet[xAct`xPerm`Cycles[{1,2,3}],xAct`xPerm`Cycles[{3,4}]]],3]

xATP`DisplaceSlots[StrongGenSet[{},GenSet[xAct`xPerm`Cycles[{1,2,3}],xAct`xPerm`Cycles[{3,4}]]],3]

EndExamples[]

15.2.2. 1D vbundles

For version 0.7.0 the construct Join@@#1 has been replaced by DeleteDuplicates@Flatten@#1, which is identical on nonoverlapping bases. Then we have introduced (in 0.9.8) MyUnion@@#1. QUESTION: I think this function is rather unsafe, but very rarely used. Only in CovDSym and Sym1D.

JoinSGSoverlap[left___,sym:(_Symmetric|_Antisymmetric),right___]:=JoinSGSoverlap[left,SGSofsym[sym],right];
JoinSGSoverlap[SGSs__StrongGenSet]:=StrongGenSet[MyUnion@@#1,Union@@#2]&@@Transpose[Apply[List,{SGSs},1]];
JoinSGSoverlap[]:=StrongGenSet[{},GenSet[]];
MyUnion[base_List,base1_List]:=Fold[MyUnion1,base,base1];
MyUnion1[base:{___,x_,___},x_]:=base;
MyUnion1[{x___,y_,z___},p_]:={x,p,y,z}/;y>p;
MyUnion1[{x___},p_]:={x,p};

1D vector spaces: in the presence of a metric, tensors on 1D spaces are totally symmetric. If there is no metric, then they are totally symmetric in the groups of covariant and contravariant indices separately. This needs to be computed in real time (because whether or not there is a metric can change during a session). This function handles that problem:

(* Main *)
Symmetry1D[Symmetry[n_,expr_,inds_,sym_]]:=Symmetry[n,expr,inds,Symmetry1D[sym,inds]];
Symmetry1D[sym:(_Symmetric|_Antisymmetric),inds_]:=Symmetry1D[SGSofsym[sym],inds];
(* On a SGS, with the list of slot->aindex *)
Symmetry1D[sym_StrongGenSet,inds_]:=
JoinSGSoverlap[sym,Symmetry1D[Cases[List@@inds,_[_slot,_?AIndexQ]]]];
(* Construct objects {vb, dim, upQ, slot} *)
Symmetry1D[inds_List]:=Module[{vbundles=VBundleOfIndex/@Last/@inds,dims},
dims=DimOfVBundle/@vbundles;
If[FreeQ[dims,1],
StrongGenSet[{},GenSet[]],
Apply[JoinSGS,sym1vbundle/@Split[
Sort@Cases[
Transpose[{vbundles,dims,UpIndexQ/@Last/@inds,First/@First/@inds}],{_,1,_,_}],(First[#1]===First[#2])&]
]
]
];
(* One vbundle: check whether there is a metric *)
sym1vbundle[inds_List]:=sym1vbundle[inds,MetricEndowedQ[inds[[1,1]]]];
(* There is a metric: symmetry on all indices *)
sym1vbundle[inds_List,True]:=SGSofsym@Symmetric[Last/@inds];
(* There is no metric: separate upper and lower indices *)
sym1vbundle[inds_List,False]:=MapAt[Sort,Apply[JoinSGS,SGSofsym/@Symmetric/@Map[Last,Split[inds,(#1[[3]]===#2[[3]])&],{2}]],1];

15.2.3. SymmetryOf

The function SymmetryOf gives the full Symmetry structure of a generic expression. These two options for SymmetryOf are a bit surprising at first. Describe them in detail (TODO). Actually they are options for the AD part manipulating covariant derivatives:

Options[SymmetryOf]={CommutePDs->True,ConstantMetric->False};

1.- Main definition on tensors. Note that SymmetryGroupOfTensor acts on the full tensor with indices. That allows some useful tricks like giving new definitions for tensors with variable number of indices.

SymmetryOf[tensor_?xTensorQ[indices___],options___]:=Symmetry[Length[{indices}],tensor@@(First/@#),#,SGSofsym@SymmetryGroupOfTensor[tensor[indices]]]&@ToSlotRules[0,IndexList[indices]];

2.- On derivatives:

SymmetryOf[covd_?CovDQ[ind__][expr_],options___]:=CovDSymmetryOf[covd[ind]][expr,options];

3.- Other heads are essentially trivial: we just reintroduce the head on the argument expression. Only the additional z arguments of the inert heads need special treatment. Fix a bug pointed out by Alfonso (Jan 2013): Recall that the indices of an inert head expression are the unsorted union (DeleteDuplicates) of the indices in the tensor and then the IndexList expressions, in the order in which they appear in the expression. The symmetry comes exclusively from the tensor in the first argument. The other indices cannot have symmetry (unless without tweaking SymmetryOf).

symmetryz[symmetry_,{}]:=symmetry;
symmetryz[symmetry:Symmetry[_,_,rules_,_],{z__}]:=symmetryz1[symmetry,{z},appendzrules[rules,{z}]];
appendzrules[rules_,{z__}]:=Join[rules,ToSlotRules[Length[rules],DeleteCases[IndexList@@Join@@Cases[{z},_IndexList],Alternatives@@(Last/@rules)]]];
symmetryz1[symmetry_,{z__},rules_]:=
symmetryz2[symmetry,{z}/.list_IndexList:>Replace[list,Reverse/@rules,{1}],rules];
symmetryz2[Symmetry[n_,ih_[expr_,z1__],rules1_,sym_],{z2__},rules2_]:=Symmetry[Length[rules2],ih[expr,z2],rules2,sym];

SymmetryOf[LieD[v_][expr_],options___]:=MapAt[LieD[v],SymmetryOf[expr,options],2];
SymmetryOf[ParamD[ps__][expr_],options___]:=MapAt[ParamD[ps],SymmetryOf[expr,options],2];
SymmetryOf[OverDot[expr_],options___]:=MapAt[OverDot,SymmetryOf[expr,options],2];
SymmetryOf[ih_?InertHeadQ[expr_,z___],options___]:=symmetryz[MapAt[ih[#,z]&,SymmetryOf[expr,options],2],{z}];

Even simpler cases with no symmetry:

SymmetryOf[x_Scalar,options___]:=EmptySymmetry[x];
SymmetryOf[x:_?ScalarFunctionQ[___],options___]:=EmptySymmetry[x];
SymmetryOf[x:Derivative[ders__][_?ScalarFunctionQ][__],options___]:=EmptySymmetry[x];

4.- If we can remove non-indexed-scalars (note that we use NonIndexedScalarQ instead of ScalarQ), we do it (I thank Guillaume Faye for detecting that this was missing):

SymmetryOf[(f_Symbol/;f===Times)[x___,y_?NonIndexedScalarQ,z___],options___]:=MapAt[Times[y,#]&,SymmetryOf[Times[x,z],options],2];
SymmetryOf[x:Plus[__?NonIndexedScalarQ],options___]:=EmptySymmetry[x];

Note: I have found that the NonIndexedScalarQ check in products takes very long with expressions having many factors (I have seen more than 58000 checks in an expression with 10 factors, with 226 Mbytes of Trace). Something must be done here.

5.- Products:

SymmetryOf[expr:(VerbatimProduct|CommutingObjects)[prod_][___],options___]:=
SymmetryOfVerbatimProduct[expr,options];

6.- Objects

SymmetryOf[expr_Object,options___]:=SymmetryOfObject[expr,options];

7.- This is the main definition for SymmetryOf, for product objects. We need to sort the tensors first. Note the use of MahtInputExpand before xSort.

SymmetryOf[expr_,options___]:=SymmetryOfObject[xSort@MathInputExpand[expr],options];

If the resulting expression has head Plus, throw an error (QUESTION: what else could we do?):

SymmetryOf[expr_Plus,options___]:=Throw[Message[SymmetryOf::nouse,"SymmetryOf",expr]];

There are no more definitions for SymmetryOf:

SetNumberOfArguments[SymmetryOf,{1,Infinity}];
Protect[SymmetryOf];

15.2.4. Symmetry of products. CommutingObjects

This function joins two Symmetry objects. Note that slots of the first Symmetry are kept and slots of the second are shifted n1 places. The resulting second argument of Symmetry has head VerbatimProduct[prod].

JoinExprs[prod_][Null,expr2_]:=Flatten[VerbatimProduct[prod][expr2],1,VerbatimProduct[prod]];
JoinExprs[prod_][expr1_,expr2_]:=Flatten[VerbatimProduct[prod][expr1,expr2],1,VerbatimProduct[prod]];

JoinSymmetries[prod_][Symmetry[n1_,expr1_,rules1_,SGS1_],Symmetry[n2_,expr2_,rules2_,SGS2_]]:=
Symmetry[
n1+n2,
JoinExprs[prod][expr1,DisplaceSlots[expr2,n1]],
Join[rules1,DisplaceSlots[rules2,n1]],
JoinSGS[SGS1,DisplaceSlots[SGS2,n1]]
];

SymmetryOfVerbatimProduct[expr:VerbatimProduct[prod_][___],options___]:=Fold[JoinSymmetries[prod],EmptySymmetry[Null],SymmetryOf[#,options]&/@List@@expr];

Example:

JoinSymmetries[Times][Symmetry[2,T[slot[1],slot[2]],{slot[1]->A,slot[2]->B},StrongGenSet[{1},GenSet[xAct`xPerm`Cycles[{1,2}]]]],Symmetry[3,T[slot[1],slot[2],slot[3]],{slot[1]->C,slot[2]->D,slot[3]->F},StrongGenSet[{1},GenSet[xAct`xPerm`Cycles[{1,2,3}]]]]]

Remove[A,B,F,T]

We call commuting tensors to those tensors in a monomial having 
	1) same name and same derivatives, 
	2) same number of indices, 
	3) same number of free indices of the monomial and 
	4) all free indices at the symmetrizable positions. In particular, if the tensor doesn't have symmetries, no free index is allowed. Why? QUESTION.
These tensors can be permuted among them and therefore give new base permutations, appart from those coming from the indices of the tensors.

Repair CommutingObjects because only if free indices are in symmetrizable positions the tensors are commuting. This is not currently taken into account. That means that if a tensor does not have symmetries then we do not need to take commuting issues into account. QUESTION: ???

We need to combine both the symmetries of the objects themselves with the symmetries obtained by commutation, or any other symmetry of the product. There are nstotal indices, with tensors having ns indices (hence ns must be a divisor of nstotal):

CommutingCycles[sign_,ns_Integer,ns_Integer]:=GenSet[];
CommutingCycles[0,nstotal_Integer,ns_Integer]:=GenSet[];
CommutingCycles[sign_,nstotal_Integer,ns_Integer]:=Join[
CommutingCycles[sign,nstotal-ns,ns],
GenSet[
sign xAct`xPerm`Cycles@@Transpose[{Range[nstotal-2ns+1,nstotal-ns],Range[nstotal-ns+1,nstotal]}]
]
];

CommutingCycles[1,2,1]

CommutingCycles[1,6,2]

CommutingCycles[-1,6,2]

CommutingCycles[1,6,3]

Then we have commuting objects: here we need to combine both the symmetries of the objects themselves with the symmetries obtained by commutation. We need to change the handling of JoinSGS when CommutingObjects is involved. The point is that the current command JoinSGS assumes that both sgs are disjoint and this is not True in that case. QUESTION: How do we know that this produces a SGS?

July 2011: As suggested by Thomas, the /@Drop[elements,-1] in this definition has been replaced by /@elements, to follow our new convention of having all moved points in the base.

JoinSGSCommuting[sign_,SGS_,0,0]:=SGS;
JoinSGSCommuting[sign_,StrongGenSet[base_,gs_],nstotal_,ns_]:=Module[{cycles=CommutingCycles[sign,nstotal,ns],elements=Partition[Range[nstotal],ns],newbase=base},If[FreeQ[base,Alternatives@@#],AppendTo[newbase,First[#]]]&/@elements;
StrongGenSet[newbase,Join[gs,cycles]]
];

JoinSGSCommuting[1,StrongGenSet[{1,3,5,7},GenSet[]],12,2]

SymmetryOfVerbatimProduct[CommutingObjects[prod_][exprs__],options___]:=Module[{no=Length[{exprs}],nstotal,sym,SGS,sign},
(* Construct Symmetry object apart from generating set *)
sym=Fold[JoinSymmetries[prod],EmptySymmetry[Null],SymmetryOf[#,options]&/@{exprs}];
(* Number of slots in the expression *)
nstotal=Length[sym[[3]]];
(* New generating set *)
SGS=SGSofsym[Last[sym]];
sign=CommutativitySign[prod,CommutativityOfProduct[prod]]@@Take[{exprs},2];
If[sign=!=0,SGS=JoinSGSCommuting[sign,SGS,nstotal,nstotal/no]];
(* New Symmetry object *)
ReplacePart[sym,SGS,{4}]
];

We need to worry about "equal indices": labels, directions and integer-basis indices. We need to add some additional symmetries. TODO.

15.2.5. Derivatives

SymmetryOf calls CovDSymmetryOf on covds, which appends all covds to the Symmetry expression of the internal (non-covd) argument. This is then passed to AD.

At this point we assume that covariant derivatives do not add symmetries to expressions. It actually happens sometimes (for example CD[-a][v[-b]] is symmetric if v[-b] is a gradient). Apart from a single case below (two non-torsion derivatives of a scalar) this is left to the user... We simply enlarge the list of derivative indices. Note that more internal derivatives are prepended, and not appended; that means that more internal derivatives come first in the list:

Jul 2008: These functions have been generalized to deal with multi-index derivatives.

CovDSymmetryOf[cds__][covd_?CovDQ[ind__][expr_],options___]:=CovDSymmetryOf[covd[ind],cds][expr,options]
CovDSymmetryOf[cds__][expr_,options___]:=AD[Append[SymmetryOf[expr,options],CovDTMP[cds]],options]

Now comes one of the trickiest parts of xTensor: the handling of the symmetries associated to derivatives. Notes:
	- Only PDs are commuted. Other derivatives are left untouched, even if they have been defined as commuting. In that case the functions CommuteCovDs and SortCovDs must be used.
	- Only covariant PDs are commuted, unless the option ConstantMetric is True. ConstantMetric should be obtained from the properties of the first metric and not from a passed option. TODO.
	- We introduce a preferred order for second derivatives (without torsion) of scalars. This order agrees with the **default** ordering of indices, but could be inconsistent with a different order.
	- Note the frequent check AIndexQ. I'm not sure what happens with other types of indices.

0) Rule 0:

(* If there are no more derivatives return the symmetry *)
AD[Symmetry[n_,expr_,rules_,SGS_,CovDTMP[]],options___]:=Symmetry[n,expr,rules,SGS]

1) If the first (most internal) derivative contains a non-abstract index then cannot be commuted. Do nothing:

(* If the first covd cannot commute, remove it *)
AD[Symmetry[n_,expr_,rules_,SGS_,CovDTMP[covd_[i_/;Not@AIndexQ[i]],y___]],options___]:=AD[Symmetry[n+1,covd[slot[n+1]][expr],Append[rules,slot[n+1]->i],SGS,CovDTMP[y]],options];

Now we know that the index of the first derivative is abstract.

2) If the first and second derivatives are different, then they cannot be commuted: remove the first one:

(* If the first and second derivatives are different, remove the first *)
AD[Symmetry[n_,expr_,rules_,SGS_,CovDTMP[covd1_[i1_],covd2_[i2_],y___]/;covd1=!=covd2],options___]:=AD[Symmetry[n+1,covd1[slot[n+1]][expr],Join[rules,{slot[n+1]->i1}],SGS,CovDTMP[covd2[i2],y]],options];

Now we know that the first and second derivatives are the same and the first one has an abstract index.

3) If the first two derivatives coincide, have abstract indices and have curvature but no torsion, commute them on scalars.

$CommuteCovDsOnScalars=True;

(* Two equal derivatives with lower abstract indices of a scalar commute if the derivative has no torsion. We check for curvate; the non-curvature case is treated below *)
AD[Symmetry[n_,expr_,rules_,SGS_,CovDTMP[covd_[i1_?AIndexQ],covd_[i2_?AIndexQ],y___]],options___]:=With[{firstmetric=FirstMetricOfVBundle[VBundleOfIndex[i1],False],metric=MetricOfCovD[covd]},AD[Symmetry[n+2,covd[slot[n+2]][covd[slot[n+1]][expr]],Join[rules,{slot[n+1]->i1,slot[n+2]->i2}],JoinSGS[SGS,SGSofsym@Symmetric[{n+1,n+2}]],CovDTMP[y]],options]/;$CommuteCovDsOnScalars&&
CurvatureQ[covd]&&
Not@TorsionQ[covd]&&
ScalarQ[expr/.rules]&&(DownIndexQ[i1]&&DownIndexQ[i2]||(metric=!=Null&&(metric===firstmetric ||MatchQ[InducedFrom@metric,{firstmetric,_}]))
)
];

There are five ways the previous rule could be not obeyed:
	I) the second derivative does not have an abstract index,
	II) the derivatives do not have curvature,
	III) the derivatives have torsion,
	IV) the argument is not scalar, or
	V) the indices are contravariant and have been raised with a metric which is not the Levi-Civita connection of the derivative.

4) With non-scalar expressions, if the first derivative has curvature or torsion, do nothing:

(* Other derivatives with curvature or torsion are not commuted, even if they do commute; this is left to the user *)
AD[Symmetry[n_,expr_,rules_,SGS_,CovDTMP[covd_[i_]/;Or[CurvatureQ[covd],TorsionQ[covd]],y___]],options___]:=AD[Symmetry[n+1,covd[slot[n+1]][expr],Append[rules,slot[n+1]->i],SGS,CovDTMP[y]],options];

Now we know that the first two derivatives are the same ordinary derivative (no curvature and no torsion). The first one has an abstract index. 

5) There are more than one commuting derivatives. We need to worry about 3 possibilities: we can have several instances of the commuting derivative and then:
	a) a different derivative (starting from the third derivative)
	b) the same derivative with a non-abstract index (starting from the second derivative, to include case I)
	c) nothing (starting from the second derivative; that is, we need to consider the case with a single "commuting" derivative)
    We prepare a different rule for those three cases:

(* Drivers for the three remaining cases *)
AD[Symmetry[n_,expr_,rules_,SGS:StrongGenSet[base_,GS_],CovDTMP[y:covd_[_?AIndexQ]..,covd1_[i_],z___]],options___]:=ADSym[Symmetry[n,expr,rules,SGS,CovDTMP[y],CovDTMP[covd1[i],z]],options]/;covd=!=covd1;
AD[Symmetry[n_,expr_,rules_,SGS:StrongGenSet[base_,GS_],CovDTMP[y:covd_[_?AIndexQ]..,covd_[i_/;Not@AIndexQ[i]],z___]],options___]:=ADSym[Symmetry[n,expr,rules,SGS,CovDTMP[y],CovDTMP[covd[i],z]],options];
AD[Symmetry[n_,expr_,rules_,SGS:StrongGenSet[base_,GS_],CovDTMP[y:covd_[_?AIndexQ]..]],options___]:=ADSym[Symmetry[n,expr,rules,SGS,CovDTMP[y],CovDTMP[]],options];

6) Multi-index case is treated trivially:

AD[Symmetry[n_,expr_,rules_,SGS_,CovDTMP[covd_[i_,is__],other___]],options___]:=AD[With[{length=Length[{i,is}]},Symmetry[n+length,Apply[covd,slot/@Range[n+1,n+length]][expr],Join[rules,MapThread[Rule,{slot/@Range[n+1,n+length],{i,is}},1]],JoinSGS[SGS,DisplaceSlots[SymmetryGroupOfCovD[covd[i,is]],n]],CovDTMP[other]]],options];

7) Finally,

(* If there are several derivatives that can commute, give GS *)
ADSym[Symmetry[n_,expr_,rules_,SGS_,CovDTMP[y__],CovDTMP[z___]],options:OptionsPattern[]]:=Module[{der,comPD,constmet,inds,newSGS,slotrules,slots},{comPD,constmet}=OptionValue[SymmetryOf,{options},{CommutePDs,ConstantMetric}];
der=Head[First[{y}]];
inds=Apply[Identity,IndexList[y],{1}];
slotrules=ToSlotRules[n,inds];
slots=First/@First/@slotrules;
newSGS=If[comPD&&(constmet||(And@@(DownIndexQ/@inds))),JoinSGS[SGS,SGSofsym@Symmetric[slots]],SGS];
AD[Symmetry[n+Length[inds],Last@ComposeList[der/@slot/@slots,expr],Join[rules,slotrules],newSGS,CovDTMP[z]]]
];

15.2.6. SymmetryOfObject

Main definition on products of objects:

SymmetryOfObject[Object[expr:(VerbatimProduct|CommutingObjects)[_][___],__],options___]:=
SymmetryOfVerbatimProduct[expr//.Object[expr1_,__]:>expr1,options];

The symmetry of elementary objects (non products) is computed with SymmetyOf.

We treat in a special way the objects with no free and no dummy indices (they might still have blocked indices). This is part of what the former Scalar1 head did in the past:

SimpleObjectQ[Object[_,_,{_,IndexList[],IndexList[],_,_}]]:=True;
SimpleObjectQ[_]:=False;

SymmetryOfObject[object:Object[expr_,_,_],options___]:=
If[SimpleObjectQ[object],
EmptySymmetry[expr],
SymmetryOf[expr//.Object[expr1_,__]:>expr1,options]
];

Again, we can do nothing on sums. This is needed in case the sum comes as a result of MathInputExpand and then xSort. ToCanonicalObject has a dedicated threading definition to avoid this.

SymmetryOfObject[Object[expr_VerbatimPlus,__],options___]:=Throw[Message[SymmetryOf::nouse,"SymmetryOf",UxSort[expr]]];

15.2.7. Examples

BeginExamples[]

DefTensor[Rie[A,B,C,D],M2,RiemannSymmetric[{1,2,3,4}]]

SymmetryGroupOfTensor[Rie]

SymmetryOf[Rie[G,F,D,K]]

SymmetryOf[OverDot[Rie[G,F,D,K]]]

SymmetryOf[PD[-A][PD[-B][PD[-C][Rie[G,F,D,K]]]]]

SymmetryOf[PD[-A][PD[-B][PD[-C][Rie[G,F,D,K]]]],CommutePDs->False]

SymmetryOf[PD[Dir@Rie[Z]][PD[-B][PD[-C][Rie[G,F,D,K]]]]]

SymmetryOf[PD[-L][PD[-A][PD[Dir[Rie[Z]]][PD[-B][PD[-C][Rie[G,F,D,K]]]]]]]

SymmetryOf[PD[-A][PD[B][PD[-C][Rie[G,F,D,K]]]]]

SymmetryOf[PD[-A][PD[B][PD[-C][Rie[G,F,D,K]]]],ConstantMetric->True]

QUESTION: An important problem is the following: what happens when we have two equal Dir indices? I see two possibilities: either we uncontract first the directions converting the object into a generic expression, or we include more Commuting rules. Both possibilities seem complicated... Even more complicated seems what to do with basis directions. There is the same problem with labels.

Now I think that we need to introduce more symmetries, but in the D group, and not in the S group. This will be taken into account below with the concept of RepeatedSet.

DefTensor[v[A],M2]

SymmetryOf[Rie[Dir@v@Z,Dir@v@Z,C,D]]

UndefTensor/@{Rie,v};

More examples:

DefTensor[T[A,B],M2,Symmetric[{A,B}]]
DefTensor[UU[-A,-B],M2,Antisymmetric[{-A,-B}]]
DefTensor[S[A,B],M2]
DefTensor[V[A],M2]
DefTensor[r[],M2]
DefTensor[v[A],M2]
DefTensor[R[-A,-B,-C,-D],M2,RiemannSymmetric[{1,2,3,4}]]

$AbstractIndices

term=7 r[]^2 T[-A,-B]UU[B,C]S[-C,G]T[-D,-F]V[D]V[F]V[A]R[-G,-G1,-G2,-G3];

FindFreeIndices[Evaluate[term]]

SymmetryOf[R[-G,-G1,-G2,-G3]]

SymmetryOf[xATP`CommutingObjects[Times][V[A],V[B],V[C]]]

xSort[term]

xATP`SymmetryOfObject[%]

xSort[UU[C,B]R[-G,-G1,-G2,-G3]]

SymmetryOf[UU[C,B]R[-G,-G1,-G2,-G3]]

SymmetryOf[7 r[]^2UU[C,G3]R[-G,-G1,-G2,D]S[-A,-B]T[-C,G]V[A]V[B]]

UndefTensor/@{T,S,UU,V,R,v,r};

Remove[term,L,Z]

EndExamples[]

15.3. ToCanonical

15.3.0. Comments

ToCanonical is a function that the user can use on any kind of object. Therefore we must prepare it for any input.

The basic objects are:
	- “tensors” of the form head[inds], including the case head[]. Indices are those given.
	- derivatives cd[inds][expr]. Indices are those of expr and then the inds.
	- inert heads head[expr, other]. Indices are those of expr and then any indices in the IndexList’s of other.
	- products prod[expr1, expr2, ...]. Indices are those of the exprs.

ToCanonical has two fundamental parts:

1) Sort all objects in the expression, without moving their indices. The index information may be used to sort them. This is performed by xSort. Now that we handle antisymmetric products, we might find that the result is zero. Beware of nested products.

2) Move the indices of the expression, without moving the tensors. The result may be zero due to the presence of antisymmetries.

15.3.1. ToCanonical

?ToCanonical

In principle the action of ToCanonical should not introduce new dummies. However there is the problem of derivatives of metrics, which does introduce new dummies.

Options[ToCanonical]:={
Verbose->False,
UseMetricOnVBundle->All,
Method->{ChangeCovD,"ExpandChristoffel"->False},
MathLink:>$xpermQ,
TimeVerbose->False
};

1.- Simplest types:

(* 1. ToCanonical on atoms: Identity *)
ToCanonical[x_Symbol,options___]:=x;
ToCanonical[x:(_Integer|_Rational|_Real|_Complex),options___]:=x;
ToCanonical[x_String,options___]:=x;

2.- We minimize dummies in equations and sums, but not in lists. SameDummies in a sum might eliminate the sum, and so we use MapIfPlus. In order for SameDummies to perform its job correctly we need to be sure that the expression is fully expanded, and so we need MathInputExpand. For the moment we do not use it with equations, in which we might be trying to keep some particular structure. MathInputExpand can potentially be very slow so it might be good to offer some way to control its behaviour.

(* 2. ToCanonical is threaded over lists, equations and sums *)
ToCanonical[list_List,options___]:=Map[ToCanonical[#,options]&,list];
ToCanonical[Equal[lhs_,rhs_],options___]:=Apply[Equal,Map[ToCanonical[#,options]&,SameDummies[{lhs,rhs}]]];
ToCanonical[expr_Plus,options___]:=MapIfPlus[ToCanonical[#,options]&,SameDummies@MathInputExpand[expr]];

3.- The action of ToCanonical on rules is a tricky point because we could change the structure of the LHS of a rule, maybe invalidating it. We prefer to leave them untouched:

(* 3. ToCanonical on rules: do nothing *)
ToCanonical[expr_Rule,options___]:=expr;
ToCanonical[expr_RuleDelayed,options___]:=expr;

4.- It is convenient to have special definitions for "frequent and simple cases".

(* 4. Special simple cases. These are exceptions to the general algorithm *)
ToCanonical[tensor_?xTensorQ[],options___]:=ToCanonicalTensorHead[tensor][];
ToCanonical[tensor_?xTensorQ[ind_],options___]:=Block[{$TCOptions=CheckOptions[options]},ToCanonicalTensorHead[tensor][ToCanonicalIndex[ind]]];
ToCanonical[covd_?CovDQ[ind_][tensor_?xTensorQ[]],options___]:=Block[{$TCOptions=CheckOptions[options]},covd[ToCanonicalIndex[ind]][ToCanonicalTensorHead[tensor][]]];

5.- We also give a definition to canonicalize single tensors with indices. Note that it avoids sorting. This calls directly ToCanonicalOne, instead of going through the machinery of ToCanonicalObject. When puthead gets sign=0 then the indices are exactly those at input and so reconstructing tensor@@inds does not pose any danger; it will get inmediately killed by the zero.

(* 5. A single tensor. An exception to the general algorithm *)
ToCanonical[tensor_?xTensorQ[inds__],options___]:=With[{t=ToCanonicalTensorHead[tensor],newinds=ToCanonicalIndex[IndexList[inds]]},
puthead[
t,
Sow[ToCanonicalOne[newinds,Union[UpIndex/@TakeEPairs[newinds]],SymmetryGroupOfTensor[t@@newinds],options],"NewIndices"]
]
];
puthead[tensor_,{sign_,inds_}]:=sign tensor@@inds;

6.- All other cases. Note that we send the options to Identify through xSort. Once the expression has been xSorted, we shift control to ToCanonicalObject. This is actually the only entry point for ToCanonicalObject. Finally we remove all intermediate heads used during sorting.

(* 6. ToCanonical on unsorted expressions: apply xSort, then canonicalize, and then UxSort *)
ToCanonical[expr_,options___]:=
UxSort[
ToCanonicalObject[
xSort[
SameDummies@MathInputExpand[expr],
options
],options
]
];

7.- Final definitions of ToCanonical:

SetNumberOfArguments[ToCanonical,{1,Infinity}];
Protect[ToCanonical];

15.3.2. ToCanonicalTensorHead

Now that we can have lots of information in the head of a tensor, we need a hook to canonicalize that information:

(* Lie brackets of vectors with ultraindices *)
ToCanonicalTensorHead[Bracket[v1_,v2_]]:=With[{cv1=ToCanonicalDir[v1],cv2=ToCanonicalDir[v2]},
Which[
v1===v2,Zero,
OrderedQ[{cv1,cv2}],Bracket[cv1,cv2],
True,MultiplyHead[-1,Bracket[cv2,cv1]]
]
];
(* Other. Match the behaviour of ToCanonical pre1.1 *)
ToCanonicalTensorHead[tensor_]:=tensor;

Note how MultiplyHead acts as a (Left) ProductByScalar. This function should be given a more important role in the system.

15.3.3. ToCanonicalObject

ToCanonicalObject takes the result of xSort and returns a standard expression.

ToCanonicalObject is also threaded over Plus, but now without sharing dummies first (it has been already done). This definition is needed because the sum might not be explicit originally (then the rule for ToCanonical would have fired), but it might have been generated by the use of MathInputExpand in the generic definition of ToCanonical, or because there is a sum in an argument of a scalar function, for instance.

ToCanonicalObject[Object[expr_VerbatimPlus,__],options___]:=ToCanonicalObject[#,options]&/@expr;

Then we have all other objects. This function is more complicated than it should be due to the handling of derivatives. The computation of riskyders uses UpIndexQ and hence does not see patterns. QUESTION.

ToCanonicalObject[object_,options:OptionsPattern[]]:=Module[
{sym=SymmetryOfObject[object],verb,mms,indices,dummies,vbundles,newindices,riskyders,result},
{verb,mms}=OptionValue[ToCanonical,{options},{Verbose,UseMetricOnVBundle}];

If[verb,
Print["***********************************************************"];
Print["ToCanonical:: object: ",object];
Print["ToCanonical:: sym: ",sym]
];

(* 0. Indices. Use sym and not object to ensure the right ordering of indices *)
indices=IndexList@@(Last/@sym[[3]]);
dummies=Union[UpIndex/@object[[3,3]]];
vbundles=Union[VBundleOfIndex/@List@@indices];

(* 1. Group theory *)
newindices=ToCanonicalOne[indices,dummies,sym[[4]],options];
If[verb,Print["ToCanonical:: newindices: ",newindices]];

(* 2. List of risky derivatives on metrics. QUESTION: what about bases? And inert heads? Dietmar Theiss has reported a xCoba case in which this leads to a bug *)
Switch[mms,
None,mms={},
All,mms=$VBundles];
riskyders=If[
Or[!$MixedDers,
newindices===0,
Intersection[vbundles,mms]==={},
(UpIndexQ/@indices)===(UpIndexQ/@Last@newindices)],
{},
Apply[List,RiskyDers[object],{1}]/.deronvbundle->Sequence
];
If[verb,Print["ToCanonical:: riskyders: ",riskyders]];

(* 3. Compute result from newindices *)
result=Which[
newindices==={0,indices},
0,
newindices==={1,indices},
object,
riskyders==={},
Reconstruct[sym,newindices],
True,
Message[ToCanonical::cmods,First/@riskyders];
ToCanonicalDers[UxSort[Reconstruct[sym]],options]
];
If[verb,Print["ToCanonical:: result: ",result]];

(* Final result, sowing the list of indices *)
Sow[newindices,"NewIndices"];
result
];
ToCanonical::cmods="Detected metric-incompatible derivatives `1`.";

This simple function reconstructs our expression to its original form:

Reconstruct[Symmetry[n_,smt_,slotrules_,_]]:=smt/.slotrules;
Reconstruct[Symmetry[n_,smt_,slotrules_,_],{sign_,perm_IndexList}]:=sign smt/.Inner[Rule,slot/@IndexList@@Range[n],perm,List];

Note that before calling ToCanonicalDers we reconstruct the expression. The algorithm in ToCanonicalDers is so different that nothing is gained by sending the parsed form.

15.3.4. ToCanonicalDers

This is the main algorithm for canonicalization of expressions containing derivatives and non-associated metrics. The main idea is transforming all derivatives into the Levi-Civita connection of the first-metric of the vbundle, canonicalizing, and then coming back to the original derivatives. This trick is clearly general for covariant derivatives and Lie derivatives, but it's not clear to me if it is valid for parametric derivatives. Comments on this:
	- Now the metrics do not depend on parameters, and therefore the problem does not really appear. But we want metrics to depend on parameters.
	- There is the question of whether a parametric derivative can be converted into a Lie derivative along some vector field. I think a Lie derivative can be represented as a parametric derivative using the parameter along the integral curves of the vector of the Lie derivative. However, in general, a parametric derivative is exploring a "dependence" which has nothing to do with any manifold, and therefore we would need to extend that manifold in one additional dimension to construct a vector corresponding to the parametric derivative. This explains, for example, why all parametric derivatives are assumed to commute, while several Lie derivatives on the same manifold do not commute in general.
	- Therefore I think that the trick of changing to the metric connection does not work for parametric derivatives.

Note that there is an alternative algorithm in those cases in which careQ is True: we could transform all indices of tensors into their original heights contracting or separating metrics and then canonicalizing without using the metric. I prefer the other one because it is closer in spirit to what we do in general: moving indices without changing the number of metric factors. The problem is that it is less general and does not work for all types of derivatives, or even worse, for inert heads.

Yet another possibility could be using a temporary decomposition in a frame in which the metric has constant coefficients, though I don't know how this could be implemented. Perhaps this is the way to proceed with parametric derivatives.

All functions here are private. Several steps:

0) Special inert-heads. TMPCovD is not linear to help grouping covariant derivatives. It is not a restriction.

DefInertHead[TMPChristoffel,LinearQ->True,ProtectNewSymbol->False,DefInfo->False];
DefInertHead[TMPCovD,ProtectNewSymbol->False,DefInfo->False,ContractThrough->{delta}];
TMPCovD[0,_]:=0;
(* Define the weight *)
WeightOf[TMPChristoffel[expr_,z___]]^:=WeightOf[expr];
WeightOf[TMPCovD[expr_,z___]]^:=WeightOf[expr];

1) addTMPCovD transforms derivatives into metric derivatives and Christoffels. In principle there are no options; once we know that the transformation of derivatives is required for canonicalization, then we try to transform all derivatives.

(* One argument to three or four arguments. Recursion on expr. Param ders not working *)
addTMPCovD[expr_]:=expr/.{
covd_?CovDQ[ind_][expr1_]:>addTMPCovD[addTMPCovD[expr1],covd[ind],CovD,VBundleOfIndex[ind]],
LieD[v_][expr1_]:>addTMPCovD[addTMPCovD[expr1],LieD[v],LieD,VBundleOfIndex[Dir[v]]],
OverDot[expr1_]:>addTMPCovD[addTMPCovD[expr1],OverDot,OverDot],
ParamD[pars__][expr1_]:>addTMPCovD[addTMPCovD[expr1],ParamD[pars],ParamD]
}

This constructs the new object. Several steps. We first add the first-metric of the vbundle, if any.

(* Four to five arguments. Add vbundle metric  *)
addTMPCovD[expr_,der_,type_,vbundle_]:=addTMPCovD[expr,der,type,vbundle,FirstMetricOfVBundle[vbundle,False]];

We need to add a mark in the derivatives to pinpoint those cases which must be transformed back (there could be metric-derivatives of the user in the expression, and those do not have to be transformed back). On the other hand we need to store somewhere the name of the old derivative to which we need to go back. We use the already defined TMPCovD, which stores as a second argument the original derivative.

The expr here is assumed to have only covdofmetric, and not any other covariant derivative, but can be a sum of terms and can have metrics. Note that we use changeCovD, which implements its own recursion, different and additional to that of addTMPCovD. Note also that we **do not** use the TMPChristoffel head at this step.

(* If there is no metric in the vbundle do not change derivative *)
addTMPCovD[expr_,der_,_,_,Null]:=der[expr];
(* Covariant derivatives. Use changeCovD adding the TMPCovD head. Do not mark Christoffels *)
addTMPCovD[expr_,covd_[ind_],CovD,vbundle_,metric_]:=changeCovD[covd[ind][expr],covd,CovDOfMetric[metric],TMPCovD,Identity];
(* Lie derivatives. Add the TMPCovD head. Do not mark derivatives of vector v *)
addTMPCovD[expr_,LieD[v_],LieD,vbundle_,metric_]:=
ExpandLieD[v,CovDOfMetric[metric],True,TMPCovD][expr];

2) Now that all derivatives are metric-compatible we apply ToCanonical, bringing all terms with derivatives into a canonical form.

3) Then we need to transform back to the previous derivative, using the derivative stored in the TMPCovD inert-head. Now the result is marked with the TMPChristoffel head, pinpointing the terms which still need canonicalization.

removeTMPCovD[expr_]:=changeTMPCovD[expr]//.TMPCovD[expr1_,__]->expr1;
changeTMPCovD[expr_]:=expr/.TMPCovD[covd_?CovDQ[ind_][expr1_],oldcovd_]:>TMPCovD[changeTMPCovD[covd[ind][changeTMPCovD@expr1],oldcovd],oldcovd];

changeTMPCovD[covd_?CovDQ[ind_][expr_],oldcovd_?CovDQ]:=changeCovD[covd[ind][expr],covd,oldcovd,Identity1,TMPChristoffel];

changeTMPCovD[covd_?CovDQ[dir_][expr_],LieD]:=CovDToLieD[covd[dir][expr],TMPChristoffel];

4) We expand the expression and canonicalize (with ToCanonical) those terms containing a TMPChristoffel head somewhere:

SecondToCanonical[expr_]:=secondcan[Expand[expr]];
secondcan[expr_Plus]:=secondcan/@expr;
secondcan[expr_]:=If[MemberQ[expr,TMPChristoffel,{0,Infinity},Heads->True],ToCanonical[expr/.TMPChristoffel->Identity],
expr];

5) This is the final function called from ToCanonical. It calls again ToCanonical and hence we must be extra careful to avoid infinite recursion.

This is an awfully complicated function, with 3 calls to ToCanonical in the worst case:

ToCanonicalDersChangeCovD[expr_,method_,options:OptionsPattern[]]:=Module[{verb,eC,result},
verb=OptionValue[ToCanonical,{options},Verbose];
eC="ExpandChristoffel"/.method/.Rest[Method/.Options[ToCanonical]];

result=Tee[SameDummies,verb]@Tee[SecondToCanonical,verb]@Tee[removeTMPCovD,verb]@Tee[ToCanonical,verb]@Tee[addTMPCovD,verb][expr];

If[eC,ToCanonical[result//ChristoffelToGradMetric//ContractMetric,UseMetricOnVBundle->None],result]
];

New, simpler function, based in a completely different idea:

ToCanonicalDersImplode[expr_,options:OptionsPattern[]]:=With[{verb=OptionValue[ToCanonical,{options},Verbose]},

ToCanonical[
Tee[Explode,verb]@ToCanonical[
Tee[Implode,verb][expr],
options],
UseMetricOnVBundle->None,options]

];

This is a simple tee structure to get verbose output if needed:

Tee[command_,verb_][expr_]:=Module[{result=command[expr]},
If[verb,Print[command,": ",result]];result];

The function ToCanonicalDers is called only by ToCanonicalObject, when the situation is complicated enough to require a change of canonicalization algorithm.

ToCanonicalDers[expr_,options:OptionsPattern[]]:=With[{method=OptionValue[ToCanonical,{options},Method]},
Switch[method,
ChangeCovD|{ChangeCovD,___},ToCanonicalDersChangeCovD[expr,Rest@Flatten[{method}],options],
Implode,ToCanonicalDersImplode[expr,options],
_,Throw@Message[ToCanonical::unknown,"method",method]
]
];

15.3.5. ToCanonicalOne: canonicalization of a set of indices

Input:
	- indices: list of names of indices as they appear in the tensor. That is, the first index corresponds to slot 1, the second to slot 2, etc.
	- dummies: list of NAMES of dummy indices (only the up-member) in no particular order.
	- syms: generating set of the group of slot-symmetries.
	- options
Output: IndexList[...] or -IndexList[...] with the sorted indices:

It is very important to note that this is the only function in all of xTensor calling CanonicalPerm.

posits[list_List]:=Apply[Join,posits/@list];
posits[DummySet[_,{pairs___},_]]:=Join[pairs];
posits[RepeatedSet[list_]]:=list;

MakeDummySet[dummies_,fm_,vbundle_]:=DummySet[vbundle,List@@Select[dummies,(VBundleOfIndex[#]===vbundle)&],If[fm&&MetricEndowedQ[vbundle],SymmetryOfMetric@FirstMetricOfVBundle[vbundle],0]];

$RepeatedSingletonsQ=True;

ToCanonicalOne is pretty large,even though it has many If[verb,...] sentences. QUESTION: When $RepeatedSingleTonsQ = True we take all blocked indices, and so we are not allowing for repeted b-indices. Is this a limitation? I cannot play for examples with tensors T[a,a], and sometimes that would be fine...

ToCanonicalOne[indices_IndexList,dummies_IndexList,syms_,options:OptionsPattern[]]:=Module[{order=Length[indices],sortedindices,perm,dummysets,frees,verb,not,mms,fm,repes,newsyms},

{verb,mms}=OptionValue[ToCanonical,{options},{Verbose,UseMetricOnVBundle}];

(* Actual configuration *)
If[verb,Print["ToCanonicalOne:: Actual configuration: ",indices]];
(* Standard configuration *)
sortedindices=IndexSort[indices];
If[verb,Print["ToCanonicalOne:: Standard configuration: ",sortedindices]];
(* Look for repeated indices *)
repes=If[$RepeatedSingletonsQ,Union@TakeBlocked[indices],TakeRepeated[indices]];
If[verb,Print["ToCanonicalOne:: Repeated indices: ",repes]];
repes=List@@Map[RepeatedSet,Flatten[IndexPosition[sortedindices,#]]&/@repes];
If[verb,Print["ToCanonicalOne:: Repeated indices: ",repes]];

(* Permutation to be canonicalized *)
perm=TranslatePerm[PermutationFromTo[List@@sortedindices,List@@indices],Images];
If[verb,Print["ToCanonicalOne:: Permutation to be canonicalized: ",perm]];

(* Arrange metric use on the vbundles *)
Switch[mms,
All,fm[_]:=True,
None,fm[_]:=False,
_List,(fm[#]:=True)&/@mms;fm[_]:=False
];

(* Separate dummies according to the existing vbundles *)
If[verb,Print["dummies: ",dummies]];
dummysets=MakeDummySet[dummies,fm[#],#]&/@$VBundles;
If[verb,Print["ToCanonicalOne:: dummysets_tmp: ",dummysets]];
(* Positions of dummies. No spinorial case considered yet *)
dummysets=dummysets/.DummySet[man_,dums_,metricQ_]:>DummySet[man,{IndexPosition[sortedindices,#][[1,1]],IndexPosition[sortedindices,ChangeIndex@#][[1,1]]}&/@dums,metricQ];
If[verb,Print["ToCanonicalOne:: dummysets: ",dummysets]];
(* Positions of free (here all non-dummies or non-repeated) indices *)
frees=Complement[Range@order,posits[dummysets],posits[repes]];
If[verb,Print["ToCanonicalOne:: Free indices: ",frees]];

(* Add symmetries coming from 1D vbundles *)
newsyms=Symmetry1D[syms,Inner[Rule,slot/@Range@Length@indices,List@@indices,List]];

(* !!!!!!!!!!!!!!!! Invert to meet Renato's notation !!!!!!!!!!!!!!!! *)
perm=InversePerm[perm];

(* Canonicalization *)
If[verb,Print["ToCanonicalOne:: calling: ","CanonicalPerm[",perm,",",order,",",newsyms,",",frees,",",Join[dummysets,repes],",",options,"]"]];
perm=CanonicalPerm[perm,order,newsyms,frees,Join[dummysets,repes],FilterRules[{options},Options[CanonicalPerm]]];
If[verb,Print["ToCanonicalOne:: Canonical permutation: ",perm]];

(* !!!!!!!!!!!!!!!! Invert back to our notation !!!!!!!!!!!!!!!! *)
perm=If[perm===0,0,InversePerm[perm]];

(* Final indices: {sign, indexlist} *)
If[perm===0,{0,indices},{If[Head[perm]===Times,-1,1],PermuteList[sortedindices,perm]}]

];

15.3.6. Simplification

Simplification is simply ToCanonical with a Simplify:

Simplification[expr_,options___]:=Simplify@ToCanonical[expr,options];
SetNumberOfArguments[Simplification,{1,Infinity}];

We do not protect it because it will be given more definitions below.

15.4. Examples

15.4.1. Examples with a single tensor

Examples. First, there is no metric in M2:

BeginExamples[]

ToCanonical[]

$ContextPath

DefTensor[riemannR[-A,-B,-C,-D],{M2},GenSet[-Perm[{-B,-A,-C,-D}]],PrintAs->"R"]

ToCanonical[riemannR[-B,-A,-D,-C]]

Note that this tensor is not zero because, not having a metric, the expression does not make sense:

ToCanonical[riemannR[A,-A,C,D]]

Catch@xATP`ValidateTensor[riemannR[A,-A,C,D]]

UndefTensor[riemannR]

DefTensor[r[],M2]

ToCanonical[r[]]//Trace

ToCanonical[r[A]]//Trace

ToCanonical[r[A,B]]//Trace//ByteCount

ToCanonical[r[A,B,C]]//Trace//ByteCount

ToCanonical[r[A,B,C,D]]//Trace//ByteCount

UndefTensor[r]

Now we introduce a metric and define the Riemann tensor with the usual symmetries:

xUpSet[MetricsOfVBundle[TangentM2],{metricg}];
xUpSet[xTensorQ[metricg],True];
xUpSet[SymmetryGroupOfTensor[metricg],Symmetric[{1,2}]];

DefTensor[riemannR[-A,-B,-C,-D],{M2},GenSet[-Perm[{-B,-A,-C,-D}],Perm[{-C,-D,-A,-B}]],PrintAs->"R"]

ToCanonical[riemannR[A,-B,-A,B]]

ToCanonical[riemannR[A,-A,B,C]]

Use of UseMetricOnVBundle:

ToCanonical[riemannR[A,-B,-A,B],UseMetricOnVBundle->None]

ToCanonical[riemannR[A,-A,B,C],UseMetricOnVBundle->None]

ToCanonical[riemannR[A,-A,B,C],UseMetricOnVBundle->{TangentM2}]

ToCanonical[riemannR[A,-A,B,C],UseMetricOnVBundle->{TangentS2}]

ToCanonical[riemannR[A,-A,B,C],UseMetricOnVBundle->{TangentM2,TangentS2}]

ToCanonical[riemannR[-C,-B,-A,-D]]

ToCanonical[riemannR[B,-D,-B,-A]]

SymmetryOf[riemannR[B,-D,-B,-A]]

ToCanonical[riemannR[B,-D,-B,-A],Verbose->True]

UndefTensor[riemannR]

DefTensor[T[-A,-B,-C],{M2},Symmetric[{-A,-B,-C}]]

ToCanonical[T[-C,-B,-A]]

UndefTensor[T]

DefTensor[T[-A,-B,-C],{M2},Antisymmetric[{-A,-B,-C}]]

ToCanonical[T[-C,-B,-A]]

UndefTensor[T]

DefTensor[T[A,B,C,D,F,G],{M2},GenSet[Perm[{B,A,C,D,F,G}],-Perm[{A,B,D,C,F,G}],Perm[{A,B,C,D,G,F}]]]

ToCanonical[T[A,-A,B,C,-D,D]]

ToCanonical[T[A,-A,-C,C,-D,F]]

UndefTensor[T]

DefTensor[T[A,B,C,D,F,G],{M2},GenSet[xAct`xPerm`Cycles[{1,2}],-xAct`xPerm`Cycles[{3,4}],xAct`xPerm`Cycles[{5,6}]]]

ToCanonical[T[A,-A,B,C,-D,D]]

ToCanonical[T[A,-A,-C,C,-D,F]]

UndefTensor[T]

EndExamples[]

15.4.2. Examples with several tensors

BeginExamples[]

DefTensor[T[A,B],M2,Symmetric[{A,B}]]
DefTensor[UU[-A,-B],M2,Antisymmetric[{-A,-B}]]
DefTensor[S[A,B],M2]
DefTensor[V[A],M2]
DefTensor[r[],M2]
DefTensor[R[-A,-B,-C,-D],M2,RiemannSymmetric[{1,2,3,4}]]

ToCanonical[UU[C,B]R[-G,-G1,-G2,-G3]T[-A,-B]S[-C,G]V[A]]

ToCanonical[UU[C,B]R[-G,-G1,-G2,-G3]T[-A,-B]S[-C,G]V[A],OrderedBase->False]

ToCanonical[UU[-D,-F]V[D]V[F]]

ToCanonical[UU[-B,-A]T[B,A]]

ToCanonical[UU[-B,-A]+3r[]^2T[-B,-A],Verbose->True]

ToCanonical[Scalar[UU[C,D]UU[-C,-D]]]

ToCanonical[Scalar[UU[C,D]UU[-C,-D]]^2]

ToCanonical[Scalar[UU[C,D]UU[-C,-D]]^2Scalar[UU[-B,-D]UU[B,D]]]

Sin[UU[D,A]UU[-D,-A]]Scalar[UU[C,D]UU[-C,-D]]^3Scalar[UU[-B,-D]UU[B,D]]/Scalar[7UU[A,C]UU[-A,-C]]^2

ToCanonical[%]

%/.Sin->Identity

$Tensors

ToCanonical[Sin[UU[A,B]UU[-A,-B]+1]]

UndefTensor/@{T,S,UU,V,R,r};

xUpSet[MetricsOfVBundle[TangentM2],{}];

DefTensor[S[A,B],M2]

DefTensor[T[A,B,C],M2,Symmetric[{1,2,3}]]

DefMetric[-1,gg[-A,-B],Cd,{";","D"}]

In this case the indices can be moved:

Cd[-A][S[-B,-C,B]]

ToCanonical[%]

but not in this case:

ToCanonical[%%,UseMetricOnVBundle->None]

If we have PD instead of Cd this is done much more carefully. Note that in those cases the algorithm does not arrive at the final solution in a single step:

PD[-A][S[-B,-C,B]]

ToCanonical[%]

ToCanonical[S[C,A]Cd[-D][T[-A,-B,B]],UseMetricOnVBundle->None]

ToCanonical[S[C,A]Cd[-D][T[-A,-B,B]]]

Note the difference in timings:

ToCanonical[S[C,A]PD[-D][T[-A,-B,B]],UseMetricOnVBundle->None]//ScreenDollarIndices//Timing

ToCanonical[Last[%]]//ScreenDollarIndices//Timing

S[C,-A]PD[-D][T[A,-B,B]]-S[C,A]PD[-D][T[-A,B,-B]]

ToCanonical[%]//ScreenDollarIndices

ToCanonical[%%,Method->{ChangeCovD,"ExpandChristoffel"->True}]//ScreenDollarIndices

And canonicalize:

ToCanonical[S[C,A]PD[-D][T[-A,-B,B]]]

ToCanonical[S[C,-A]PD[-D][T[A,-B,B]]]//ScreenDollarIndices

ToCanonical[S[C,-A]PD[-D][T[A,-B,B]],Method->{ChangeCovD,"ExpandChristoffel"->True}]//ScreenDollarIndices

UndefTensor/@{T,S};

A metric can be undefined using either UndefTensor or UndefMetric:

UndefTensor[gg];

And with repeated indices:

DefTensor[T[A,B,C],M2,Antisymmetric[{1,2}]]

T[B,A,C]//ToCanonical

T[{2,Polar},{1,Polar},{3,Polar}]//ToCanonical

T[{1,Polar},{1,Polar},{3,Polar}]//ToCanonical

T[{1,Polar},{3,Polar},{1,Polar}]//ToCanonical

T[{1,-Polar},{3,-Polar},{1,-Polar}]//ToCanonical

T[{1,Polar},{1,Polar},{1,Polar}]//ToCanonical

T[{1,Polar},{1,-Polar},{1,Polar}]//ToCanonical

T[{1,-Polar},{1,-Polar},{1,Polar}]//ToCanonical

UndefTensor[T]

EndExamples[]

15.4.3. Products of an antisymmetric tensor

BeginExamples[]

DefTensor[UU[-A,-B],M2,Antisymmetric[{-A,-B}]]

xUpSet[MetricsOfVBundle[TangentM2],{metricg}];

$xpermQ

Order of S is 2:

2!/2

ToCanonical[UU[-B,B],TimeVerbose->True,MathLink->False]//AbsoluteTiming

If[$xpermQ,ToCanonical[UU[-B,B],MathLink->True]//AbsoluteTiming]

Order of S is 2x4=8:

4!/8

ToCanonical[UU[-B,-A]UU[A,B],TimeVerbose->True,MathLink->False]//AbsoluteTiming

If[$xpermQ,ToCanonical[UU[-B,-A]UU[A,B],MathLink->True]//AbsoluteTiming]

Order of S is 2x4x6=48:

6!/48

ToCanonical[UU[-B,-A]UU[A,C]UU[-C,B],TimeVerbose->True,MathLink->False]//AbsoluteTiming

If[$xpermQ,ToCanonical[UU[-B,-A]UU[A,C]UU[-C,B],MathLink->True]//AbsoluteTiming]

Order of S is 2x4x6x8=384:

8!/384

ToCanonical[UU[-B,-A]UU[A,C]UU[-C,-D]UU[D,B],TimeVerbose->True,MathLink->False]//AbsoluteTiming

If[$xpermQ,ToCanonical[UU[-B,-A]UU[A,C]UU[-C,-D]UU[D,B],MathLink->True]//AbsoluteTiming]

Order of S is 2x4x6x8x10=3840:

10!/3840

ToCanonical[UU[-B,-A]UU[A,C]UU[-C,-D]UU[D,F]UU[-F,B],TimeVerbose->True,MathLink->False]//AbsoluteTiming

If[$xpermQ,ToCanonical[UU[-B,-A]UU[A,C]UU[-C,-D]UU[D,F]UU[-F,B],MathLink->True]//AbsoluteTiming]

12!/46080

ToCanonical[UU[-B,-A]UU[A,C]UU[-C,-D]UU[D,F]UU[-F,-G]UU[G,B],TimeVerbose->True,MathLink->False]//AbsoluteTiming

If[$xpermQ,ToCanonical[UU[-B,-A]UU[A,C]UU[-C,-D]UU[D,F]UU[-F,-G]UU[G,B],MathLink->True]//AbsoluteTiming]

14!/645120

ToCanonical[UU[-B,-A]UU[A,C]UU[-C,-D]UU[D,F]UU[-F,-G]UU[G,G1]UU[-G1,B],TimeVerbose->True,MathLink->False]//AbsoluteTiming

If[$xpermQ,ToCanonical[UU[-B,-A]UU[A,C]UU[-C,-D]UU[D,F]UU[-F,-G]UU[G,G1]UU[-G1,B],MathLink->True]//AbsoluteTiming]

16!/10321920

ToCanonical[UU[-B,-A]UU[A,C]UU[-C,-D]UU[D,F]UU[-F,-G]UU[G,G1]UU[-G1,-G2]UU[G2,B],TimeVerbose->True,MathLink->False]//AbsoluteTiming

If[$xpermQ,ToCanonical[UU[-B,-A]UU[A,C]UU[-C,-D]UU[D,F]UU[-F,-G]UU[G,G1]UU[-G1,-G2]UU[G2,B],MathLink->True]//AbsoluteTiming]

ToCanonical[UU[-B,-A]UU[A,C]UU[-C,-D]UU[D,F]UU[-F,-G]UU[G,G1]UU[-G1,-G2]UU[G2,G3]UU[-G3,B],TimeVerbose->True,MathLink->False]//AbsoluteTiming

If[$xpermQ,ToCanonical[UU[-B,-A]UU[A,C]UU[-C,-D]UU[D,F]UU[-F,-G]UU[G,G1]UU[-G1,-G2]UU[G2,G3]UU[-G3,B],MathLink->True]//AbsoluteTiming]

?UU

UndefTensor[UU]

xUpSet[MetricsOfVBundle[TangentM2],{}];

EndExamples[]

15.4.4. Products of Riemann tensors

BeginExamples[]

DefTensor[Rie[-A,-B,-C,-D],M2,RiemannSymmetric[{1,2,3,4}]]

DefTensor[T[-A,-B],M2]

DefTensor[S[-A,-B,-C,-D],M2]

xUpSet[MetricsOfVBundle[TangentM2],{metricg}];

?Rie

GetIndicesOfVBundle[TangentM2,10]

myterm=Rie[A,B,C,D]Rie[G,F,G1,G2]Rie[G3,-A,-G4,-G]Rie[-B,-C,-D,-G3]Rie[-F,-G1,-G2,G4];

ToCanonical[myterm,TimeVerbose->True,MathLink->False]//AbsoluteTiming

If[$xpermQ,ToCanonical[myterm,MathLink->True]//AbsoluteTiming]

myterm=S[G1,-G,G2,G3] Rie[-B,-C,A,D] Rie[-D,C,-A,G] Rie[-G1,G4,F,B] T[-G2,-G3];

Depending on the Booleans $CommutingFreeIndices and OrderedBase we have 4 possibilities. We also check that we get the same result with Mathematica and with the external executable:

$CommuteFreeIndices=True;

r1=ToCanonical[myterm,MathLink->False,TimeVerbose->True]

If[$xpermQ,ToCanonical[myterm,MathLink->True]]

r2=ToCanonical[myterm,OrderedBase->False,TimeVerbose->True,MathLink->False]

If[$xpermQ,ToCanonical[myterm,OrderedBase->False,MathLink->True]]

$CommuteFreeIndices=False;

r3=ToCanonical[myterm,TimeVerbose->True,MathLink->False]

If[$xpermQ,ToCanonical[myterm,MathLink->True]]

r4=ToCanonical[myterm,OrderedBase->False,TimeVerbose->True,MathLink->False]

If[$xpermQ,ToCanonical[myterm,OrderedBase->False,MathLink->True]]

{r1,r2,r3,r4}//ColumnForm

UndefTensor/@{Rie,T,S};

DefTensor[T[A,B],M2]
DefTensor[S[A,B],M2,Symmetric[{A,B}]]
DefTensor[UU[A,B],M2,Antisymmetric[{A,B}]]
DefTensor[V[A],M2]

T[A,B]V[-B]T[C,D]V[-D]UU[-A,-C]//xSort

T[A,B]V[-B]T[C,D]V[-D]UU[-A,-C]//ToCanonical

UndefTensor/@{T,S,UU,V};

xUpSet[MetricsOfVBundle[TangentM2],{}];

Remove[myterm,r1,r2,r3,r4]

EndExamples[]

15.4.5. More examples with derivatives

BeginExamples[]

DefTensor[T[-A,-B],M2]

DefCovD[CD[-A],{";","D"}]

DefMetric[-1,g[-A,-B],cd,{";","▽"}]

For example we could have this divergence:

xATP`addTMPCovD[CD[-A][T[A,C]]]//ScreenDollarIndices

We fake some canonicalization process:

%/.A->-A

Then remove temporary derivative:

%//xATP`removeTMPCovD

Simplify:

%//SameDummies

%/.xATP`TMPChristoffel->Identity

That requires some additional canonicalization or transformation to derivatives of the metric:

%//ChristoffelToMetric

%//ContractMetric

%//ScreenDollarIndices

Similar example with a Lie derivative (this is not working now. TODO):

xATP`addTMPCovD[T[-B]LieD[T[A]][T[A,-A,B,C]]]//Expand//ScreenDollarIndices

%/.{A->-A,B->-B}

%//xATP`removeTMPCovD//Expand

%//SameDummies

%/.expr_xATP`TMPChristoffelLieD:>xATP`convertChristoffelTMP[expr]

%//ScreenDollarIndices

Undef/@{g,CD,T};

EndExamples[]

15.4.6. Even more examples

BeginExamples[]

DefTensor[T[A,B],M2]
DefTensor[S[A,B],M2]

xUpSet[MetricsOfVBundle[TangentM2],{g}];
xTensorQ[g]^=True;
SymmetryGroupOfTensor[g]^=Symmetric[{1,2}];

T[-A,A]//ToCanonical

T[-A,A]S[-B,B]-T[B,-B]S[A,-A]//ToCanonical

T[-A,A,-B,B]-T[B,-B,A,-A]//ToCanonical

xUpSet[MetricsOfVBundle[TangentM2],{}];
UndefTensor/@{T,S};

Remove[g];

EndExamples[]

Other examples:

BeginExamples[]

DefTensor[U[a,b,c],S2,Antisymmetric[{1,2,3}]]

DefTensor[v[a],S2]

DefMetric[1,metric[-a,-b],CD,{";","▽"},PrintAs->"g"]

This is correct:

U[a,b,c]PD[-a][v[d]]PD[-b][v[e]]metric[-d,-e]

ToCanonical[%]

and this is also correct:

U[a,b,c]CD[-a][v[-d]]CD[-b][v[d]]

ToCanonical[%]

However, here we cannot commute the objects. The system detects that and changes the algorithm. Interestingly the cancellation actually happens and we end up with a single derivative of the vector v:

U[a,b,c]PD[-a][v[-d]]PD[-b][v[d]]

TODO: THIS IS WRONG NOW:

ToCanonical[%]//ScreenDollarIndices

%//ChristoffelToMetric//ToCanonical//ScreenDollarIndices

%//ContractMetric

UndefTensor/@{metric,U,v};

EndExamples[]

15.5. Symmetry-related structures

15.5.1. ImposeSymmetry

This is a general function to construct a symmetrized version of an expression. From version 0.9.8 of xTensor` we introduce a fourth argument, which is a function acting on individual terms sequentially. This is never a gain in speed, but it can be a gain in memory.

ImposeSymmetry[expr_,{inds___},SGS_,f_:Identity]:=ImposeSymmetry[expr,IndexList[inds],SGS,f];
ImposeSymmetry[expr_,inds_IndexList,sym:(_Symmetric|_Antisymmetric),f_:Identity]:=ImposeSymmetry[expr,inds,SGSofsym[sym],f];
ImposeSymmetry[expr_,inds_IndexList,SGS_StrongGenSet,f_:Identity]:=ImposeSymmetry[expr,inds,SGS[[2]],f];
ImposeSymmetry[expr_,inds_IndexList,GS_GenSet,f_:Identity]:=ImposeSymmetry[expr,inds,Dimino[GS],f];
ImposeSymmetry[expr_,inds_IndexList,group_Group,Identity]:=Plus@@(PermuteIndices[expr,inds,#]&/@group)/Length[group];
ImposeSymmetry[expr_,inds_IndexList,group_Group,f_]:=Module[{tmp=0,elem},Do[tmp+=f[PermuteIndices[expr,inds,group[[elem]]]],{elem,Length[group]}];tmp]/Length[group];
ImposeSymmetry[expr_,inds_,group_,f_:Identity]:=Throw@Message[ImposeSymmetry::error,"Cannot impose symmetry."];
SetNumberOfArguments[ImposeSymmetry,{3,4}];
Protect[ImposeSymmetry];

BeginExamples[]

DefTensor[Test[-A,-B,-C],M2,Antisymmetric[{-A,-B,-C}]]

ImposeSymmetry[Test[-A,-B,-C],{-A,-B},Symmetric[{1,2}]]

ImposeSymmetry[Test[-A,-B,-C]Test[-D,-F,-G],{-A,-D},Symmetric[{1,2}]]

UndefTensor[Test]

EndExamples[]

Special simple cases. Note that when giving integers the list of indices has head List.

xAct`xTensor`Symmetrize[expr_]:=xAct`xTensor`Symmetrize[expr,FindFreeIndices[expr],Identity];
xAct`xTensor`Symmetrize[expr_,{},f_:Identity]:=expr;
xAct`xTensor`Symmetrize[expr_,inds:{__Integer},f_:Identity]:=xAct`xTensor`Symmetrize[expr,FindIndices[expr][[inds]],f];
xAct`xTensor`Symmetrize[expr_,inds_,f_:Identity]:=ImposeSymmetry[expr,inds,Symmetric@Range@Length[inds],f];
SetNumberOfArguments[xAct`xTensor`Symmetrize,{1,3}];
Protect[xAct`xTensor`Symmetrize];

Antisymmetrize[expr_]:=Antisymmetrize[expr,FindFreeIndices[expr],Identity];
Antisymmetrize[expr_,{},f_:Identity]:=expr;
Antisymmetrize[expr_,inds:{__Integer},f_:Identity]:=Antisymmetrize[expr,FindIndices[expr][[inds]],f];
Antisymmetrize[expr_,inds_,f_:Identity]:=ImposeSymmetry[expr,inds,Antisymmetric@Range@Length[inds],f];
SetNumberOfArguments[Antisymmetrize,{1,3}];
Protect[Antisymmetrize];

PairSymmetrize[expr_,{},f_:Identity]:=expr;
PairSymmetrize[expr_,inds:{{_?GIndexQ,_?GIndexQ}..},f_:Identity]:=ImposeSymmetry[expr,Flatten[inds],GenSet@@(xAct`xPerm`Cycles@@#&/@Transpose/@Partition[Partition[Range[2Length[inds]],2],2,1]),f];
SetNumberOfArguments[PairSymmetrize,{2,3}];
Protect[PairSymmetrize];

PairAntisymmetrize[expr_,{},f_:Identity]:=expr;
PairAntisymmetrize[expr_,inds:{{_?GIndexQ,_?GIndexQ}..},f_:Identity]:=ImposeSymmetry[expr,Flatten[inds],GenSet@@(-xAct`xPerm`Cycles@@#&/@Transpose/@Partition[Partition[Range[2Length[inds]],2],2,1]),f];
SetNumberOfArguments[PairAntisymmetrize,{2,3}];
Protect[PairAntisymmetrize];

We perform cyclizing through an independent construct:

Cyclize[expr_,inds_List,f_:Identity]:=Plus@@Map[f,ReplaceAll[expr,Map[Inner[Rule,inds,#,List]&,NestList[RotateRight,inds,Length[inds]-1]]]]/Length[inds];
SetNumberOfArguments[Cyclize,{2,3}];
Protect[Cyclize];

15.5.2. Monomials

These three functions identify the objects by the indices they have. An important problem is the fact that blocked indices do not identify objects because they can be repeatd. The idea is that here we only worry about AB indices and those indices cannot be repeated.

These functions could be constructed from the Object structure returned by xSort, but for historical reasons they are based on IsIndexOf.

ObjectsWithIndices returns a list with the objects having the given indices (upindices or downindices) in a term. Note that ObjectsWithIndices with a single index must give a list with zero or one elements, but never more, so that we directly ask for a single object:

(* Plus expression: throw an error *)
ObjectsWithIndices[expr_Plus,_]:=Throw[Message[MonomialsOfTerm::error,"Expression with head Plus cannot be separated in monomials."];ERROR[expr]];
(* List of indices *)
ObjectsWithIndices[term_,list_IndexList]:=Union@Flatten[ObjectsWithIndices[term,#]&/@List@@list];
(* Single index. IsIndexOf used without third argument *)
ObjectsWithIndices[term_,index_]:=Select[ListOfFactors[term],IsIndexOf[#,index]&,1];
Protect[ObjectsWithIndices];

This is not a very efficient function, but the coding is very simple.

Examples:

BeginExamples[]

DefTensor[T[A,B,C],M2]
DefTensor[UU[-A,-B,-C],M2]
DefTensor[S[-A,-B,-C],M2]
DefTensor[V[A,B],M2]
DefConstantSymbol[Mass]

DefCovD[Cd[-A],{"|","∂"}]

xATP`ObjectsWithIndices[1,A]

xATP`ObjectsWithIndices[T[A,B,C],A]

xATP`ObjectsWithIndices[T[A,B,C]Cd[-A][UU[-D,-B,-C]],A]

xATP`ObjectsWithIndices[T[A,B,C]Cd[-A][UU[-D,-B,-C]],IndexList[A,-C]]

xATP`ObjectsWithIndices[T[A,B,C]Cd[-A][UU[-D,-B,-C]],IndexList[A,B]]

xATP`ObjectsWithIndices[T[A,B,C]Cd[-A][UU[-D,-B,-C]],-A]

xATP`ObjectsWithIndices[T[A,B,C]Cd[-D][UU[-A,-B,-C]],-A]

xATP`ObjectsWithIndices[T[A,B,C]Cd[-F][Cd[-D][UU[-A,-B,-C]]],-C]

xATP`ObjectsWithIndices[T[A,B,C]Cd[V][Cd[-C][Cd[-D][UU[-A,-B,-F]]]],-C]

xATP`ObjectsWithIndices[T[-A,-B,-C]LieD[V[A]][T[D,B,C]],A]

xATP`ObjectsWithIndices[T[{A,Polar},-B,-C]LieD[V[A]][T[D,B,C]],{A,Polar}]

xATP`ObjectsWithIndices[T[{A,Polar},-B,-C]LieD[V[A]][T[D,B,C]],{A,Polar}]

xATP`ObjectsWithIndices[T[{A,Polar},-B,-C]LieD[V[A]][T[D,B,C]],{A,polar}]

xAct`xCoba`BasisColor[polar]^=Hue[0];

xATP`ObjectsWithIndices[T[{A,polar},-B,-C]LieD[V[A]][T[D,B,C]],{A,polar}]

xATP`ObjectsWithIndices[T[{A,polar},-B,-C]LieD[V[A]][T[D,B,C]],{A,Polar}]

ObjectsWithIndices works with directions, integer basis-indices and labels, but in principle this should never happen because they cannot be free indices:

xATP`ObjectsWithIndices[T[Dir[V[-Z]],-B,-C]LieD[V[A]][T[D,B,C]],Dir[V[-Z]]]

xATP`ObjectsWithIndices[T[{1,Polar},-B,-C]LieD[V[A]][T[D,B,C]],{1,Polar}]

xATP`ObjectsWithIndices[T[LI[1],-B,-C]LieD[V[A]][T[D,B,C]],LI[1]]

Patterns do not behave as expected:

xATP`ObjectsWithIndices[T[A_,-B,-C]LieD[V[A]][T[D,B,C]],A_]

xATP`ObjectsWithIndices[T[A_,-B,-C]LieD[V[A]][T[D,B,C]],B_]

Remove[polar];

EndExamples[]

Given a term, we decompose it in monomials: minimal products of tensors such that every free index of the product is a free index of the term. We first define the Monomial inert head:

InertHeadQ[Monomial]^=True;
PrintAs[Monomial]^="Monomial";

We first need a function that finds the monomial identified by a given free index. We supply the list of all free indices to avoid the repetition of the calculations. The Monomial construction saves time when ordering monomials. Note that only FindFreeIndices is used here, and not FindIndices; that ensures that only abstract indices and noninteger basis indices will appear in the list frees. The list inds only contains traceable indices because we use TakeEIndices in MonomialsOfTerm. Note also that the indices of the Monomial construction are sorted according to Sort.

(* Two arguments: Find free indices of term and set up Monomial. Convert to four arguments. Argument inds can be an index or an IndexList *)
FindMonomial[term_,inds_]:=FindMonomial[term,inds,FindFreeIndices[term],Monomial[1,IndexList[]]];
(* Four arguments. No more indices to look for: stop monomial construction *)
FindMonomial[_,IndexList[],_IndexList,monomial_]:=monomial;
(* Four arguments. More indices to look for *)
FindMonomial[term_,inds_,frees_IndexList,Monomial[monomial_,minds_IndexList]]:=FindMonomial[term,ChangeIndex/@Complement[#[[2]],frees],frees,#]&@(Monomial[#,FindFreeIndices[#]]&@(Times@@ObjectsWithIndices[term/monomial,inds]monomial))
Protect[FindMonomial];

Finally MonomialsOfTerm gives the list of monomials in a term. Note that the first element of the list is a special monomial; it is a product of numbers and scalars with head ScalarMonomial. ScalarMonomial gives a monomial with no traceable indices; Monomial[...,{}] gives a monomial with no free indices.

(* Find traceable indices of term and setup list of monomials *)
MonomialsOfTerm[term_]:=MonomialsOfTerm[term,TakeEIndices@FindIndices[term],{}];
(* Select monomial of first index of term *)
MonomialsOfTerm[term_,IndexList[i_,is___],monomials_List]:=MonomialsOfTerm[term,IndexList[is],monomials,FindMonomial[term,i]];
(* New monomial: append to list and eliminate from term *)
MonomialsOfTerm[term_,IndexList[is___],monomials_List,Monomial[monomial_,minds_]]:=MonomialsOfTerm[term/monomial,Complement[IndexList[is],FindIndices[monomial]],Append[monomials,Monomial[monomial,minds]]]
(* Non-indexed monomial. Prepend to list with head ScalarMonomial *)
MonomialsOfTerm[term_,IndexList[],monomials_List]:=Prepend[monomials,ScalarMonomial@@ListOfFactors[term]]

Note that MonomialsOfTerms is also used in the simplification of Scalar expressions. See further below. This is the user driver:

BreakInMonomials[expr_Plus]:=BreakInMonomials/@expr;
BreakInMonomials[expr_]:=Apply[Times,MonomialsOfTerm[expr]/.ScalarMonomial->Times/.Monomial[mono_,inds_]->Monomial[mono]];
SetNumberOfArguments[BreakInMonomials,1];
Protect[BreakInMonomials];

Examples:

BeginExamples[]

xATP`FindMonomial[1,-A]

xATP`FindMonomial[T[A,F,C],A]

%//InputForm

xATP`FindMonomial[T[A,F,C]S[-A,-F,-D]Cd[H][V[J,B]]UU[-B,-G,-H],-G]

xATP`FindMonomial[T[A,F,C]S[-A,-F,-D]Cd[H][V[J,B]]UU[-B,-G,-H],J]

xATP`FindMonomial[T[A,F,C]S[-A,-F,-D]Cd[H][V[J,B]]UU[-B,-G,-H],IndexList[-D,C]]

Note that if we give one of the dummy indices the function returns the correct result too:

xATP`FindMonomial[T[A,F,C]S[-A,-F,-D]Cd[H][V[J,B]]UU[-B,-G,-H],F]

xATP`FindMonomial[T[A,F,C]S[-A,-F,-D]Cd[H][V[J,B]]UU[-B,-G,-H],-F]

xATP`FindMonomial[T[A,F,C]S[-A,-F,-D]Cd[H][V[J,B]]UU[-B,-G,-H],H]

xATP`MonomialsOfTerm[3 Mass^2T[]T[A,F,C]S[-A,-F,-D]Cd[H][V[J,B]]UU[-B,-G,-H]]

xATP`MonomialsOfTerm[3 Mass^2T[]T[A,F,C]S[-A,-F,-D]Cd[H][V[J,B]]UU[-B,-G,-H]Scalar[U[A,B]UU[-A,-B]]]

xATP`MonomialsOfTerm[3 Mass^2T[]T[A,F,C]S[-A,-F,-D]Cd[H][V[J,B]]UU[-B,-G,-H]Scalar[UU[A,B]UU[-A,-B]]^2]

xATP`MonomialsOfTerm[3 Mass^2T[{1,Polar},{1,Polar},{-1,Polar}]T[A,F,C,{-1,Polar},Dir[V[Z]]]S[-A,-F,-D]Cd[H][V[J,B]]UU[-B,-G,-H,{-1,Polar}]Scalar[UU[A,B]UU[-A,-B]]^2]

BreakInMonomials[3 Mass^2T[]T[A,F,C]S[-A,-F,-D]Cd[H][V[J,B]]UU[-B,-G,-H]]

%//InputForm

UndefCovD[Cd]

UndefConstantSymbol[Mass]

UndefTensor/@{T,UU,S,V};

EndExamples[]

These three functions work nicely, but they could be more efficient.

15.5.2. Manipulation of Scalar expressions

Three functions are needed to manipulate expressions containing the head Scalar. The functions PutScalar and NoScalar are inverse of each other. We could introduce the inverse of BreakScalars (say GroupScalars), but that would be difficult, and it is not clear to me that it is really needed.

1) A Scalar expression can be broken in several Scalar expressions:

BreakScalars[expr_]:=expr/.Scalar[s_]:>Apply[Times,MonomialsOfTerm[s]//.{ScalarMonomial->Times,Monomial[monomial_,IndexList[]]->Scalar[monomial]}]

2) This function detects the presence of scalars with indexed objects and introduces the head Scalar:

makeScalar[ScalarMonomial[expr__]]:=Times[expr]
makeScalar[expr_Scalar]:=expr
makeScalar[Monomial[expr_,IndexList[]]]:=Scalar[expr]
makeScalar[Monomial[expr_,IndexList[__]]]:=expr

PutScalar[expr_]:=Apply[Plus,Apply[Times,makeScalar/@MonomialsOfTerm[#]]&/@ListOfTerms[expr]/.{ScalarMonomial->Times}]

3) Scalar expressions are converted into normal tensorial expressions without the Scalar head. Dummy indices cannot be repeated. We assume that the only dangerous case is the power of a Scalar expression. This is a dangerous operation that could easily lead to index collisions if used without care:

NoScalar[expr_]:=expr/.Scalar[x_]^n_Integer?Positive:>Apply[Times,ReplaceDummies/@Table[x,{n}]]/.Scalar[x_]:>ReplaceDummies[x]

New safer code, developed together with Guillaume Faye:

(* Thread over Plus and Times *)
NoScalar[expr_Plus]:=NoScalar/@expr;
NoScalar[expr_Times]:=NoScalar/@expr;
(* Remove Scalar head from positive powers *)
NoScalar[Power[expr_,n_Integer?Positive]]:=Apply[Times,Table[NoScalar[expr],{n}]];
NoScalar[Scalar[expr_]]:=ReplaceDummies[expr];
(* Skip inert heads *)
NoScalar[ih_?InertHeadQ[expr_,z___]]:=ih[NoScalar[expr],z];
NoScalar[expr:_?ProductQ[___]]:=NoScalar/@expr;
(* Derivatives *)
NoScalar[der_?FirstDerQ[expr_]]:=der[NoScalar[expr]];
(* Do nothing on other cases *)
NoScalar[expr_]:=expr;
SetNumberOfArguments[NoScalar,1];
Protect[NoScalar];

15.5.3. Examples with Scalar

Examples:

BeginExamples[]

DefTensor[v[A],M2]
DefTensor[T[A,B],M2,Symmetric[{1,2}]]

Scalar[v[B$]v[-B$]]

ToCanonical[%]

ToCanonical[%^2]

ToCanonical[Scalar[v[A$]v[-A$]]^2Scalar[v[B]v[-B]]^3]

((Scalar[v[A$]v[-A$]]^2Scalar[v[B]v[-B]]^3)/(Scalar[v[C]v[-C]]))//Simplification

Exp[Scalar[T[A$,B$]v[-A$]v[-B$]]]//Simplification//ScreenDollarIndices

Scalar[v[A$]v[-A$]T[C$,D$]v[-C$]v[-D$]]/Scalar[v[A]v[-A]]

%//BreakScalars

%//Simplification

UndefTensor/@{v,T};

EndExamples[]

15.5.4. STF tensors

Coefficient to substract the n-th trace of a tensor with l indices in d dimensions:

asymcoeff[n_,l_,d_]:=Gamma[l-n+d/2-1]Gamma[l+1]/((-4)^n Gamma[n+1]Gamma[l+d/2-1]Gamma[l+1-2n])

Note that it also can be written as (this has been deactivated):

asymcoeff[n,l,d]==(( Binomial[l,n] Binomial[l-n,n])/((((-4))^n)Binomial[-2+(d/2)+l,-2+(d/2)+l-n]))//FullSimplify

This is the STF command. Note that we select the AIndices only. This function does not worry about non-metric derivatives, bases, etc. It needs a more careful behaviour:

STFPart::wrongsym="Indices with different height cannot be symmetrized: `1`.";
STFPart[expr_,metric_,indices_:All]:=Module[{n,l,inds,symexpr,pairs,dummypairs,dummy,dim},
(* Indices *)
inds=Select[FindFreeIndices[expr],AIndexQ];
If[indices=!=All,inds=Intersection[inds,IndexList@@indices]];
l=Length[inds];
pairs=Partition[inds,2];
dummypairs=Map[DummyAs,pairs,{2}];
(* Dimension *)
dummy=DummyIn[VBundleOfMetric[metric]];
dim=metric[dummy,-dummy];
(* Symmetrize. Sent message, but do not throw it *)
If[Not[SameQ@@(UpIndexQ/@inds)],Message[STFPart::wrongsym,inds]];
symexpr=xAct`xTensor`Symmetrize[expr,List@@inds];
(* Remove traces *)
symexpr+Sum[asymcoeff[n,l,dim]xAct`xTensor`Symmetrize[symexpr=metric@@(pairs[[n]])metric@@(ChangeIndex/@dummypairs[[n]])ReplaceIndex[Evaluate[symexpr],Inner[Rule,pairs[[n]],dummypairs[[n]],List]] ,List@@inds],{n,1,Floor[l/2]}]
];
SetNumberOfArguments[STFPart,{2,3}];
Protect[STFPart];

15.5.6. Implicit symmetrization. The Sym head

We introduce a new head which plays the role of Symmetrize, but without actually expanding the expression. Thanks toThomas Backdahl for discussions on this object.

(* Definition of Sym as an inert-head *)
InertHeadQ[Sym]^=True;
DefInfo[Sym]^={"inert head",""};
LinearQ[Sym]^=True;
PrintAs[Sym]^="Sym";
(* Linearity *)
Sym[x_?ConstantQ y_,other__]:=x Sym[y,other];
Sym[expr_Plus,other__]:=Sym[#,other]&/@expr;
Sym[0,other__]:=0;
(* Shortcuts *)
Sym[expr_]:=Sym[expr,FindFreeIndices[expr]];
Sym[expr_,inds_]:=Sym[expr,inds,Symmetric[Range@Length@inds]];
Sym[expr_,inds_,GS_GenSet]:=Sym[expr,inds,SchreierSims[{},GS]];

Note that the second argument must have head IndexList and the third argument is converted into a StrongGenSet structure.

Unfortunately, we are not able yet to provide a direct definition of SymmetryOf[Sym[expr_,__]], but we shall introduce a trick to avoid it. TODO: I'm not sure this code is correct.

(* Temporary functions to handle spinorial metrics *)
symsign[list_List]:=Times@@(symsign1/@list);
symsign1[-x_Symbol]:=SymmetryOfIndex[x];
symsign1[x_Symbol]:=1;
(* Note that we place Sdelta after the expression. This is important for the symsign convention before *)
Sym/:ToCanonical[Sym[expr_,inds_,sym_],options___]:=With[{exprinds=Cases[FindIndices[expr],Alternatives@@inds]},
Module[{newinds=DummyAs/@exprinds,Sexpr},
Sexpr=symsign[newinds]ReplaceIndex[expr,Thread[exprinds->newinds]]Sdelta[sym][Sequence@@(ChangeIndex/@newinds),Sequence@@exprinds];
Sym[ContractMetric[RemoveSdelta@ToCanonical[Sexpr,options]],inds,sym]]];

SetNumberOfArguments[Sym,{1,3}];
Protect[Sym];

15.A. Reworking the canonicalizer

Suppose we start with a general standard expression, which is a sum of terms prod1[v[a], prod2[w[b,-c, ...], ... ], ... ]. To canonicalize this we should proceed in these steps:
	1) Change all derivatives to TensorDerivative form, and mark those new TensorDerivative heads. Hence we only have tensor[inds] objects now.
	2) Expand, so that we have a sum of products.
	3) Minimize the number of dummies.
	4) Hide the external Plus, to avoid early canonicalization and reevaluations of Plus.
	5) Strip off the heads of the products, to hide their attributes.
	2) reorder the expressions to some canonical form compatible with the properties of the products and the grades of the tensors
	3) convert the expression into a sum of terms xTensor[...][a, b, -c, ...]
	4) compute the slot symmetries of the xTensor[...] objects
	5) find canonical reordering of indices, without modifying the xTensor[...] object
	6) reorder the indices according to 5) and reconstruct a standard expression.

We see that we need two natural forms for the expressions. We need names. What we have used until now could be called the “standard form”, and the new could be the “non-standard form”. That could work for the moment.

15.A.1. Stripped expressions

This is a function that converts any standard expression into an inert form with stripping wrappers.

ToStripped[expr_]:=Strip[SameDummies@MathInputExpand[ToTMPTensorDerivative[expr]]];
SetNumberOfArguments[ToStripped,1];
Protect[ToStripped];

We need to distinguish the TensorDerivative objects we introduce from those that the user had originally.

ToTMPTensorDerivative[expr_]:=expr/.dexpr:(_?CovDQ[__][_]|LieD[_][_]|ParamD[__][_]|OverDot):>(ToTensorDerivative[dexpr]/.TensorDerivative->TMPTensorDerivative);
xTensorQ[TMPTensorDerivative[exprs__]]^:=xTensorQ[TensorDerivative[exprs]];

Strip returns expressions with these possible structures:
	StrippedPlus[strippeds]
	Stripped[type, object][inds]
The key point is that now the canonicalizer will only see tensor[inds] objects (note we prepare Stripped to accept future additional arguments):

xTensorQ[Stripped[type_,object_,props___]]^:=True;

(* Hide Plus, to avoid unexpected early canonicalization *)
Strip[expr_Plus]:=Strip/@(StrippedPlus@@expr);
(* Hide Times *)
Strip[expr_Times]:=StripProduct[Times,Strip/@List@@expr];
(* Tensors *)
Strip[tensor_?xTensorQ[inds___]]:=Stripped[Tensor,tensor,Length[{inds}]][inds];
(* Scalars *)
Strip[c_?ConstantQ]:=Stripped[Constant,c,0][];
Strip[p_Symbol?ParameterQ]:=Stripped[Parameter,p,0][];
Strip[expr_Scalar]:=Stripped[Scalar,ToCanonicalScalar[expr],0][];
Strip[sf_?ScalarFuncionQ[args__]]:=Stripped[ScalarFunction,ToCanonicalScalar/@sf[args],0][];
(* Inert heads *)
Strip[ih_?InertHeadQ[expr_,z___]]:=StripInertHead[ih,Strip[expr],z];
(* Hide other products *)
Strip[prod_?ProductQ[factors___]]:=StripProduct[prod,Strip/@{factors}];
(* Default *)
Strip[expr_]:=expr;

(* Convert products of stripped tensors into a single stripped object *)
StripProduct[prod_,factors_]:=With[{heads=Head/@factors,inds=IndexList@@@factors},
If[Union[Head/@heads]=!={Stripped},Throw[Validate::error,"Invalid expression found."]];
With[{joininds=Join@@inds},
Stripped[Product,{prod,heads},Length[joininds]]@@joininds
]
];

(* Convert an inert head expression into a tensor. We need to store the initial indices to compare heights at the end *)
StripInertHead[ih_,stripped_Stripped[inds___],z___]:=Stripped[InertHead,{ih,stripped,{inds},z},Length[{inds}]][inds];

Inverse conversion:

FromStripped[sexpr_StrippedPlus]:=Plus@@(FromStripped/@sexpr);
FromStripped[Stripped[Tensor,TMPTensorDerivative[exprs__],n_][inds___]]:=FromTensorDerivative[TensorDerivative[exprs][inds]];
FromStripped[Stripped[Tensor,tensor_,n_][inds___]]:=tensor[inds];
FromStripped[Stripped[Constant,c_,0][]]:=c;
FromStripped[Stripped[Parameter,p_,0][]]:=p;
FromStripped[Stripped[Scalar,scalar_,0][]]:=scalar;
FromStripped[Stripped[ScalarFunction,scalar_,0][]]:=scalar;
FromStripped[Stripped[Product,{prod_,strippeds_List},n_][inds___]]:=
prod@@(FromStripped/@Apply@@@Transpose[{strippeds,Internal`PartitionRagged[{inds},strippeds[[All,3]]]}]);
(* Inert heads may be problematic if deltas or metrics cannot be contracted through them *)
FromStripped[Stripped[InertHead,{ih_,stripped_,initinds_List,z___},n_][inds___]]:=With[{needed=NeededChanges[{inds},DummyAs[#,Automatic]&/@initinds]},
If[And@@(ContractThroughQ[ih,#]&/@(Head/@needed)),
ih[FromStripped[stripped[inds]],z],
ContractMetric[xAct`xCoba`ContractBasis[ih[FromStripped[stripped@@initinds],z]Times@@needed]]
]
];
(* Default *)
FromStripped[expr_]:=expr;
SetNumberOfArguments[FromStripped,1];
Protect[FromStripped];

(* We are assuming (do not check) that both indices belong to the same space. Put dummies in the second index of deltas and metrics, so that their contraction is tried first *)
NeededChanges[inds_List,dummies_List]:=MapThread[NeededChange,{inds,dummies}];
NeededChange[ind1_,ind2_]:=Switch[{UpIndexQ[ind1],UpIndexQ[ind2]},
{True,True},delta[ind1,DownIndex@ind2],
{False,False},delta[ind1,UpIndex@ind2],
{True,False},FirstMetricOfVBundle[VBundleOfIndex[ind2],True][ind1,UpIndex@ind2],
{False,True},Inv[FirstMetricOfVBundle[VBundleOfIndex[ind2],True]][ind1,DownIndex@ind2],
_,Throw@Message[FromStripped::error1,"Found invalid indices:",{ind1,ind2}]
];

15.A.2. Sort stripped expressions

The idea here is that when we find a product that has some special symmetry then we can sort the tensors to some canonical order. This must be done before (and independently) of the canonicalization of the order of indices.

16. Computations

(*************************** 16.Computations **************************)

{TimeUsed[],SessionTime[],TimeUsed[]/SessionTime[]}

16.0. Comments

If[$ReadingVerbose,Print["Reading section 16: Computations."],Null,Null]

There is nothing concerning index notations in this section. Some functions only work for abstract indices.

16.1. Validation

16.1.1. Definitions

This function validates an expression. Note that we assume that ValidateTensor, ValidateCovD, ValidateLieD and ValidateBracket implement some kind of recursion (internal calls to UncatchedValidate). The expression is assumed to be already evaluated; Validate has attribute HoldFirst.  QUESTION: Is really this what we want?

?Validate

SetAttributes[Validate,HoldFirst]
Validate[expr_]:=Catch[UncatchedValidate[expr]];
SetNumberOfArguments[Validate,1];
Protect[Validate];

SetAttributes[UncatchedValidate,HoldFirst]
(* Out expressions *)
UncatchedValidate[x_Out]:=UncatchedValidate[Evaluate[x]];
(* Held expressions *)
UncatchedValidate[(Hold|HoldForm|HoldComplete|HoldPattern|xHold)[expr_]]:=UncatchedValidate[expr];
(* Times and Plus expressions. Check indices *)
UncatchedValidate[expr:(_Times|_Plus|_?ProductQ[___])]:=(FindIndices[expr];UncatchedValidate/@Unevaluated[expr]);
(* xTensor expressions. Convert to ValidateType *)
UncatchedValidate[t:_?xTensorQ[___]]:=ValidateTensor[t];
UncatchedValidate[covd:_?CovDQ[_][_]]:=ValidateCovD[covd];
UncatchedValidate[lied:LieD[_][_]]:=ValidateLieD[lied];
UncatchedValidate[br:Bracket[_,_][_]]:=ValidateBracket[br];
(* xTensor expressions. Recursion *)
UncatchedValidate[ParamD[ps__?ParameterQ][expr_]]:=ParamD[ps][UncatchedValidate[expr]];
UncatchedValidate[OverDot[expr_]]:=OverDot[UncatchedValidate[expr]];
UncatchedValidate[ih_?InertHeadQ[expr_,z___]]:=ih[UncatchedValidate[expr],z];
UncatchedValidate[Scalar[expr_]]:=Scalar[UncatchedValidate[expr]];
UncatchedValidate[sf_?ScalarFunctionQ[sc_,x___]]:=sf[UncatchedValidate[sc],x];
UncatchedValidate[Derivative[ders__Integer][f_][args__]]:=MapAt[Derivative[ders],UncatchedValidate[f[args]],0];
UncatchedValidate[c_Symbol?ConstantSymbolQ]:=c;
(* Atoms *)
UncatchedValidate[number:(_Integer|_Rational|_Real|_Complex)]:=number;
UncatchedValidate[string_String]:=string;
UncatchedValidate[x_Symbol]:=x;
(* Mathematica constructions *)
UncatchedValidate[expr:(_Slot|_Blank|_Pattern)]:=expr;
UncatchedValidate[Function[expr_]]:=Function[UncatchedValidate[expr]];
(* Other cases. Note that if h IS known the els ARE NOT validated *)
UncatchedValidate[x:h_[els___]]:=If[FreeQ[Join[$SystemNames,$xActNames],ToString[h]],
Throw[Message[Validate::unknown,"head",h]],x];
SetNumberOfArguments[UncatchedValidate,1];
Protect[UncatchedValidate];

Recall that a useful way of tracing problems is turning On[General::warning].

16.1.2. Examples

BeginExamples[]

DefTensor[R[A,B,C,D],M2,Symmetric[{1,2,3}]]

DefTensor[S[A,B],M2,Antisymmetric[{1,2}]]

DefTensor[T[-A,-B],M2,Antisymmetric[{1,2}]]

DefTensor[v[A],M2]

Validate[v[-A]v[A]]

Validate[v[-A]]

Validate[R[A,B,C,D]T[-A,B]]

Validate[R[A,B,C,D]T[-A,-B]]

$Pre=Validate;

R[A,B,C,D]T[-A,B]

R[A,B,C,D]T[-A,-B]

There is something strange here, due to the fact that we have changed the generic definition for Validate:

Validate[Null]

$Pre=.

Validate[Null]

R[A,B,C,D]T[-A,B]

Validate[%]

$Tensors

TracePrint[Validate[PD[-C][S[A,B]T[-A,-B]]],xATP`UncatchedValidate[_]]

TracePrint[Validate[Hold[PD[-C][S[A,B]T[-A,-B]]]],xATP`UncatchedValidate[_]]

$Tensors

UndefTensor/@{R,S,T,v};

EndExamples[]

16.2. Equations

16.2.1. Equality and unequality

Firstly, we must define the concept of equality of indexed expressions. Two indexed expressions are equal if they have the same canonical form. They are different if they have different free indices. In other cases, the expression is left unchanged.

Note that we use sx, sy temporarily to store the possible dummy indices, dropping the free indices:

Simplification[(action:Equal|Unequal)[x_,y_],options___]:=Module[{
fx=List@@FindFreeIndices[x],
fy=List@@FindFreeIndices[y],
sx,sy},
sx=Complement[$AbstractIndices,UpIndex/@fx];
sy=Complement[$AbstractIndices,UpIndex/@fy];
sx=ReplaceDummies[Simplification@x,IndexList@@sx];
sy=ReplaceDummies[Simplification@y,IndexList@@sy];
Which[
Sort@fx=!=Sort@fy && sx=!=0&&sy=!=0,action/.{Equal->False,Unequal->True},
True,action[sx,sy]
]
]

Now we can protect Simplification:

Protect[Simplification];

Examples:

BeginExamples[]

DefTensor[T[A,B],M2]

DefTensor[v[-A],M2]

T[A,B]v[-B]==T[A,C]v[-C]

Simplification[%]

Should we issue an error or just give False here?

Simplification[T[A,B]v[-B]==T[B,C]v[-C]]

Simplification[PD[-D][T[A,B]v[-B]]==PD[-D][T[A,C]]v[-C]+T[A,F]PD[-D][v[-F]]]

UndefTensor/@{T,v};

EndExamples[]

16.2.2. Solving indexed equations

The concept of a tensor equation is not simple. Here we will only solve for linear equations of the form
	scalar  tensor1[inds] == tensor2[inds]
In general it is not possible to solve an equation with a product of objects. For example it is not possible to solve    v[A] w[B] = T[A,B]    for v. In the future we will include more general types of equations. IndexSolve is not prepared to handle indices other than abstract indices.

IndexSolve::free="Cannot solve for tensor with unknown free indices: `1`.";
IndexSolve[False,object_,options___]:={}
IndexSolve[True,object_,options___]:={{}}
IndexSolve[lhs_==rhs_,object_,options___]:=Module[{seq=Simplification[Expand[lhs-rhs]],frees,inds,scalar,righths,verb=OptionValue[MakeRule,{options},Verbose]},
frees=FindFreeIndices[Evaluate[seq]];
inds=Select[FindIndices[object],ABIndexQ];
If[verb,Print["frees: ",frees,", inds: ",inds]];
If[Sort@frees=!=Sort@inds,Throw[Message[IndexSolve::free,inds]]];
scalar=ToCanonical@Scalar@Coefficient[seq,ToCanonical@object];
If[verb,Print["scalar: ",scalar]];
If[!ScalarQ[scalar],Throw[Message[IndexSolve::error,""]]];
righths=Simplification[NoScalar[seq-scalar object]];
If[verb,Print["righths: ",righths]];
MakeRule[{Evaluate[object],Evaluate[-righths/scalar]},PatternIndices->List@@frees,options]//Flatten
]
SetNumberOfArguments[IndexSolve,{2,Infinity}];
Protect[IndexSolve];

Example:

BeginExamples[]

DefTensor[T[A,B],M2]
DefTensor[v[A],M2]
DefTensor[r[],M2]
DefTensor[w[A],M2]

This expression has free indices {A,F} and is not homogeneous in T. Note that dummy indices are all internally replaced to avoid confusion:

rule=IndexSolve[T[A,F]v[B]w[-B]r[]==3T[A,F]v[B]w[-B]r[]^3+v[A]v[F]v[B]v[-B],T[A,F]]

rule//ScreenDollarIndices

T[C,D]v[B]w[-B]r[]/.rule//ScreenDollarIndices

%//BreakScalars

%//PutScalar

Simplification[%]

Compare with the direct application of Solve. There is no care about scalars, and no patterns on the lhs.

Solve[T[A,F]v[B]w[-B]r[]==3T[A,F]v[B]w[-B]r[]^3+v[A]v[F]v[B]v[-B],T[A,F]]

A homogeneous case:

xTensorQ[metricg]^=True;
SymmetryGroupOfTensor[metricg]^=StrongGenSet[{1},GenSet[Cycles[{1,2}]]];
xUpSet[MetricsOfVBundle[TangentM2],{metricg}];

IndexSolve[T[A,F]v[B]w[-B]r[]==3T[A,F]v[C]w[-C]r[]^3,T[A,F],MetricOn->All]//ScreenDollarIndices

xUpSet[MetricsOfVBundle[TangentM2],{}];

Remove[metricg];

UndefTensor/@{T,v,r,w};

EndExamples[]

16.3. IndexCoefficient and IndexCollect

16.3.0. Comments

I thank Alfonso García-Parrado and Juanjo López-Villarejo for many discussion on this important pair of functions.

16.3.1. IndexCoefficient

(* Shortcut: With nonindexed form change to Coefficient *)
IndexCoefficient[expr_,form_?NonIndexedScalarQ]:=Coefficient[expr,form];
(* Recursion *)
IndexCoefficient[expr_,form1_ form2_]:=IndexCoefficient[Expand@IndexCoefficient[expr,form1],form2];
(* General case: Expand symmetry and average *)
IndexCoefficient[expr_,form_]:=average@SymmetryIndexCoefficient[ReplaceDummies[expr],SymmetryEquivalentsOf[form]];
SetNumberOfArguments[IndexCoefficient,2];
Protect[IndexCoefficient];

(* Secondary functions *)
average[{0...}]:=0;
average[list_List]:=With[{nonzero=DeleteCases[list,0]},Plus@@nonzero/Length[nonzero]];
(* Thread over symmetry equivalents *)
SymmetryIndexCoefficient[expr_,list_List]:=IndexCoefficient1[expr,#]&/@list;
(* Thread over Plus *)
IndexCoefficient1[expr_Plus,form_]:=IndexCoefficient1[#,form]&/@expr;
(* Products *)
IndexCoefficient1[expr_Times,form_]:=average@Map[IndexCoefficient2[expr/#,#,form]&,List@@expr];
IndexCoefficient1[expr_,form_]:=IndexCoefficient2[1,expr,form];
(* Compare expr and form *)
IndexCoefficient2[rest_,expr_,-form_]:=-IndexCoefficient2[rest,expr,form];
IndexCoefficient2[rest_,expr_,form_]:=rest IndexCoefficient3[FindIndices[expr],FindIndices[form]]/;SameExpressionsQ[expr,form];
IndexCoefficient2[rest_,expr_,form_]:=0;
(* Compute coefficient. Assume lists have same length. inds1 are the indices of expr and inds2 are the indices of form *)
IndexCoefficient3[inds1_,inds1_]:=1;
IndexCoefficient3[inds1_,inds2_]:=IndexCoefficient3[inds1,inds2,TakeEPairs[inds1],TakeEPairs[inds2]];
(* 1. There are no dummies: form pairs, taking care of repeated free indices.
   EXTENDED TO THE GENERAL CASE TO SEE WHAT HAPPENS *)
IndexCoefficient3[inds1_,inds2_,_,_]:=IndexCoefficient4[Thread[{inds1,inds2},IndexList],Intersection[inds1,inds2]];
todelta[{___,_LI,___}]:=Throw@Message[IndexCoefficient::error,"Cannot collect label indices."];
(* QUESTION: Is this OK with spinors? *)
todelta[{a_,b_?DownIndexQ}]:=delta[a,ChangeIndex[b]];
todelta[{a_,b_?UpIndexQ}]:=delta[ChangeIndex[b],a];
IndexCoefficient4[pairs_,IndexList[]]:=Apply[Times,todelta/@pairs];
IndexCoefficient4[IndexList[pairs1___,{a_,a_},pairs2___],IndexList[a_,other___]]:=IndexCoefficient4[IndexList[pairs1,pairs2],IndexList[other]];
IndexCoefficient4[_,_]:=0;
(* 2. There are dummies. ??? *)

This function checks whether two expressions are equal or not up to indices. We check equality of length of indices in order to allow for variable-rank tensors:

SameExpressionsQ[expr_,expr_]:=True;
SameExpressionsQ[tensor_[inds1___],tensor_?xTensorQ[inds2___]]:=Length[{inds1}]===Length[{inds2}];
SameExpressionsQ[covd_[_][expr1_],covd_?CovDQ[_][expr2_]]:=SameExpressionsQ[expr1,expr2];
SameExpressionsQ[ParamD[ps1__][expr1_],ParamD[ps2__][expr2_]]:={ps1}==={ps2}&&SameExpressionsQ[expr1,expr2];
SameExpressionsQ[LieD[v1_][expr1_],LieD[v2_][expr2_]]:=SameExpressionsQ[v1,v2]&&SameExpressionsQ[expr1,expr2];
SameExpressionsQ[Bracket[v1a_,v1b_][_],Bracket[v2a_,v2b_][_]]:=SameExpressionsQ[v1a,v2a]&&SameExpressionsQ[v1b,v2b];
SameExpressionsQ[prod_?ProductQ[tensors1___],prod_?ProductQ[tensors2___]]:=Length[{tensors1}]===Length[{tensors2}]&&And@@MapThread[SameExpressionsQ,{{tensors1},{tensors2}}];
SameExpressionsQ[_,_]:=False;

Old code. This function only works on form's with free indices, and sometimes (due to the ReplaceDummies construction) on form's with dummy indices.

$Coeffindices:=SymbolJoin[#,"$$"]&/@IndexList@@$AbstractIndices;
IndexCoefficient[expr_,form_]:=Coefficient[ReplaceDummies[expr,$Coeffindices],ReplaceDummies[form,$Coeffindices]];
SetNumberOfArguments[IndexCoefficient,2];
Protect[IndexCoefficient];

BeginExamples[]

DefTensor[T[A,B],M2]
DefTensor[v[C],M2]

DefTensor[metricg[-A,-B],M2,Symmetric[{1,2}],PrintAs->"g"]

Unprotect[TangentM2];
MetricsOfVBundle[TangentM2]^={metricg};

IndexCoefficient[T[-A,-B]v[-C]+v[-A]v[-B]v[-C],v[-C]]

It doesn't work yet with free indices:

IndexCoefficient[T[A,-A]v[-C]+T[B,-B]v[-C],T[C,-C]]

UndefTensor/@{T,v};

UndefTensor[metricg]

MetricsOfVBundle[TangentM2]^={};
Protect[TangentM2];

EndExamples[]

16.3.2. IndexCollect

This is a simple recursive function based on IndexCoefficient. Again, we imitate Mathematica's builtin Collect. The recursive part of the code is pretty clear, but the "rest" part of the code is not that clear. In particular, it is not enough to act with the f function because lots of metrics could have been generated. That is why we use f@ToCanonical@ContractMetric on that part, though I don't really like this because the user does not expect to have that there. That is why we define a (currently private) global function to control that point.

$IndexCollectRest=Composition[ToCanonical,ContractMetric];
IndexCollect[expr_,forms_]:=IndexCollect[expr,forms,Identity];
IndexCollect[expr_,{},f_]:=f[expr];
IndexCollect[expr_,{form1_,forms___},f_]:=With[{coeff=ReplaceDummies@IndexCoefficient[expr,form1]},form1 IndexCollect[coeff,{forms},f]+f[$IndexCollectRest[expr- coeff form1]]];
IndexCollect[expr_,x_,f_]:=IndexCollect[expr,{x},f];
SetNumberOfArguments[IndexCollect,{2,3}];
Protect[IndexCollect];

Old code:

IndexCollect[expr_,tensor_[],f_]:=Collect[expr,tensor[],f];
IndexCollect[expr_,tensor_,f_]:=EIndexCollect[Expand[ReplaceDummies[expr]],tensor,f];
EIndexCollect[expr_Plus,tensor_,f_]:=Collect[Map[EIndexCollect[#,tensor,f]&,expr],tensor,f];
changerule[Rule[x_,y_]]:=Rule[ChangeIndex[x],ChangeIndex[y]];
EIndexCollect[rest_. tensor_[oldinds__],tensor_[newinds__],f_]:=With[{rules=Apply[Rule,Transpose[{{oldinds},{newinds}}],1]},ReplaceIndex[rest tensor[oldinds],Join[rules,changerule/@rules]]]

BeginExamples[]

DefTensor[T[-a,-b,-c],M2,Symmetric[{1,2,3}]]
DefTensor[Y[-a,-b,-c],M2]
DefTensor[W[a,b],M2,Symmetric[{1,2}]]

expr=T[-a,-b,-c]W[b,c]+Y[-d,-a,-f]W[d,f]

IndexCollect[expr,W[d,c]]

IndexCoefficient[expr,W[d,c]]

UndefTensor/@{T,Y,W};

EndExamples[]

16.4. calc function

This function is now only used for examples in this notebook:

Options[calc]={
ExpandCoordinates->False,
ExpandProductManifolds->True,
PrintTimeThreshold->1,
Screen->True,
UseMetric->True,
UseRiemann->False,
Verbose->False};
calc[f_,options:OptionsPattern[]]:=Module[{time,result,verb,tmp},time=TimeUsed[];

verb=OptionValue[Verbose];

(* Initialize *)
result=f;

If[verb,Print["1) Looking for product manifolds..."]];
If[OptionValue[ExpandProductManifolds],result=ExpandProductMetric[TraceProductDummy[result],$ProductMetrics]];
If[verb, Print[result]];

If[verb,Print["2) Applying global rules"]];
result=Expand[result]//.$Rules;
If[verb, Print[result]];

If[verb,Print["3) Using Riemann..."]];
If[OptionValue[UseRiemann],result=SortCovDs[result]];
If[verb, Print[result]];

(* Third, metric contractions *)
If[verb,Print["4) Using metric rules..."]];
If[OptionValue[UseMetric],result=ContractMetric[result]];
If[verb, Print[result]];

(* Finally, simplifications *)
If[verb,Print["5) Simplifying..."]];
result=Simplification[result,options];
If[verb, Print[result]];

If[verb,Print["6) Coordinate expansions..."]];
If[OptionValue[ExpandCoordinates],result=TraceBasisDummy[result] ];
If[verb, Print[result]];

If[verb,Print["7) Rules..."]];
result=result//.$Rules;

If[OptionValue[Screen],result=ScreenDollarIndices[result]];

If[(time=TimeUsed[]-time)>OptionValue[PrintTimeThreshold],Print["Elapsed time: ",time, " seconds"]];

Simplify[result]

];
calc[f_List,options___]:=calc[#,options]&/@f;
SetNumberOfArguments[calc,{1,Infinity}];
Protect[calc];

16.5. Tracing abstract product dummies

There are three things to worry about here:
	1) The expression could be of the form a  (b + c) and therefore we must expand the sum before applying TraceProductDummy. TraceProductDummy must be always applied on terms. This is handled by TraceDummy.
	2) We must be able to expand only a few dummies and not the others.  We use a list of indices (head IndexList) as second argument.
	3) We must be able to say that we want to expand all indices of a given space.

New code:

TraceProductDummy[expr_]:=TraceProductDummy[expr,IndexList@@$SumVBundles];
TraceProductDummy[expr_,list_IndexList]:=Fold[TraceProductDummy,expr,list];
TraceProductDummy[expr_,vbundle_?VBundleQ]:=With[{vbundleQ=VBundleIndexQ[vbundle]},TraceDummy[expr,_?vbundleQ:>SubdummiesIn[vbundle]]];
TraceProductDummy[expr_,index_Symbol?AIndexQ]:=TraceDummy[expr,index:>SubdummiesIn[VBundleOfIndex[index]]];
SetNumberOfArguments[TraceProductDummy,{1,2}];
Protect[TraceProductDummy];

Old code:

TraceProductDummy::noindex="Cannot trace index `1`.";
(* One argument: convert to two arguments *)
TraceProductDummy[expr_]:=TraceProductDummy[expr,VBundle/@$SumVBundles];
(* Two arguments: convert to TraceProductDummy1 *)
TraceProductDummy[expr_,x_]:=TraceProductDummy1[Expand[expr],x];
(* TraceProductDummy1 with two arguments: expand Plus/List and convert to three arguments *)
TraceProductDummy1[expr_Plus,x_]:=TraceProductDummy[#,x]&/@expr;
TraceProductDummy1[expr_List,x_]:=TraceProductDummy[#,x]&/@expr;
TraceProductDummy1[expr_,x_]:=TraceProductDummy1[expr,x,Fold[Select[#1,VBundleIndexQ[#2]]&,IndexName/@FindDummyIndices[expr],$SumVBundles]];
(* TraceProductDummy1 with three arguments: index *)
TraceProductDummy1[expr_,index_Symbol,dummies_IndexList]:=TraceProductDummy1[expr,index,MemberQ[dummies,index]];
TraceProductDummy1[expr_,index_Symbol,False]:=(Message[TraceProductDummy::noindex,index];expr);
TraceProductDummy1[expr_,index_Symbol,True]:=Plus@@ReplaceIndex[expr,{index->#,-index->-#}&/@DummyIn/@List@@Last[SplittingsOfVBundle@VBundleOfIndex@index]];
(* TraceProductDummy1 with three arguments: list *)
TraceProductDummy1[expr_,{VBundle[vb_],x___},dummies_IndexList]:=TraceProductDummy1[expr,Select[dummies,VBundleIndexQ[vb]]~Join~IndexList[x],dummies];
TraceProductDummy1[expr_,IndexList[index_Symbol,x___],dummies_IndexList]:=TraceProductDummy1[TraceProductDummy1[expr,index,dummies],IndexList[x],DeleteCases[dummies,index]];
TraceProductDummy1[expr_,IndexList[],dummies_IndexList]:=Expand[expr];
(* TraceProductDummy1 with three arguments: other cases *)
TraceProductDummy1[_,x_,_]:=Throw[Message[TraceProductDummy::noindex,x]];

SetNumberOfArguments[TraceProductDummy,{1,2}];
Protect[TraceProductDummy];

Examples:

BeginExamples[]

TraceProductDummy[]

TraceProductDummy[1,2,3,4]

DefTensor[UU[A],M2]

DefManifold[Mprod,{M2,S2},{alpha,beta,mu,nu,sigma,lambda,rho,eta},omega]

?Mprod

?TangentMprod

DefTensor[v[mu],Mprod]

DefTensor[w[mu],Mprod]

TraceProductDummy[w[mu]v[-mu],mu]//ScreenDollarIndices

TraceProductDummy[v[mu]w[-mu](v[nu]v[-nu]+w[lambda]w[-lambda])]//ScreenDollarIndices

TraceProductDummy[v[-mu],w[mu,nu],v[-nu]]//ScreenDollarIndices

UndefTensor[w]

UndefTensor[v]

UndefManifold[Mprod]

?Mprod

?M2

UndefTensor[UU]

EndExamples[]

16.6. Product metric

In this case we do not worry about the dimension of the product manifold. That is, for example if the product manifold has dimension 3 we do not worry about the Weyl tensor, which is 0. We assume that this is consistently treated by the submanifolds.

QUESTION: Do we have to prepare this function for Christoffels not related to PD?
QUESTION: I think the treatment of densities is far from general.
Note that we do not check that the indices of the expression to decompose belong to submanifolds of the decomposed product manifold. In particular if we use indices of the product manifold the rules are repeatedly applied, without limit. A possible solution could be to define MetricScalar[metric, vbundle]=1 where metric is that of vbundle. These functions are not prepared for indices other than abstract indices:

DefProductMetric::nonsum="Non-sum vbundle. Structure: `1`.";
DefProductMetric::need="Needed vbundles are: `1`.";
DefProductMetric::nometric="VBundle `1` does not have a metric.";

Options[DefProductMetric]={
PrintAs->Identity,
ProtectNewSymbol:>$ProtectNewSymbols
};
DefProductMetric[_,{},_,___]:=Message[DefProductMetric::empty,2,"pairs"];
DefProductMetric[_[-_,-_],{{_,_}},_,___]:=Message[DefProductMetric::error,"At least two pairs are needed."];
DefProductMetric[metric_,scalars_,covd_,covdsymbol:{_String,_String},options___]:=DefProductMetric[metric,scalars,covd,SymbolOfCovD->covdsymbol,options];
DefProductMetric[metric_[-ind1_,-ind2_],scalars:{{_,_}..},covd_,options:OptionsPattern[]]:=
Catch@With[{
vbundle=VBundleOfIndex[ind1],
christoffel=GiveSymbol[Christoffel,covd],
riemann=GiveSymbol[Riemann,covd],
ricci=GiveSymbol[Ricci,covd],
ricciscalar=GiveSymbol[RicciScalar,covd],
einstein=GiveSymbol[Einstein,covd],
covdsymbol=OptionValue[DefCovD,DeleteCases[{options},rule_[PrintAs,_]],SymbolOfCovD]},
Module[{subvbundles,signdet,invD,prot},

(* Generic checks *)
subvbundles=SplittingsOfVBundle[vbundle];
If [subvbundles==={} ,Throw[Message[DefProductMetric::nonsum,subvbundles]]];
subvbundles=List@@Last[subvbundles];

(* Checks on vbundles and scalars *)
If[Sort[Transpose[scalars][[1]]]=!=Sort[subvbundles],Throw@Message[DefProductMetric::need,subvbundles]];
Map[If[!MetricEndowedQ[#],Throw@Message[DefProductMetric::nometric,#]]&,subvbundles];
Map[If[!ScalarQ[#],Throw@Message[DefProductMetric::unknown,"scalar",#]]&,Transpose[scalars][[2]]];

(* Define metric *)
AppendToUnevaluated[$ProductMetrics,metric];
signdet=Times@@Map[SignDetOfMetric[FirstMetricOfVBundle[#,True]]&,subvbundles];
DefMetric[signdet,metric[-ind1,-ind2],covd,covdsymbol,options,CurvatureRelations->False];

(* Add rules *)
prot=Unprotect[metric];
With[{vb=First[#],scal=Last[#]},TagSet[metric,MetricScalar[metric,vb],scal]]&/@scalars;
Protect[Evaluate[prot]];

(* Construct rules *)
ProductMetricRules[metric,delta]={
delta[a_?AIndexQ,b_?AIndexQ]:>With[{aV=VBundleOfIndex[a],bV=VBundleOfIndex[b]},
Which[
aV===bV,delta[a,b],
aV=!=bV,0
]]};
ProductMetricRules[metric,Metric]={
metric[a_?AIndexQ,b_?AIndexQ]:>With[{aV=VBundleOfIndex[a],bV=VBundleOfIndex[b]},
With[{aVmet=FirstMetricOfVBundle[aV,True]},
Which[
aV===bV && DownIndexQ[a]&&DownIndexQ[b],MetricScalar[metric,aV]^2aVmet[a,b],
aV===bV && UpIndexQ[a]&&UpIndexQ[b],1/MetricScalar[metric,aV]^2aVmet[a,b],
aV===bV,aVmet[a,b],
aV=!=bV,0
]
]]};
ProductMetricRules[metric,Christoffel]={
christoffel[a_,b_,c_]:>With[{aV=VBundleOfIndex[a],bV=VBundleOfIndex[b],cV=VBundleOfIndex[c]},
With[{aVmet=FirstMetricOfVBundle[aV,True],bVmet=FirstMetricOfVBundle[bV,True],cVmet=FirstMetricOfVBundle[cV,True]},
Module[{chra,da,db,dc,sc=Function[MetricScalar[metric,#]]},
chra=Christoffel[CovDOfMetric@aVmet];
da=DummyIn[aV];
db=DummyIn[bV];
dc=DummyIn[cV];
Which[
aV===bV &&bV===cV,metric[a,-da]metric[b,db]metric[c,dc]chra[da,-db,-dc],
aV=!=bV&&bV===cV,-metric[b,c]metric[a,da]CovDOfMetric[aVmet][-da][sc[bV]]/sc[bV],
aV===bV&&aV=!=cV,metric[a,b]metric[c,dc]CovDOfMetric[cVmet][-dc][sc[aV]]/sc[aV],
aV===cV&&aV=!=bV,metric[a,c]metric[b,db]CovDOfMetric[bVmet][-db][sc[aV]]/sc[aV],
aV=!=bV&&bV=!=cV&&aV=!=cV,0
]
]]]/;FreeQ[VBundleOfIndex/@{a,b,c},vbundle]};
ProductMetricRules[metric,CovD]={
covd[a_][expr1_]:>Module[{aV=VBundleOfIndex[a],aVQ,cda,chra,da,dda,dummy=DummyIn[vbundle],inds=List@@FindFreeIndices[expr1]},
aVQ=VBundleIndexQ[aV];
cda=CovDOfMetric[FirstMetricOfVBundle[aV,True]];
chra=Christoffel[cda];
da=DummyIn[aV];
dda=DummyIn[aV];
metric[a,dda](cda[-dda][expr1]+
(TraceProductDummy[
Plus@@Map[christoffel[#,-dda,-dummy]ReplaceIndex[expr1,#->dummy]&,Select[inds,UpIndexQ]]]-Plus@@Map[chra[#,-dda,-da]ReplaceIndex[expr1,#->da]&,Select[inds,aVQ]])-(TraceProductDummy[Plus@@Map[christoffel[dummy,-dda,-#]ReplaceIndex[expr1,-#->-dummy]&,Select[-inds,UpIndexQ]]]-Plus@@Map[chra[da,-dda,-#]ReplaceIndex[expr1,-#->-da]&,Select[-inds,aVQ]])
-WeightOf[expr1,AIndex] expr1 (TraceProductDummy[christoffel[dummy,-dda,-dummy]-chra[da,-dda,-da]]))]/;FreeQ[{VBundleOfIndex[a]},vbundle]};
ProductMetricRules[metric,Riemann]={
riemann[a_,b_,c_,d_]:>Module[{aV=VBundleOfIndex[a],bV=VBundleOfIndex[b],cV=VBundleOfIndex[c],dV=VBundleOfIndex[d],da, db,dc,dd,dalpha,dbeta,sc=Function[MetricScalar[metric,#]],cda,cdb,cdc,cdd,riema},
da=DummyIn[aV];
db=DummyIn[bV];
dc=DummyIn[cV];
dd=DummyIn[dV];
dalpha=DummyIn[vbundle];
dbeta=DummyIn[vbundle];
cda=CovDOfMetric@FirstMetricOfVBundle[aV,True];
cdb=CovDOfMetric@FirstMetricOfVBundle[bV,True];
cdc=CovDOfMetric@FirstMetricOfVBundle[cV,True];
cdd=CovDOfMetric@FirstMetricOfVBundle[dV,True];
riema=Riemann[cda];
Which[

(* Riemann[a,b,c,d] *)
aV===bV ===cV ===dV,
metric[a,-da]metric[b,db]metric[c,dc]metric[d,dd]riema[da,-db,-dc,-dd]-(metric[a,c]metric[b,d]-metric[a,d]metric[b,c])$RiemannSign TraceProductDummy[metric[dalpha,dbeta]covd[-dalpha][sc[aV]]covd[-dbeta][sc[aV]]]/sc[aV]^2,

(* Riemann[a,b,C,D] *)
aV===bV&&cV===dV, 0,

(* Riemann[a,B,C,D] *)
bV===cV===dV,
-metric[a,da]cda[-da][sc[bV]]/sc[bV]$RiemannSign(metric[c,dc]cdc[-dc][sc[aV]]metric[b,d]-metric[d,dd]cdd[-dd][sc[aV]]metric[b,c])/sc[aV],
aV===cV===dV,-riemann[b,a,c,d],
aV===bV===dV,riemann[c,d,a,b],
aV===bV===cV,-riemann[d,c,a,b],

(* Riemann[a,B,c,D] *)
aV===cV&&bV===dV,$RiemannSign(
-metric[b,d]metric[a,da]metric[c,dc]cdc[-dc][cda[-da][sc[bV]]]/sc[bV]-metric[a,c]metric[b,db]metric[d,dd]cdb[-db][cdd[-dd][sc[aV]]]/sc[aV]-metric[a,c]metric[b,d]TraceProductDummy[metric[dalpha,dbeta]covd[-dalpha][sc[aV]]covd[-dbeta][sc[bV]]]/sc[aV]/sc[bV]),
aV===dV&&bV===cV,-riemann[a,b,d,c],

(* Riemann[a,B,c,delta] *)
aV===cV&&aV=!=bV&&aV=!=dV&&bV=!=dV,metric[a,c]metric[b,db]metric[d,dd]$RiemannSign(-cdb[-db][cdd[-dd][sc[aV]]]/sc[aV]+cdb[-db][sc[aV]]/sc[aV] cdd[-dd][sc[bV]]/sc[bV]+cdd[-dd][sc[aV]]/sc[aV]cdb[-db][sc[dV]]/sc[dV]-cdd[-dd][sc[aV]]/sc[aV] cdb[-db][sc[aV]]/sc[aV]),
aV===dV&&aV=!=bV&&aV=!=cV&&bV=!=cV,-riemann[a,b,d,c],
bV===cV&&bV=!=aV&&bV=!=dV&&aV=!=dV,-riemann[b,a,c,d],
bV===dV&&bV=!=aV&&bV=!=cV&&aV=!=cV,riemann[b,a,d,c],

(* Other cases *)
True,0]
]/;FreeQ[VBundleOfIndex/@{a,b,c,d},vbundle],

ricci[a_,b_]:>Module[{dummy=DummyIn[vbundle]},$RicciSign TraceProductDummy[riemann[dummy,a,-dummy,b]]],

ricciscalar[]:>Module[{dummy=DummyIn[vbundle]},TraceProductDummy[ricci[dummy,-dummy]]],

einstein[a_,b_]:>ricci[a,b]-ricciscalar[]/2metric[a,b]

};
]
];
DefProductMetric[metric_,{{_,_},{_,_}..},_,_,___]:=Message[DefProductMetric::invalid,metric,"metric"];
DefProductMetric[_[-_,-_],scalars_,_,_,___]:=Message[DefProductMetric::invalid,scalars,"list of pairs"];
SetNumberOfArguments[DefProductMetric,{4,Infinity}];
Attributes[ProductMetricRules]={ReadProtected};
Protect[DefProductMetric];
SetNumberOfArguments[MetricScalar,2];
Protect[MetricScalar];

QUESTION: ExpandProductMetric can only expand expressions with indices on the subvbundles, but not with indices on the product vbundle. It would give just wrong answers!

ProductMetricRules[metric_]:=Union[Flatten[ProductMetricRules[metric,#]&/@{delta,Metric,Christoffel,CovD,Riemann}]];
ExpandProductMetric1[rules_][expr_]:=expr/.rules;
ExpandProductMetric[expr_,metric_Symbol?MetricQ,object___]:=CheckZeroDerivative@FixedPoint[ExpandProductMetric1[ProductMetricRules[metric,object]],expr];
ExpandProductMetric[expr_,list_List]:=Fold[ExpandProductMetric[#1,#2]&,expr,list];
ExpandProductMetric[expr_]:=ExpandProductMetric[expr,$ProductMetrics];
SetNumberOfArguments[ExpandProductMetric,{1,Infinity}];
Protect[ExpandProductMetric];
Attributes[ProductMetricRules]={ReadProtected};

16.7. Examples

BeginExamples[]

DefManifold[Mprod,{M2,S2},{alpha,beta,mu,nu,sigma,lambda,rho,eta},omega]

Catch@DefProductMetric[g4[-mu,-nu],{{TangentM2,w[]},{TangentS2,r[]}},Cd4,{";","Ξ"}]

DefMetric[-1,g[-A,-B],CdM,{"|","▽"}]

DefMetric[1,gamma[-a,-b],CdS,{":","▽"},PrintAs->"γ"]

Catch@DefProductMetric[g4[-mu,-nu],{{TangentM2,w[]},{TangentS2,r[]}},Cd4,{";","▽"}]

UndefMetric[g4]

DefTensor[w[],S2]
DefTensor[r[],M2]

DefProductMetric[g4[-mu,-nu],{{TangentM2,w[]},{TangentS2,r[]}},Cd4,{";","▽"}]

Is this really what we want?

Catch@DefProductMetric[g4[-mu,-nu],{{TangentM2,w[]},{TangentS2,r[]}},Cd4,{";","▽"}]

$Metrics

Examples:

ExpandProductMetric[Outer[delta,{A,a},{-B,-b}]]

ExpandProductMetric[Outer[g4,{-A,-a},{-B,-b}]]

ExpandProductMetric[Outer[g4,{A,a},{B,b}]]

ExpandProductMetric[Outer[ChristoffelCd4,{A,a},{-B,-b},{-C,-c}]]//ScreenDollarIndices

ContractMetric[%,g,AllowUpperDerivatives->True]

ContractMetric[%,gamma,AllowUpperDerivatives->True]

ExpandProductMetric[Outer[RiemannCd4,{-A,-a},{-B,-b},{-C,-c},{D,d}]]/.$RiemannSign->1//ContractMetric//Simplification//ScreenDollarIndices

ExpandProductMetric[Outer[RicciCd4,{-A,-a},{-B,-b}]]/.{$RiemannSign->1,$RicciSign->1}//ContractMetric//RicciToEinstein//ToCanonical//ScreenDollarIndices//ContractMetric//Simplification

ExpandProductMetric[RicciScalarCd4[]]/.{$RiemannSign->1,$RicciSign->1}//ContractMetric//ToCanonical//ReplaceDummies//ScreenDollarIndices//Simplify

$Metrics

?Mprod

UndefMetric[g4]

?Mprod

UndefMetric/@$Metrics;

$Metrics

$Tensors

UndefTensor/@{r,w};

EndExamples[]

16.8. ChangeFreeIndices, EqualExpressionsQ

This function changes the free indices of an expression. Currently we assume, and do not check, that all indices belong to the same manifold. This is the main driver, which separates the work in three steps:

ChangeFreeIndices[0,newfrees_List]:=0;
ChangeFreeIndices[expr_,newfrees_List]:=Module[{frees,dummies,newexpr},
{frees,dummies}=FindFreeAndDummyIndices[expr];
checkChangeFreeIndices[List@@frees,newfrees];
newexpr=arrangedummies[expr,List@@dummies,newfrees];
changeFreeIndices[newexpr,List@@IndexSort[frees],newfrees]
];
SetNumberOfArguments[ChangeFreeIndices,2];
Protect[ChangeFreeIndices];

The first step is a series of checks to ensure that the suggested new dummies are consistent with the expression. There is the important problem of the character of the indices, not solved yet:

metricendQ[{vbundle_,tf_}]:=If[MetricEndowedQ[vbundle],{vbundle,Null},{vbundle,tf}];

checkChangeFreeIndices[{},{}]:=Null;
checkChangeFreeIndices[frees_List,newfrees_List]:=Module[{manichars,newmanichars,ups},
(* Check1: Equal number of free indices *)
If[Length[frees]=!=Length[newfrees],Throw@Message[ChangeFreeIndices::error,"Inconsistent number of free indices."]];
(* Check2: All abstract indices *)
If[Not[AIndexQ[#]],Throw[Message[ChangeFreeIndices::invalid,#,"abstract index"]]]&/@Join[frees,newfrees];
(* Check3: Consistent vbundles and characters of free indices *)
manichars=metricendQ/@(VBundleUpQ/@frees);
newmanichars=metricendQ/@(VBundleUpQ/@newfrees);
If[Sort[manichars]=!=Sort[newmanichars],Throw@Message[ChangeFreeIndices::error,"Inconsistent vbundles or characters of free indices."]];
]

The second step removes any possible collision between dummies of expr and the new free indices:

arrangedummies[expr_,dummies_List,newfrees_List]:=Module[{nodummies,newdummies},
nodummies=Intersection[dummies,UpIndex/@newfrees];
newdummies=DummyAs/@nodummies;
ReplaceIndex[expr,DuplicateRule/@Inner[Rule,nodummies,newdummies,List]]
];

The third step performs the actual replacement of dummies:

changeFreeIndices[expr_,sortedfrees_List,newfrees_List]:=ReplaceIndex[expr,Inner[Rule,sortedfrees,newfrees,List]]

There is a fourth function checking whether the permutation is consistent from the point of view of characters and manifolds:

manicharpermQ[sortedfrees2_,frees1_]:=(metricendQ/@VBundleUpQ/@sortedfrees2)===(metricendQ/@VBundleUpQ/@frees1)

Finally, this is the function which performs the comparison between any two expressions:

EqualExpressionsQ[expr1_,expr2_]:=Module[{frees1,frees2,dummies2,sortedfrees2,perms1,arrexpr2,newexpr2,count,result=False,perm,xxx,equation,solution},
(* Indices of expr1 *)
frees1=List@@FindFreeIndices[expr1];
(* Indices of expr2 *)
{frees2,dummies2}=FindFreeAndDummyIndices[expr2];
sortedfrees2=List@@IndexSort[frees2];
dummies2=List@@dummies2;
checkChangeFreeIndices[frees1,sortedfrees2];
(* All permutations of the free indices of expr1 *)
perms1=Permutations[List@@frees1];
(* Remove collisions between frees1 and dummies2 *)
arrexpr2=arrangedummies[expr2,dummies2,frees1];
DefConstantSymbol[xxx,DefInfo->False];
Do[
newexpr2=changeFreeIndices[arrexpr2,sortedfrees2,perms1[[count]]];
equation=ToCanonical[expr1-xxx newexpr2];
solution=First[xxx/.Solve[equation==0,xxx]];
If[ConstantQ[solution],result=True;perm=Inner[Rule,perms1[[count]],sortedfrees2,List];Break[]],
{count,Length[perms1]}];
If[result,Print["LEFT  == ",Switch[solution,1,"",-1,"-",_,solution]," RIGHT   with rules: ",perm]];
result
];
SetNumberOfArguments[EqualExpressionsQ,2];
Protect[EqualExpressionsQ];

BeginExamples[]

DefTensor[T[A,B],M2]

DefTensor[v[A],M2]

Catch@ChangeFreeIndices[T[B,A],{C,D,F}]

Catch@ChangeFreeIndices[T[B,A],{-C,-D}]

Catch@ChangeFreeIndices[T[B,A],{-C,{D,Polar}}]

Catch@ChangeFreeIndices[T[B,A],{a,b}]

Catch@ChangeFreeIndices[T[B,-A],{C,-D}]

ChangeFreeIndices[T[B,A],{C,D}]

ChangeFreeIndices[T[A,B]v[-B],{C}]

ChangeFreeIndices[T[A,B]v[-B],{B}]//ScreenDollarIndices

ChangeFreeIndices[T[A,B,C,D]v[-B]v[-D],{B,D}]//ScreenDollarIndices

EqualExpressionsQ[T[A,B]v[-B],T[C,D]v[-D]]

EqualExpressionsQ[T[A,B,C,D]v[-C]v[-D],T[B,D,A,C]v[-A]v[-C]]

EqualExpressionsQ[T[A,B,C,D]v[-C]v[-D],T[B,D,A,C]v[-A]v[-D]]

UndefTensor/@{T,v};

EndExamples[]

16.9. Listable functions and equations

A little flexibility using the fact that Equal is essentially a specialized 2-arg form of List:

ListableQ[f:(_Symbol|_String)]:=MemberQ[Attributes[f],Listable];
ListableQ[_]:=False;
Unprotect[Equal];
Equal/:Plus[Equal[a_,b_],Equal[c_,d_]]:=Equal[Plus[a,c],Plus[b,d]];
Equal/:Times[Equal[a_,b_],Equal[c_,d_]]:=Equal[Times[a,c],Times[b,d]];
Equal/:Power[Equal[a_,b_],Equal[c_,d_]]:=Equal[Power[a,c],Power[b,d]];
Equal/:f_?ListableQ[l___,eq_Equal,r___]:=f[l,#,r]&/@eq;
Protect[Equal];

Examples:

BeginExamples[]

(a==b)+c

(a==b)c

(a==b)^2

(a==b)(c==d)

(a==b)+(c==d)

(a==b)^(c==d)

EndExamples[]

17. Control of evaluation (ExpressionManipulation)

(**************************** 17.Evaluation ***************************)

{TimeUsed[],SessionTime[],TimeUsed[]/SessionTime[]}

17.0. Comments

If[$ReadingVerbose,Print["Reading section 17: ExpressionManipulation."],Null,Null]

<<xAct`ExpressionManipulation`

17.1. (Color) Positions of an expression

Two new functions defined in terms of ColorPositions:

?ColorPositionsOfPattern

?ColorTerms

ColorPositionsOfPattern[pattern_,options___][expr_]:=xAct`ExpressionManipulation`ColorPositions[{Position[expr,pattern]},options][expr];
ColorTerms[expr_]:=xAct`ExpressionManipulation`ColorPositions[Partition[Range@Length@expr,1]][expr];
SetNumberOfArguments[ColorTerms,1];
Protect[ColorTerms,ColorPositionsOfPattern];

Examples:

BeginExamples[]

DefTensor[V[A],M2]
DefTensor[S[A,B],M2,Symmetric[{1,2}]]

expr=4S[A,B]V[-A]V[-B]+2V[A]V[-A]-7S[A,B]S[-A,-B]

We define a set of positions (a position is given by a list of indices):

positions={{1,2},{3,3},{3}};

And we check that they are actually pointing to the objects that we have chosen:

expr//ColorPositions[positions,EMPositionTag->None]

expr//ColorPositions[positions]

expr//ColorPositions[positions,EMPositionTag->EMIndex]

We can map any function on these positions:

MapAt[f,expr,positions]

We can group different positions:

positions={{{1,2},{1,3},{3,2}},{{2,2},{2,3},{3,3},{3,4}}};

expr//ColorPositions[positions,EMPositionTag->None]

Remove[positions];

expr//ColorPositionsOfPattern[S[_,_]]

expr//ColorPositionsOfPattern[S[_?UpIndexQ,_?UpIndexQ]]

expr//ColorPositionsOfPattern[V[_]]

expr//ColorTerms

Simplification[expr]

%//ColorTerms

Note that the third position in an expression can be indicated both as 3 and {3}, even though we always get {3} from Position. I think Position should have been called Positions because it returns a list of positions.

MapAt[f,h[1,2,3,4,5],3]

MapAt[f,h[1,2,3,4,5],{3}]

Position[h[1,2,3,4,5],3]

It is also possible to use EvaluateAt (from the ExpressionManipulation package) instead of MapAt, with equivalent results except for held expressions where EvaluateAt not only maps a function (Identity by default), but also evaluates the subexpression. Note the very different syntaxes used:

MapAt[f,Hold[1+1],{1}]

EvaluateAt[{1},f][Hold[1+1]]

Finally one comment: Indices cannot be colored. At least a tensor must be included in the expression to color.

It is possible to use ExtendedPosition (from the ExpressionManipulation package). Example:

?eP

ExtendedPosition[f[1+a+b+c],a+c]

f[1+a+b+c]//ColorPositions[%]

UndefTensor/@{S,V};

EndExamples[]

18. More examples

{TimeUsed[],SessionTime[],TimeUsed[]/SessionTime[]}

18.1. Dummy handling

BeginExamples[]

For example purposes:

DefTensor[v[-A],M2]

DefTensor[V[-A],M2]

DefTensor[T[A],M2]

DefTensor[r[],M2]

DefMetric[-1,metricg[-A,-B],CdM,{"|","▽"},PrintAs->"g"]

FindAllOfType[2 ((r[])^2) v[-J] v[J]CdM[-A][T[-B]]T[B],Tensor]

ReplaceDummies:

ReplaceDummies[2 ((r[])^2) v[-G] v[G]CdM[-c][T[-b$1]]T[b$1],IndexList[a,A,B,C,d]]

ReplaceDummies[2 ((r[])^2) v[-G] v[G]CdM[-c][CdM[c][T[-b$1]]]T[b$1],IndexList[a,A,B,C,d]]

ReplaceDummies[T[-b$1,C]v[b$1,-C],IndexList[A$1610,a$1614]]

DummyHandling:

Simplification[a v[-A]T[A]-b v[B]T[-B]]//ScreenDollarIndices

Simplification[a v[-a]T[a]-b v[b]T[-b]]//ScreenDollarIndices

Simplification[T[-A,B,C]T[A,-B,D]T[-D,-C,G]T[-G,a]-T[B,-C,F]T[-F,-A,G1]T[-B,C,A]T[-G1,a]]

Cool! (This was the first simplification ever performed with xTensor).

Note that

Simplification[T[-A]v[A]]//ScreenDollarIndices

Simplification[CdM[-B][T[-A]]v[A]]//ScreenDollarIndices

Simplification[PD[-A][T[-B]]v[A]]//ScreenDollarIndices

Simplification[PD[-B][T[-A]]v[A]]//ScreenDollarIndices

Check of "deltas":

PD[-A][metricg[B,-C]]

PD[-A][metricg[-B,-C]]

CdM[-A][metricg[-B,-C]]

UndefMetric[metricg]

UndefTensor/@{v,V,T,r};

EndExamples[]

18.2. calc

BeginExamples[]

Simple calculations:

$Manifolds

DefMetric[-1,metricg[-A,-B],CDM,{"|","▽"},PrintAs->"g"]

DefMetric[1,gamma[-a,-b],CDS,{":","▽"},PrintAs->"γ"]

DefTensor[r[],M2]
DefTensor[w[],S2]

DefProductMetric[g4[-mu,-nu],{{TangentM2,w[]},{TangentS2,r[]}},CD4,{";","▽"}]

DefTensor[V[A],M2]

DefTensor[v[A],M2]

DefTensor[T[-A,-B],M2,Symmetric[{1,2}]]

DefTensor[BB[-A,-B],M2,Antisymmetric[{1,2}]]

DefTensor[TT[-A,-B],M2]

DefTensor[S[-A,-b],{M2,S2}]

DefTensor[GG[-A,b],{M2,S2}]

DefTensor[HH[-A,-B,-C],M2]

DefTensor[AA[-A,-B,-C],M2,Antisymmetric[{1,2,3}]]

We have an invalid input:

Validate[HH[-A,B,C]HH[A,-B,D]HH[-D,-C,mu]V[-mu,a]-HH[B,-C,F]HH[-F,-A,nu]HH[-B,C,A]V[-nu,a]]

even though it is possible to calculated with it:

xATP`calc[HH[-A,B,C]HH[A,-B,D]HH[-D,-C,mu]V[-mu,a]-HH[B,-C,F]HH[-F,-A,nu]HH[-B,C,A]V[-nu,a]]

xATP`calc[TT[-B,-A]V[A]v[B]-TT[-C,-D]v[C]V[D]]

xATP`calc[T[-B,-A]v[A]V[B]-T[-C,-D]v[C]V[D],Verbose->True]

xATP`calc[T[B,A]v[-A]V[-B]-T[C,D]v[-D]V[-C]]

xATP`calc[T[B,A]v[-A]V[-B]-T[C,D]v[-C]V[-D]]

xATP`calc[metricg[B,A]v[-A]V[-B]+metricg[C,D]v[-C]V[-D],xATP`UseMetric->False]

xATP`calc[metricg[B,A]v[-A]V[-B]+metricg[C,D]v[-C]V[-D]]

xATP`calc[TT[B,A]v[-A]V[-B]]

xATP`calc[T[-A,-B]BB[A,B]]

xATP`calc[AA[A,B,C]v[-B]]

xATP`calc[AA[A,B,C]v[-C]]

xATP`calc[AA[A,B,C]v[-B]v[-C]]

xATP`calc[AA[A,B,C]V[-B]v[-C]]

xATP`calc[% v[-A]]

ToCanonical[BB[-B,-A]]

ToCanonical[BB[A,-C]BB[C,-B]]

ToCanonical[BB[A,-C]BB[-B,C]]

ToCanonical[BB[-B,-C]BB[C,A]]

xATP`calc[-m BB[A,B]BB[-B,C]+n BB[C,B]BB[-B,A]]

xATP`calc[m BB[B,A]BB[-B,C]BB[-C,D]-n BB[C,B]BB[-B,A]BB[D,-C]]

xATP`calc[BB[A,B]BB[-B,-C]BB[C,D]+BB[D,B]BB[-B,-C]BB[C,A]]

xATP`calc[BB[A,B]BB[-B,-C]BB[C,D]T[-A,-D]]

xATP`calc[m BB[B,A]BB[-B,C]BB[-C,D]BB[-D,F]+n BB[C,B]BB[-B,A]BB[-D,-C]BB[F,D]]

xATP`calc[m BB[A,B]BB[-B,C]BB[-C,D]BB[-D,F]-n BB[F,B] BB[-B,C]BB[-C,D]BB[-D,A]]

xATP`calc[BB[A,-A]]

xATP`calc[BB[-A,A]]

xATP`calc[BB[A,B]BB[-B,C]BB[-C,-A]]

xATP`calc[BB[A,B]BB[-B,C]BB[-C,D]BB[-D,F]BB[-F,-A]]

If[$xpermQ,xATP`calc[BB[A,B]BB[-B,C]BB[-C,D]BB[-D,F]BB[-F,-G]BB[G,G1]BB[-G1,-A],MathLink->True]]

SortCovDs[PD[-A][PD[-B][T[C]]],PD]

xATP`calc[ChangeCovD[CDM[-D][CDM[-A][T[-C,-B]]],CDM],xATP`UseMetric->False]

There are some problems here, involving derivatives... Note that we cannot rise and lower indices freely in a Pd derivative.

xATP`calc[CDM[-C][CDM[-D][v[-A]]]]

xATP`calc[CDM[-C][CDM[-D][v[A]]],xATP`UseRiemann->True]

xATP`calc[CDM[-B][CDM[-C][CDM[-D][v[-A]]]],xATP`UseRiemann->True]

xATP`calc[ChangeCovD[CDM[-A][CDM[-C][V[-B]]],CDM],xATP`UseMetric->False]

xATP`calc[T[mu,-nu]T[-mu,nu]]

xATP`calc[T[mu,-nu]T[-mu,nu],xATP`ExpandProductManifolds->False,xATP`UseMetric->False]

LieD[v[A]][PD[-D][T[B,-C]]]

xATP`calc[LieD[v[A],PD][PD[-D][T[B,-C]]]]

xATP`calc[LieD[v[A],CDM][CDM[-D][T[B,-C]]]]

VarD[ HH[-A] ][r[]^2HH[-C]+HH[-C]HH[-D] ]/.np

VarD[ HH[-A] ][r[]^2Pd[-F][Pd[-D][HH[-C]]]+HH[-C]HH[-D] ]/.np

calc[VarD[ v[-A] ][r[]^2v[-C]+v[-C]v[-D] v[D]]]

calc[VarD[ v[-A] ][r[]^2Pd[-D][v[-C]]+v[-C]v[-D] ]]

Product manifolds

xATP`calc[RiemannCD4[A,-B,-C,-D]]/.{$RiemannSign->1,$RicciSign->1}

xATP`calc[RiemannCD4[a,-B,-C,-D]]/.{$RiemannSign->1,$RicciSign->1}

xATP`calc[RiemannCD4[A,-b,-C,-d]]/.{$RiemannSign->1,$RicciSign->1}

xATP`calc[RicciCD4[-A,-B]]/.{$RiemannSign->1,$RicciSign->1}

xATP`calc[RicciCD4[-A,-b]]/.{$RiemannSign->1,$RicciSign->1}

xATP`calc[RicciCD4[-b,-A]]/.{$RiemannSign->1,$RicciSign->1}

xATP`calc[RicciCD4[-a,-b]]/.{$RiemannSign->1,$RicciSign->1}

xATP`calc[RicciScalarCD4[]]/.{$RiemannSign->1,$RicciSign->1}

xATP`calc[CD4[-A][TT[-B,-b]]]

VisitorsOf[M2]

$Metrics

UndefMetric/@%;

$Tensors

UndefTensor/@%;

Undefining manifolds takes some time because we search for all associated dollar-dummies:

UndefManifold[Mprod]

UndefManifold/@{M2,S2};

Remove[m,n];

EndExamples[]

18.3. EndPackage

Switch on messages about new symbols:

(* On[General::newsym] *)

$Context

End[]

$Context

EndPackage[]

$Context

{TimeUsed[],SessionTime[],TimeUsed[]/SessionTime[]}

{MaxMemoryUsed[],MemoryInUse[]}/1000/1024.

Private names that do not contain the dollar sign and have not been registered with usage messages in section 1:

Complement[StringReplace[#,"xAct`xTensor`Private`"->""]&/@Select[Names["xAct`xTensor`Private`*"],!StringMatchQ[#,"*$*"]&],xAct`xTensor`Private`$xTensorPrivateNames]

Length[%]

Symbols registered in the Global` context:

Names["Global`*"]

Length[%]

Select[%%,!StringMatchQ[#,"*$*"]&]

Length[%]