xCore

Mathematica tools for the xAct framework

José M. Martín-García
jose@xact.es

(c) 2007-2020, under GPL

http://www.xact.es/

http://groups.google.com/group/xAct

0. Info and copyright

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

IntegerPart/@Date[]

xAct`xCore`$Version={"0.6.10",{2018,2,28}}

$SessionID

0.1. GPL

(* xCore, basic functional additions to Mathematica *)

(* Copyright (C) 2007-2020 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: xCore *)

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

(* :Summary: Programming tools for xAct *)

(* :Brief Discussion:
*)
  
(* :Context: xAct`xCore` *)

(* :Package Version: 0.6.9 *)

(* :Copyright: Jose M. Martin-Garcia 2007-2020 *)

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

(* :Keywords: *)

(* :Source: xCore.nb *)

(* :Warning: Still experimental! *)

(* :Mathematica Version: 6.0 and later *)

(* :Limitations: unlimited limitations *)

0.3. TODO list

- SetNumberOfArguments does not remove previous definitions. This is wrong when the second use of SetNumberOfArguments is less restrictive than its first use.
- TildeString and Underline do not detect blanks.

1. Begin package

(************************ 1. Begin package ***********************)

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

1.1. BeginPackage

Protect against multiple loading of the package:

With[{xAct`xCore`Private`xCoreSymbols=DeleteCases[Join[Names["xAct`xCore`*"],Names["xAct`xCore`Private`*"]],"$Version"|"xAct`xCore`$Version"|"xAct`xCore`Private`$LastPackage"]},
Unprotect/@xAct`xCore`Private`xCoreSymbols;
Clear/@xAct`xCore`Private`xCoreSymbols;
]

The first action is detecting the directory in which xAct has been placed. See notebook Directories.nb for further help on the structure of relevant directories in Mathematica.

If[System`$VersionNumber<6.5,
(* Old definitions *)
xAct`xCore`$xActDirectory=First@FileNames["xAct",{$UserBaseDirectory,$BaseDirectory,$InstallationDirectory},Infinity];
xAct`xCore`$xActDocDirectory=StringJoin[xAct`xCore`$xActDirectory,"/Documentation/English"],
(* FindFile will find the package in the same place that Get found it. Thanks Teake! *)
xAct`xCore`$xActDirectory=DirectoryName[FindFile["xAct`xPerm`"],3];
xAct`xCore`$xActDocDirectory=StringJoin[xAct`xCore`$xActDirectory,"Documentation/English"]
];

xAct`xCore`$xActDirectory

xAct`xCore`$xActDocDirectory

Now we need to know which package is actually calling xCore. This will be included in the variable $xAct`xCore`Private`$LastPackage:

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

xAct`xCore`Private`$LastPackage

We use the external package ExpressionManipulation, developed by David J. M. Park and Ted Ersek. It is a great package! I don't have any idea about its version number. Deactivated in version 0.6.2. This is to avoid treating it as a xAct package; now the user needs to load it explicitly, as with ShowTime1.

BeginPackage["xAct`xCore`",{"xAct`ExpressionManipulation"}]

BeginPackage["xAct`xCore`"]

Message:

xAct`xCore`Private`$barslength=60;
xAct`xCore`Private`bars=StringJoin[Table["-",{xAct`xCore`Private`$barslength}]];

Print[xAct`xCore`Private`bars]
Print["Package ExpressionManipulation`"]
Print["CopyRight (C) 1999-2018, David J. M. Park and Ted Ersek"]

If xCore is the last package being read, print the GPL message and unset $LastPackage (this is because if more xAct packages are loaded later then the GPL message must be printed again):

If[xAct`xCore`Private`$LastPackage==="xAct`xCore`",
Unset[xAct`xCore`Private`$LastPackage];
Print[xAct`xCore`Private`bars];
Print["Package xAct`xCore`  version ",xAct`xCore`$Version[[1]],", ",xAct`xCore`$Version[[2]]];
Print["CopyRight (C) 2007-2020, Jose M. Martin-Garcia, under the General Public License."];
Print[xAct`xCore`Private`bars];
Print["This package comes 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 specify the context xAct`xCore` to avoid overriding the Disclaimer of the other xAct packages. However we need to turn off the message General:shdw temporarily:

Off[General::shdw]
xAct`xCore`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]

Eliminate annoying spell messages (included in the package, though it is not really needed since version 6):

Off[General::spell]
Off[General::spell1]

$ContextPath

1.2. Usage messages

(* Directories *)
$xActDirectory::usage="$xActDirectory is a global variable containing the directory where the xAct directory has been placed. The two recommended options are $UserBaseDirectory/Applications/xAct for a user-based installation or $BaseDirectory/Applications/xAct for a system-wide installation. The third possible place is $InstallationDirectory/AddOns/Applications/xAct, also for a system-wide installation.";
$xActDocDirectory::usage="$xActDocDirectory is a global variable containing the directory with the Documentation of xAct. It is the subdirectory Documentation/English of $xActDirectory.";

(* Warnings *)
$WarningFrom::usage="$WarningFrom is a global variable which is set to different values in different parts of the code. It is used to get an idea of where the warning messages are coming from.";

(* Replacements. Not in the package *)
ReplaceLast::usage="ReplaceLast[expr, rules] maps ReplaceAll with the given rules onto the last element of expr.";

(* Folded rules *)
FoldedRule::usage="FoldedRule[rules1, rules2, ...] contains a number of lists of rules which are applied sequentially (first rules1, then rules2, etc.) when called by ReplaceAll and ReplaceRepeated.";
CollapseFoldedRule::usage="CollapseFoldedRule[frule, {n, m}] converts the elements n to m of the foldedrule frule into a single list of replacements in terms of the independent objects at level m. The positional argument follows the notation of Take: both n, m or just m can be negative, counting from the end; a single positive integer m represents {1, m}; a single negative integer -n represents {-n, -1}. A third argument can be given specifying a function to be mapped on all rules after collapsing a new level. CollapseFoldedRule[frule] or CollapseFoldedRule[frule, All] are interpreted as collapse of all elements of frule.";

(* Dependent and independent rules *)
IndependentRules::usage="IndependentRules[rules] returns a list with the subset of rules of the form x->x. On a FoldedRule expression it returns a list with the last rules.";
DependentRules::usage="DependentRules[rules] return a list with the subset of rules not of the form x->x. On a FoldedRule expression ir returns the first list of rules.";

(* AppendToUnevaluated *)
AppendToUnevaluated::usage="AppendToUnevaluated[symbol, value] works like AppendTo[symbol, value] but none of the elements of the expression associated to symbol is evaluated.";

(* Number of arguments *)
xAct`xCore`Private`setargs::usage="xAct`xCore`Private`setargs[head, found, expected] sets a definition for head[args] such that if the number of arguments found is not compatible with the number of arguments expected then an error message is sent (not thrown). Number found must be an integer or Infinity, whereas expected can be an integer or Infinity or a range indicated by a list of two integers {m, n} or an integer and Infinity {m, Infinity}.";
SetNumberOfArguments::usage="SetNumberOfArguments[function, expected] sets several definitions for head[args] using the (private) function setargs for those cases which are incompatible with the expected number or range of arguments. The format for expected is explained in setargs.";

(* Small functions for lists *)
JustOne::usage="JustOne[{expr}] gives expr, or an error otherwise.";
MapIfPlus::usage="MapIfPlus[f, expr] maps f on the elements of expr if expr has head Plus, or returns f[expr] otherwise.";
If[System`$VersionNumber<6.5,DeleteDuplicates::usage="DeleteDuplicates[list] gives the union of the elements of list, keeping the original order. The elements of list are evaluated before the union is taken. The expression list may have head other than List."
];
If[System`$VersionNumber<9.0,
DuplicateFreeQ::usage="DuplicateFreeQ[list] returns True if there are no identical elements in the list, and False otherwise."
];

(* Combination of names *)
SymbolJoin::usage="SymbolJoin[s1, s2, ...] generates a new symbol joining together the symbols, numbers or strings si, after evaluating them.";

(* Convert named patterns into their names *)
NoPattern::usage="NoPattern[expr] converts the named patterns in expr into their names.";

(* String modification *)
Underline::usage="Underline[x] returns a string with x underlined. The string form of x must not contain blanks. Underline[x, color] prints colored underlines (but x is not colored).";
Overline::usage="Overline[x] returns a string with x overlined. The string form of x must not contain blanks. overline[x, color] prints colored overlines (but x is not colored).";
TildeString::usage="TildeString[x, n] returns a string with n tildes over x if n>0 and n tildes below x if n<0. When n is not an integer, n is replaced by 1. TildeString[x, n, color] prints colored tildes (but x is not colored).";
ColorString::usage="ColorString[atom, color] returns a string with atom printed in color.";
HatString::usage="HatString[x, n] returns a string with n hats over x if n>0 and n hats below x if n<0. When n is not an integer, n is replaced by 1. HatString[x, n, color] prints colored hats (but x is not colored).";

(* Options *)
CheckOptions::usage="CheckOptions[options] checks that options have the right rule structure and that the tensor rank of {options} is either 1 or 2. If True, it returns Flatten[{options}, 1]. If False, it throws an error.";
TrueOrFalse::usage="TrueOrFalse[True] and TrueOrFalse[False] give True. Any other argument gives False.";

(* Array manipulation *)
ThreadArray::usage="ThreadArray[head[array1, array2]] threads head over pairs of elements of the two arrays.";

(* xUpvalues *)
xUpSet::usage="xUpSet[f[x], rhs] sets an upvalue for x using UpSet[f[x], rhs] but first unprotects x and finally protects it if it was initially protected.";
xUpSetDelayed::usage="xUpSetDelayed[f[x], rhs] sets a delayed upvalue for x using UpSetDelayed[f[x], rhs] but first unprotects x and finally protects it if it was initially protected.";
xUpAppendTo::usage="xUpAppendTo[f[x], e] assumes that f[x] is a list of elements associated to x as an upvalue and appends the element e to it, resetting the association. If f[x] does not have a value, it is initialized in the first place to {}.";
xUpDeleteCasesTo::usage="xUpDeleteCasesTo[f[x], cases] assumes that f[x] is a list of elements associated to x as an upvalue and removes cases from the list, resetting the association.";
xTagSet::usage="xTagSet[{f, lhs}, rhs] assigns rhs to be the value of lhs, and associates the assignment with the symbol f. There are two differences with TagSet: 1) The symbol f is unprotected and later protected again if required; 2) xTagSet evaluates rhs (consistently with all other Set functions), but TagSet does not evaluate it!";
xTagSetDelayed::usage="xTagSetDelayed[{f, lhs}, rhs] assigns rhs to be the delayed value of lhs, and associates the assignment with the symbol f. The only difference with TagSetDelayed is that the symbol f is unprotected and later protected again if required.";
SubHead::usage="SubHead[expr] returns the atom obtained after nesting Head as many times as needed.";

(* MapRule *)
MapRuleR::usage="MapRuleR[f, expr] maps f onto the second argument of all Rule or RuleDelayed expressions of expr.";
MapRuleL::usage="MapRuleL[f, expr] maps f onto the first argument of all Rule or RuleDelayed expressions of expr.";

(* Linking symbols *)
$LinkCharacter::usage="$LinkCharacter is a global variable containing a single character to be used in linking symbols to define a new symbol. By default we use the symbol \"⎵\" (under-bracket), imitating the package Notations.";
LinkSymbols::usage="LinkSymbols[{s1, s2, ...}] returns a single symbol formed by joining the symbols s1, s2, ... inserting the charcter $LinkCharacter in between any two of them.";
UnlinkSymbol::usage="UnlinkSymbol[symbol] returns a list of symbols obtained by breaking the given symbol at those points having the character $LinkCharacter.";

(* Evaluation functions *)
xEvaluateAt::usage="xEvaluateAt[expr, pos] forces evaluation of expr at the position indicated by pos. xEvaluateAt[expr, {pos1, pos2, ...}] forces evaluation at several positions.";
xAct`xCore`Private`HoldMap::usage="xAct`xCore`Private`HoldMap[f, expr] maps and evaluates f on the elements of expr without evaluating the whole expression, which is returned wrapped in xHold. xAct`xCore`Private`HoldMap[f, expr, g] returns the expression wrapped with the function g.";
xHold::usage="xHold reproduces the behaviour of HoldForm, but with much lower precedence. It is introduced to avoid conflicts with the use of HoldForm by the user.";

(* DefType command xtension *)
xTension::usage="xTension[package, defcommand, moment]:=func declares func[args] to be executed at some moment during the execution of a defcommand (DefType[args] or UndefType[args]) in the xAct packages. This allows extensions of commands like DefMetric without actually modifying the code of xTensor. defcommand must be a symbol, like DefMetric or UndefMetric. package must be a string with the name of the package making the extension, and this is used to separate the extensions of different packages. Currently moment must be either \"Beginning\" or \"End\", representing whether the code is executed at the beginning or the end of the defcommand. The code is provided as a function func taking the same arguments args as defcommand[args].";
MakexTensions::usage="MakexTensions[defcommand, moment, symbol] collects the xTension expressions defined for defcommand at the given moment (\"Beginning\" or \"End\") and applies them to the symbol being defined.";

(* Change configuration variables *)
ReportSet::usage="ReportSet[var, val] sets assigns the value val to the variable var, reporting it if the variable had before a different value.";
ReportSetOption::usage="ReportSetOption[s, opt->val] sets the value val for the option opt of the symbol s, reporting it if the option had before a different value.";

(* Functions for previous versions of Mathematica *)
If[$VersionNumber<4.1,Ordering::usage="Ordering[{e1, e2, ...}] gives the permutation-list that brings the ei to the canonical order defined by OrderedQ."];

(* Tests *)
xTest::usage="xTest[s, expr, res, messQ] executes the expression expr and compares the result with the expected expression res, using SameQ. The argument messQ says whether we expect messages will be produced during the execution of expr. The checks yield a True/False answer that is stored as TestResult[s, c] where c is an integer that increases for each test performed for the symbol s.";
TestCounter::usage="TestCounter[s] stores the number of tests performed so far for the symbol s.";
TestResult::usage="TestResult[s, c] stores a True/False value reporting whether the test number c for the symbol s was successfull or not.";
AllTests::usage="AllTests[] return the list of all True/False values stored in TesteResult. AllTests[s] returns only those values associated to the tests for the symbol s.";
CheckTests::usage="CheckTests[] report whether all tests performed passed or failed. CheckTests[s] reports only on the tests for the symbol s.";

(* Types of names *)
$EMNames::usage="$EMNames gives the list of all names of symbols defined by the package ExpressionManipulation.";
$xPermNames::usage="$xPermNames gives the list of all names of symbols defined by the package xPerm.";
$xTensorNames::usage="$xTensorNames gives the list of names of all symbols defined by the package xTensor.";
$xCoreNames::usage="";
$xTableauNames::usage="";
$xCobaNames::usage="";
$InvarNames::usage="";
$xPertNames::usage="";
$HarmonicsNames::usage="";
$SpinorsNames::usage="";
$xActNames::usage="";
$SystemNames::usage="$SystemNames gives the list of names of all built-in symbols in Mathematica.";
$SpecialOutputNames::usage="$SpecialOutputNames gives the list of names of Mathematica symbols in $SystemNames whose output differs from them.";
FindSymbols::usage="FindSymbols[expr] gives the list of all symbols in expr, without evaluating expr. FindSymbols[expr, f] gives the list of all symbols in expr, each wrapped with the function f; if the function f has a Hold attribute then none of the symbols of expr is evaluated in the process.";
ValidateSymbol::usage="ValidateSymbol[symbol] throws an error if symbol: 1) has a value or numeric character, or is not atomic, 2) its name is locked, protected or readprotected, or 3) it is already used by Mathematica or any of the xAct packages already loaded. Otherwise it gives Null. (Read)Protection is not checked for the capitals C, D, K, N, O, used by Mathematica. Symbols E and I have numeric value.";

(* Other. Private in the package *)
LockedQ::usage="LockedQ[symbol] gives True if symbol has attribute Locked and False otherwise.";
ProtectedQ::usage="ProtectedQ[symbol] gives True if symbol has attribute Protected and False otherwise.";
ReadProtectedQ::usage="ReadProtectedQ[symbol] gives True if symbol has attribute ReadProtected and False otherwise.";
HeldQ::usage="HeldQ[symbol] gives True if symbol has an attribute of Hold-type: HoldAllComplete, HoldAll, HoldFirst, HoldRest, NHoldAll, NHoldFirst, NHoldRest, SequenceHold";
$LockedNames::usage="$LockedNames gives the list of all Mathematica names in $SystemNames with attribute Locked. They cannot be used as names for objects in xAct.";
$ProtectedNames::usage="$ProtectedNames gives the list of names of all Mathematica symbols in $SystemNames with attribute Protected. They can be used as names for objects in xAct if protection is removed by the user, but we advise against this use.";
$ReadProtectedNames::usage="$ReadProtectedNames gives the list of names of all Mathematica symbols in $SystemNames with attribute ReadProtected. They can be used as names for objects in xAct if readprotection is removed by the user, but we advise against this use.";
$HeldNames::usage="$HeldNames gives the list of names in $SystemNames with an attribute of Hold-type: HoldAllComplete, HoldAll, HoldFirst, HoldRest, NHoldAll, NHoldFirst, NHoldRest, SequenceHold";
$LengthOneNames::usage="$LengthOneNames gives the names of one-character Mathematica symbols: "<>ToString@$LengthOneNames<>". They are accepted as indices (except E and I), but not as names of other objects.";

(* Dagger character *)
$DaggerCharacter::usage="$DaggerCharacter gives the character string to be appended to a daggered symbol. By default it is the dagger symbol †.";
HasDaggerCharacterQ::usage="HasDaggerCharacterQ on symbol or -symbol returns True if symbol contains $DaggerCharacter as one of its characters, and False otherwise. On any other type of expression it throws an error.";
MakeDaggerSymbol::usage="MakeDaggerSymbol[symbol] returns a symbol with an added $DaggerCharacter if it does not already have it as last chracter, or it removes the $DaggerCharacter if symbol already has it. If the symbol contains a dollar, then the character is placed just before the first dollar. On nonsymbol expressions this function throws an error.";

1.3. Begin Private

$ContextPath

$Context

Begin Private context:

Begin["`Private`"]

$Context

$ContextPath

The Private` context is not added to the $ContextPath. However we can find symbols there. This is confusing... 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`xCore`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`xCore`Private`"];Null)&@Complement[Names["Global`*"],Global`symbols]

The only problem is that writing xAct`xCore`Private is rather long. We define (not in the package):

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

Names["xAct`xCore`*"]

Length[%]

2. Functions

(******************* 2. Functions *******************)

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

2.0. New functions

2.0.1. Ordering (from 4.1)

This function is included in Mathematica 4.1 and later, but in previous versions it must be defined explicitly:

?Ordering

If[System`$VersionNumber<4.1,Ordering[list_List]:=Last/@Sort[Transpose[{list,Range@Length@list}]]];

Note that we have  given only the main definition of Ordering.

2.4.3. DeleteDuplicates (from 7.0)

This function is used in some places related to the index manipulation:

??DeleteDuplicates

This has been copied from Mathematica (it was called UnsortedUnion). I have just added the Verbatim. The philosophy behind this construction is really clever! (note however that this is not the definition going into the package)

If[System`$VersionNumber<7.,
DeleteDuplicates[list_]:=Module[{f,x},f[x_]:=(f[Verbatim[x]]=Sequence[];x);f/@list]
];

In versions 7 and 8 there is DeleteDuplicates in Mathematica, but as pointed out by Teake it only works on expressions with head List. In version 9 it works with any head, and we imitate that here:

If[6.5<System`$VersionNumber<8.5,
Unprotect[DeleteDuplicates];
DeleteDuplicates[head_[elems___]/;head=!=List]:=head@@DeleteDuplicates[{elems}];
Protect[DeleteDuplicates];
];

Examples:

BeginExamples[]

Union[{b,a,a,b}]

DeleteDuplicates[{b,a,a,b}]

Elements are evaluated before the union is done:

a=b;

Union[{b,a,a,b}]

DeleteDuplicates[{b,a,a,b}]

a=.

Without the Verbatim, the function f would get confused with patterns. Slots are automatically numbered (even with a HoldComplete wrapper):

DeleteDuplicates[{b,a_,a,a__,a___,b,#,#1,#,#2,##}]

HoldComplete[#]

An issue with the pre7 definition

There is an annoying problem, already reported to Wolfram Support in version 5.1, but not corrected in 5.2 or 6.0. If we have a list of 99 or less elements the temporary variable f$ behaves properly:

list=Table[Random[Integer,{0,9}],{99}];

DeleteDuplicates[list]

?xACP`f$*

But if we have 100 or more then it refuses to die!

list=Table[Random[Integer,{0,9}],{100}];

DeleteDuplicates[list]

?xACP`f$*

Names["xAct`xCore`Private`f$*"]

Information[Evaluate@Last[%]]

Remove[a,b,list]
EndExamples[]

That problem forces us to use the definition

If[System`$VersionNumber<6.5,DeleteDuplicates[list_]:=Module[{f,x,r},f[x_]:=(f[Verbatim[x]]=Sequence[];x);r=f/@list;Remove[f];r];
SetNumberOfArguments[DeleteDuplicates,1];
Protect[DeleteDuplicates];
]

which explicitly removes the function f after using it.

2.0.2. DuplicateFreeQ (from 9.0)

If[System`$VersionNumber<9.0,DuplicateFreeQ[expr_]:=SameQ[DeleteDuplicates[expr],expr]];

2.1. Errors and messages

We already define here the Validate::warning message. Note that it deals with warnings, and not with errors, which are always output. Note also that this message needs two strings and that it has different colors in diferent versions of Mathematica. The global variable $WarningFrom gives an indication (through Block constructs) of where the warning was generated; the default value General gives no information whatsoever.

?$WarningFrom

Note that StyleBox expects a box-structure as first argument, which can be in particular a string:

$WarningFrom=General;
General::warning=Switch[System`$VersionNumber,
_?(#≥5.&),"\!\(\*StyleBox[`1`,FontColor->RGBColor[0,0,1]]\)",
_?(#<5.&),"\!\(\*StyleBox[`1`,FontColor->RGBColor[1,0,0]]\)"]<>" : From `2`."

Message[General::warning,"Example: "<>ToString[a],$WarningFrom]

Remove[a]

By default it is off, but here we keep it in order to check its behaviour:

Off[General::warning]

On[General::warning]

We can also give information on any new symbol created. This is not equivalent to On[General::newsym] due to the treatment of contexts. In particular the latter does not report creation of Private symbols, and that is the main reason why we want to use $NewSymbol. Deactivated because there are commands generating long lists of internal symbols.

$NewSymbol=Print["New symbol created: ", #1, ", Context: ",#2]&

These are very common messages that we associate to General:

(* General messages *)
General::versions="Loaded `1` version `2` but expected version `3` at least.";
General::unknown="Unknown `1` `2`.";
General::invalid="`1` is not a valid `2`.";
General::noundef="`1` `2` cannot be undefined because `3`.";
General::nouse="Attempting to apply `1` on `2`.";
General::empty="Argument number `1` cannot be an empty list of `2`.";
General::notyet="Sorry. Cannot work with `1` yet.";
General::missing="There is no `1` in `2`.";
General::undef="Undefined `1` of `2`.";
General::error="`1`";
General::error1="`1` `2`";
General::error2="`1` `2` `3`";
General::error3="`1` `2` `3` `4`";

Some packages modify global configuration variables. When that happens there is the following warning message:

General::nostdvar="Nonstandard configuration: variable `1` now has value `2`.";
General::nostdopt="Nonstandard configuration: option `1` of `2` now has value `3`.";

A message for self-checks:

$ReportToJose="Uhh. This was not expected (though there is nothing wrong). Please, report to jose@xact.es."

2.2. Option values

This function checks that the given options have the expected rule structure and depth (options must be a sequence of rules or a list of rules). We will not check that those options are actually options for a given function because it could happen that they are options for a function that is called internally by the first function. CheckOptions always return a list of rules. The issue of evaluation is not important here if we assume that rules are still rules even after evaluation:

??OptionQ

BeginExamples[]

OptionQ[a->b]

OptionQ[a->b,c->d]

OptionQ[{a->b,c->d}]

OptionQ[{{a->b},{{c->d}}}]

EndExamples[]

?CheckOptions

CheckOptions[]:={};
CheckOptions[opts__]:=If[OptionQ[{opts}]&&MemberQ[{1,2},ArrayDepth[{opts}]],
Flatten[{opts},1],
Throw[Message[CheckOptions::invalid,opts,"option or list of options"]]];
Protect[CheckOptions];

BeginExamples[]

CheckOptions[a->b]

CheckOptions[a->b,c->d]

CheckOptions[{a->b,c->d}]

Catch@CheckOptions[{{a->b},{c->d}}]

Catch@CheckOptions[{{a->b},{{c->d}}}]

Remove[a,b,c,d]

EndExamples[]

TrueOrFalse will be used to check the value of Boolean rules. Just a comment: this function evaluates its argument before checking it:

?TrueOrFalse

TrueOrFalse[True|False]:=True;
TrueOrFalse[_]:=False;
SetNumberOfArguments[TrueOrFalse,1];
Protect[TrueOrFalse];

Trace[TrueOrFalse[True&&False]]

Trace[TrueOrFalse[True||False]]

2.3. SetNumberOfArguments

There are five kinds of argument messages:
	- n arguments are expected (argx, argr, argrx)
	- n or more arguments are expected (argm, argmu)
	- n or fewer arguments are expected (argf)
	- n or m arguments are expected (argt, argtu)
	- between n and m arguments are expected (argb, argbu)

This function imposes one condition. Structure: setargs[function, found, expected]

?setargs

SetAttributes[setargs,HoldFirst];

setargs[f_,n_,n_]:=Null;
setargs[f_,Infinity,1]:=SetDelayed[f[_,x__],Message[f::argx,f,1+Length[{x}]]];
setargs[f_,Infinity,n_]:=SetDelayed[f[##],Message[f::argrx,f,n+Length[{x}],n]]&@@Table[Blank[],{n}]~Join~{Pattern[x,BlankSequence[]]};
setargs[f_,1,n_/;n=!=1]:=SetDelayed[f[_],Message[f::argr,f,n]];
setargs[f_,i_/;i=!=1,1]:=SetDelayed[f[##],Message[f::argx,f,i]]&@@Table[Blank[],{i}];
setargs[f_,i_,n_]:=SetDelayed[f[##],Message[f::argrx,f,i,n]]&@@Table[Blank[],{i}];

setargs[f_,n_,{n_,Infinity}]:=Null;
setargs[f_,Infinity,{n_,Infinity}]:=SetDelayed[f[##],Message[f::argm,f,n+Length[{x}],n]]&@@Table[Blank[],{n}]~Join~{Pattern[x,BlankSequence[]]};
setargs[f_,1,{n_/;n=!=1,Infinity}]:=SetDelayed[f[_],Message[f::argmu,f,n]];
setargs[f_,i_,{n_,Infinity}]:=SetDelayed[f[##],Message[f::argm,f,i,n]]&@@Table[Blank[],{i}];

setargs[f_,Infinity,{0,0}]:=setargs[f,Infinity,0];
setargs[f_,Infinity,{0,n_}]:=SetDelayed[f[##],Message[f::argf,f,n+Length[{x}],n]]&@@Table[Blank[],{n}]~Join~{Pattern[x,BlankSequence[]]};
setargs[f_,0,{1,2}]:=SetDelayed[f[],Message[f::argt,f,0,1,2]];
setargs[f_,Infinity,{1,2}]:=SetDelayed[f[_,_,x__],Message[f::argt,f,2+Length[{x}],1,2]];
setargs[f_,0,{2,3}]:=SetDelayed[f[],Message[f::argt,f,0,2,3]];
setargs[f_,1,{2,3}]:=SetDelayed[f[_],Message[f::argt,f,1,2,3]];
setargs[f_,Infinity,{2,3}]:=SetDelayed[f[_,_,_,x__],Message[f::argt,f,3+Length[{x}],2,3]];

SetNumberOfArguments imposes all conditions:

?SetNumberOfArguments

SetAttributes[SetNumberOfArguments,HoldFirst];

(* Function with exactly n arguments *)
SetNumberOfArguments[f_,n_Integer]:=(
Do[setargs[f,i,n],{i,0,n-1}];
setargs[f,Infinity,n];
);

(* Function with n or more arguments *)
SetNumberOfArguments[f_,{n_Integer?Positive,Infinity}]:=
Do[setargs[f,i,{n,Infinity}],{i,0,n-1}];

(* Function with n or fewer arguments *)
SetNumberOfArguments[f_,{0,n_Integer?Positive}]:=setargs[f,Infinity,{0,n}];

(* Function with 1 or 2 arguments *)
SetNumberOfArguments[f_,{1,2}]:=(
setargs[f,0,{1,2}];
setargs[f,Infinity,{1,2}];
);

(* Function with 2 or 3 arguments *)
SetNumberOfArguments[f_,{2,3}]:=(
setargs[f,0,{2,3}];
setargs[f,1,{2,3}];
setargs[f,Infinity,{2,3}];
);

It is important to note that these functions give messages but do not throw them.

Examples:

BeginExamples[]

SetNumberOfArguments[function,2]

SetNumberOfArguments[function,2]

??function

function[]

function[1]

function[1,2]

function[1,2,3]

We can change the definitions, but this is only really right if the new set of conditions is more restrictive than the previous one. Otherwise, the old definitions are still there. QUESTION: How can we solve this? It seems we have to remove previous definitions, but that seems dangerous.

SetNumberOfArguments[function,{2,3}]

??function

function[]

function[1]

function[1,2]

function[1,2,3,4]

This definition is now wrong:

function[1,2,3]

Remove[function]

EndExamples[]

2.4. Lists

This subsection develops some small but useful functions:

2.4.1. JustOne

This is a stupid, but terribly useful, function that checks that we have a list (head List) with only one element:

?JustOne

JustOne::notone="Expecting a list with one element, but got `1`.";
JustOne[{expr_}]:=expr;
JustOne[]:=Throw@Message[JustOne::notone,"nothing"];
JustOne[expr_]:=Throw@Message[JustOne::notone,expr];
SetNumberOfArguments[JustOne,1];
Protect[JustOne];

2.4.2. MapIfPlus

This is another simple function, used by ToCanonical:

?MapIfPlus

MapIfPlus[f_,expr_Plus]:=Map[f,expr];
MapIfPlus[f_,expr_]:=f[expr];
SetNumberOfArguments[MapIfPlus,2];
Protect[MapIfPlus];

2.4.3. ThreadArray

We construct a simple threading head for expressions with two arrays of the same dimensions (although we do not check that their dimensions are the same). This function is used in xCoba:

?ThreadArray

ThreadArray[head_[arrayL_List,arrayR_List]]:=MapThread[head,{arrayL,arrayR},ArrayDepth[arrayL]];
SetNumberOfArguments[ThreadArray,1];
Protect[ThreadArray];

2.4.4. xThrough

This function is not being used now in xAct:

xThrough[List[args__][expr_]]:=xThrough/@Through[List[args][expr]];
xThrough[expr_]:=expr;

2.5. Evaluation

2.5.1. xEvaluateAt

The package ExpressionManipulation has a function EvaluateAt (there is no such built-in in Mathematica), but it is rather complicated. Here we define two simplified versions. The functions are constructed using the functions ReplacePart and Extract, which themselve do not have holding attributes. Note that both latter functions (and MapAt) have been modified by the original form of ExpressionManipulation, but I have deactivated that creating three functions NewReplacePart, NewExtract and NewMapAt inside that package.

??ReplacePart

??Extract

??MapAt

This first function is used by ScreenDollarIndices and by DisplaceSlots. Note that xEvaluateAt does not have a holding attribute.

?xEvaluateAt

xEvaluateAt[expr_,positions_]:=Fold[ReplacePart[#1,Part[#1,Sequence@@#2],#2]&,Unevaluated[expr],positions];
SetNumberOfArguments[xEvaluateAt,2];
Protect[xEvaluateAt];

xEvaluateAt[{Hold[1+1],Hold[1+1],Hold[1+1]},{{1,1},{2,1},{3,1}}]

The following function assumes that expr does not evaluate by itself (i.e., assumes that expr has a holding wrapper). It is used in HoldMap. The mapped function can have holding attributes or not. It is not included in the package because HoldMap is not included in the package:

(* A single position *)
xEvaluateAt2[expr_,posn:_Integer|{___Integer},f_:Identity]:=ReplacePart[expr,Extract[expr,posn,f],posn];
(* A list of positions *)
xEvaluateAt2[expr_,posn:{{__Integer}..},f_:Identity]:=Fold[xEvaluateAt2[#1,#2,f]&,expr,Reverse[Sort[posn]]];

xEvaluateAt2[Hold[(1+1)+(1+1)+(1+1)],{{1,2},{1,3}},XX]

Attributes[XX]={HoldFirst}

xEvaluateAt2[Hold[(1+1)+(1+1)+(1+1)],{{1,2},{1,3}},XX]

Remove[XX]

2.5.2. xHold

In several computations it is interesting to have an alternative function to HoldForm to avoid conflicts. It will be called xHold. Comments:
	- We define xHold with attribute HoldAll instead of HoldAllComplete imitating Hold. The problem is that HoldAllComplete does not strip out Unevaluated or Sequence, and we usually want to do it.
	- I have not been able to make PrecedenceForm to work because it evaluates its argument. We use the (undocumented in the Help) function Parenthesize, that requires the use of DisplayForm. It gives us, however, more control on the ouput.
	- The precedence level 15 is chosen to be just above the precedence 10 of CompoundExpression:
	- I'd like to have those parenthesis colored, but don't know how to do it.

Attributes[PrecedenceForm]

Attributes[Parenthesize]

?xHold

SetAttributes[xHold,HoldAll];
Format[xHold[expr_]]:=DisplayForm@Parenthesize[expr, StandardForm, 15, NonAssociative];
Protect[xHold];

Note that Format produces a MakeBoxes definition.

??xHold

The parenthesis do not appear if the expression is at level 0:

xHold[1+1]

%//InputForm

7 +xHold[1+1]

%//InputForm

2.6. Held mappings

2.6.1. The problem of evaluation. Preliminary comments

Here we deal with the problem of evaluation.

Cycle of evaluation of h[(Subscript["\!\(\*StyleBox[\"\\\"e\\\"\", \"TI\"]\)", 1]), (Subscript["\!\(\*StyleBox[\"\\\"e\\\"\", \"TI\"]\)", 2]),…] (copied from the Reference Guide):
◼ If the expression is a raw object (e.g., Integer, String, etc.), leave it unchanged.
◼ Evaluate the head h of the expression.
◼ Evaluate each element (Subscript["\!\(\*StyleBox[\"\\\"e\\\"\", \"TI\"]\)", i]) of the expression in turn. If h is a symbol with attributes HoldFirst, HoldRest, HoldAll or HoldAllComplete, then skip evaluation of certain elements.
◼ Unless h has attribute HoldAllComplete strip the outermost of any Unevaluated wrappers that appear in the (Subscript["\!\(\*StyleBox[\"\\\"e\\\"\", \"TI\"]\)", i]).
◼ Unless h has attribute SequenceHold, flatten out all Sequence objects that appear among the (Subscript["\!\(\*StyleBox[\"\\\"e\\\"\", \"TI\"]\)", i]).
◼ If h has attribute Flat, then flatten out all nested expressions with head h.
◼ If h has attribute Listable, then thread through any (Subscript["\!\(\*StyleBox[\"\\\"e\\\"\", \"TI\"]\)", i]) that are lists.
◼ If h has attribute Orderless, then sort the (Subscript["\!\(\*StyleBox[\"\\\"e\\\"\", \"TI\"]\)", i]) into order.
◼ Unless h has attribute HoldAllComplete, use any applicable transformation rules associated with f that you have defined for objects of the form h[ f[(Subscript["\!\(\*StyleBox[\"\\\"e\\\"\", \"TI\"]\)", 1]),…],…].
◼ Use any built-in transformation rules associated with f for objects of the form h[ f[(Subscript["\!\(\*StyleBox[\"\\\"e\\\"\", \"TI\"]\)", 1]),…],…].
◼ Use any applicable transformation rules that you have defined for h[(Subscript["\!\(\*StyleBox[\"\\\"e\\\"\", \"TI\"]\)", 1]), (Subscript["\!\(\*StyleBox[\"\\\"e\\\"\", \"TI\"]\)", 2]),…] or for h[…][…].
◼ Use any built-in transformation rules for h[(Subscript["\!\(\*StyleBox[\"\\\"e\\\"\", \"TI\"]\)", 1]), (Subscript["\!\(\*StyleBox[\"\\\"e\\\"\", \"TI\"]\)", 2]),…] or for h[…][…].

To summarize. There are three groups of actions, in this order:
	1.- Evaluate all parts of the expression: first the  head, then the elements.
	2.- Worry, in this order, about Unevaluated, Sequence, Flat, Listable, Orderless. This part is not really clear to me.
	3.- Use upvalues before downvalues, and user definitions before built-in definitions.

Unevaluated plays a very special role in Mathematica because it is very high up in the previous list. I find it the most confusing and difficult to understand or use. For example here the function Length behaves as I would expect:

Length[1+1]//Trace

Length[Unevaluated[1+1]]//Trace

However, a new function behaves very strangely because I guess that its argument is really evaluated, as shown in next line. So, why is not Unevaluated removed from the expression?

length[1+1]//Trace

length[Unevaluated[1+1]]//Trace

Remove[length]

Nothing for the rest of this section goes into the package. We just test different ideas:

2.6.2. The problem of evaluation. Use ReplacePart/Extract. HoldMap

We want to map a function ff on the elements of an expression without evaluating the whole expression or any of its parts (nor at the beginning not at the end), but evaluating the function ff on each element throught downvalues of ff or upvalues for the elements of the expression. We also want to implement recursion in this function. There are two main options:
	- We can avoid evaluation of the input wrapping it initially with xHold and then evaluate its parts using Extract and ReplacePart,
	- or else we can just be extremely careful using the holding attributes and the head Unevaluated.
The first possibility is simpler, but then recursion becomes more complicated because the mapped head is inside a holding head and hence does not easily evaluate. The second possibility is easier from the recursion point of view, but it is also easy to let the arguments evaluate if we manipulate them carelessly.

Let us first explore the first possibility:

This is a simple example:

BeginExamples[]

We define downvalues for ff:

ff[k_Integer]:=k^2

DownValues[ff]

It is clear that we do not want ff to let evaluate its arguments. Therefore we must set a holding attribute. Note that this does not prevent the use of downvalues of ff, which is later in the evaluation cycle.

SetAttributes[ff,HoldFirst]

The example is that we want to convert all integers in the expression 1+2+(3+4) into their squares, without doing any sum at any point.

Without a holding head, Map evaluates its arguments:

Map[ff,1+2+(3+4)]//Trace

We can add Unevaluated to avoid evaluation of the original expression, but then there cannot be recursion because the argument is evaluated before the call to ff. The expression is evaluated at the end too.

Map[ff,Unevaluated[1+2]]//Trace

If we wrap the expression with Hold, then ff does not get evaluated:

Map[ff,Hold[1+2+(3+4)],{2}]

We have not implemented recursion yet:

Map[ff,Unevaluated[1+2+(3+4)]]//Trace

Therefore we need to control the evaluation. A good option is xEvaluateAt2, constructed from Extract and ReplacePart:

xACP`xEvaluateAt2[Hold[1+2+(3+4)],{{1,1},{1,2},{1,3}},ff]

A complete possibility in this case would be the following, but it is not recursive:

xACP`xEvaluateAt2[Hold[1+2+(3+4)],{{1,1},{1,2},{1,3,1},{1,3,2}},ff]

EndExamples[]

We can implement recursion as follows. The idea is that we must evaluate the mapped function, but without evaluating the expression. A possibility is given below, based on the fact that we enclose all substructures with the xHold function.

This is the final function. There is a third argument to choose the holding function. By default it is xHold. This function is not included in the package.

?HoldMap

SetAttributes[HoldMap,HoldAll];
HoldMap[f_,expr_,g_:xHold]:=xEvaluateAt2[g@expr,Thread[{1,Range@Length@Unevaluated@expr}],f];
SetNumberOfArguments[HoldMap,{2,3}];
Protect[HoldMap];

BeginExamples[]

We add recursion as follows. In this case recursion acts on every nonatomic expression:

ff[k:_[___]]:=xACP`HoldMap[ff,k]

ff[1+(2+3):>Module[{},4+(5+6)]]

InputForm[%]

It also works well if the input has holding structures:

ff[Unevaluated[1+(2+3):>Module[{},4+(5+6)]]]

ff[Hold[1+(2+3):>Module[{},4+(5+6)]]]

ff[Hold@Hold[1+(2+3):>Module[{},4+(5+6)]]]

To eliminate the xHold wrappers we need a second function:

SetAttributes[MAINff,HoldFirst]

MAINff[k_]:=ff[k]//.xHold[kk_]->kk

It eliminates even the most external of the xHold's.

MAINff[1+(2+3):>Module[{},4+(5+6)]]

InputForm[%]

MAINff[Hold[Set[1+(2+3),3+(4+5)]]]

MAINff[Hold[1+(2+3),3+(4+5)]]

MAINff[Hold@Hold[1+(2+3),3+(4+5)]]

ff[RuleDelayed[1+(2+3),3+(4+5)]]//Trace

It is however very slow:

Flatten[%]//Length

Note however that recursion must be simple:

ff[k:_[___]]:=xACP`HoldMap[ff,k]

ff[1+(2+3):>Module[{},4+(5+6)]]

ff[k:_[___]]:=xACP`HoldMap[ff[#]&,k]

ff[1+(2+3):>Module[{},4+(5+6)]]

If a pure function is required,then we need to use the third argument of Function:

ff[k:_[___]]:=xACP`HoldMap[Function[{kk},ff[kk],{HoldAll}],k]

ff[1+(2+3):>Module[{},4+(5+6)]]

Remove[ff,MAINff,k,kk]

EndExamples[]

2.6.3. The problem of evaluation. Use ReplacePart/Thread

An alternative is this, which still uses ReplacePart, but now uses Thread instead of Extract. This is more complicated, but I think it is faster:

BeginExamples[]

SetAttributes[ff,HoldFirst]
ff[k_Integer]:=k^2
ff[head_[]]:=xHold[head[]]
ff[head_[elements__]]:=ReplacePart[xHold[head[elements]],Map[Function[{k},ff[k],{HoldAll}],Unevaluated[List[elements]]],Thread[{1,Range@Length@HoldComplete[elements]}],Thread[{Range@Length@HoldComplete[elements]}]]

ff[RuleDelayed[1+(2+3),3+(4+5)]]//Trace

Length[Flatten[%]]

ff[Hold[Set[1+(2+3),3+(4+5)]]]

%//.xHold[k_]->k

Again, we can implement the elimination of xHold using two functions:

SetAttributes[MAINff,HoldFirst];

MAINff[k_]:=ff[k]//.xHold[kk_]->kk

MAINff[1+(2+3)]

ff[RuleDelayed[1+(2+3),3+(4+5)]]

MAINff[RuleDelayed[1+(2+3),3+(4+5)]]

ff[Rule[1+(2+3),3+(4+5)]]

MAINff[Rule[1+(2+3),3+(4+5)]]

MAINff[Hold[Rule[1+(2+3),3+(4+5)]]]

MAINff[Hold[Hold[Rule[1+(2+3),3+(4+5)]]]]

ff[1+(2+3):>Module[{},3+(4+5)]]

MAINff[1+(2+3):>Module[{},3+(4+5)]]

Remove[ff,k,kk,MAINff,head,elements]

EndExamples[]

2.6.4. The problem of evaluation. Use ReplacePart/Extract. HoldMap2

Another alternative to define ff. Let us try using Extract and ReplacePart, imitating the examples given by Mathematica for ReplacePart in the Help. We define the function HoldMap2. It is similar to Map in spirit, but with three differences:
	- Assuming that the mapped function has a Hold attribute, HoldMap maps it on the expression and evaluates the elements, but not the head.
	- There is no choice of levels.
	- There is a third argument to give a wrapper that is placed after mapping and evaluation of the element, but before evalution of the head.
Again, it is not included in the package.

SetAttributes[HoldMap2,HoldAll]
HoldMap2[f_,expr:_[___],g_:xHold]:=Module[{range,heldParts,newParts},
range=Range@Length@Unevaluated@expr;
heldParts=Extract[Unevaluated@expr,Thread@{range},HoldComplete];
newParts=Apply[f,heldParts,{1}];
ReplacePart[Unevaluated@g@expr,newParts,Thread@{1,range},Thread@{range}]
]

Note that the key steps are: 1) the elements of the expression are each wrapped in HoldComplete and then stored as the list heldParts; 2) then each one is passed into the function f (without the HoldComplete) and f[element] is evaluated. The result is wrapped in xHold. The list of results is stored in newParts.

With HoldMap we have full control on the first level of the expression, but not below:

BeginExamples[]

SetAttributes[ff,HoldFirst]

ff[k_Integer]:=k^2

xACP`HoldMap2[ff,1+2+3+4,Identity]

xACP`HoldMap2[ff,1+2+3+4]

xACP`HoldMap2[ff,1+2+(3+(4+5))]

xACP`HoldMap2[ff,Times[1,2,3+4]]//FullForm

Now we can define a new function (which still has the HoldAll attribute):

ff[k:_[___]]:=xACP`HoldMap2[ff,k]

(We do not need to wrap head[elements] with Unevaluated because HoldMap2 has a HoldAll attribute.)

ff[1+(2+(3+4))]

RuleDelayed[1+(2+3),3+(4+5)]

ff[RuleDelayed[1+(2+3),3+(4+5)]]

%//InputForm

ff[Hold[Hold[Set[1+2,3+4]]]]

Again, if a pure function is required, then the third argument of Function must be used:

ff[k:_[___]]:=xACP`HoldMap2[ff,k]

ff[1+(2+(3+4))]

ff[k:_[___]]:=xACP`HoldMap2[ff[#]&,k]

ff[1+(2+(3+4))]

ff[k:_[___]]:=xACP`HoldMap2[Function[{kk},ff[kk],{HoldAll}],k]

ff[1+(2+(3+4))]

Again we would need a second function to eliminate the xHold's.

Remove[ff,k,kk]

EndExamples[]

2.6.5. The problem of evaluation. Second option

Start again: we would like to map a function over a expression without evaluating the expression or its elements, but allowing evaluation of the mapped function taking into account the properties of the elements, using ownvalues of the function of upvalues for the arguments. A simple example is this function, that must change any integer by its square

BeginExamples[]

SetAttributes[ff,HoldFirst];
ff[k_Integer]:=k^2

ff[5]

The HoldFirst attribute ensures that the function ff gets the original argument, not evaluated yet:

ff[2+3]

The expression will be always assumed to be an expression with a head with a Hold attribute, or an expression which has been fed into the function ff using Unevaluated. In the former case the output will be wrapped in the same holding head; in the latter the expression will be returned and inmediately evaluated (unless we supply a holding function using a second argument to the function ff. The elements could be other expressions, not neccesarily the objects that we are seeking to change, and these other expressions need not be surrounded by a holding head, so that we must be careful not to evaluate them at any stage of the process.

1) A simple Map doesn't work. Here we should get 1+4+9, which is 14.

ff[head_[elements___]]:=Map[ff,head[elements]]

ff[1+(2+3)]//Trace

We see that the expression is evaluated before mapping the function (Map doesn't have a Hold attribute). We prevent this by using Unevaluated:

ff[head_[elements___]]:=Map[ff,Unevaluated[head[elements]]]

ff[1+(2+3)]//Trace

2) Now it works. However, if we use a pure function instead of a simple head, recursion doesn't work:

ff[head_[elements___]]:=Map[ff[#]&,Unevaluated[head[elements]]]

ff[1+(2+3)]//Trace

It works only partially because even though ff has attribute HoldFirst we have that these two construction are very different:

ff[2+3]//Trace

(ff[#]&)[2+3]//Trace

A possible solution is using a third argument of pure functions. Note the differences between the previous line and

Function[{k},ff[k]][2+3]//Trace

Function[{k},ff[k],{HoldAll}][2+3]//Trace

Therefore we try:

ff[head_[elements___]]:=Map[Function[{k},ff[k],{HoldAll}],Unevaluated[head[elements]]]

ff[1+(2+3)]//Trace

ff[1+2+3]//Trace

3) We have an additional problem with the heads with a Hold attribute:

ff[Rule[1+2,3+4]]

ff[RuleDelayed[1+2,3+4]]

We solve it by temporarily replacing that head:

ff[head_[elements___]]:=Apply[xHold[head[##]]&,Map[Function[{k},ff[k],{HoldAll}],HoldComplete[elements]]]

ff[RuleDelayed[1+(2+3),3+(4+5)]]//Trace

Length[Flatten[%]]

ff[RuleDelayed[1+(2+3),3+(4+5)]]

%//.xHold[k_]->k

ff[Hold[1+(2+3),3+(4+5)]]

%//.xHold[k_]->k

ff[Hold[Set[1+(2+3),3+(4+5)]]]

ff[Hold[Hold[Set[1+(2+3),3+(4+5)]]]]

%//.xHold[k_]->k

ff[Module[{},3+(4+5)]]

Remove[ff,k,head,elements]

EndExamples[]

This looks better, but it is possible to do it even simpler.

2.6.6. The problem of evaluation. Second option. Simpler

Another idea, even simpler: everything is always wrapped in xHold. Note that ff does not need a holding attribute!

BeginExamples[]

ff[xHold[k_Integer]]:=k^2

ff[xHold[head_[elements___]]]:=Apply[xHold[head[##]]&,ff/@xHold/@xHold[elements]]

ff[xHold[RuleDelayed[1+(2+3),3+(4+5)]]]//Trace

Length[Flatten[%]]

ff[xHold[RuleDelayed[1+(2+3),3+(4+5)]]]

%//.xHold[k_]->k

ff[xHold[Hold[RuleDelayed[1+(2+3),3+(4+5)]]]]

%//.xHold[k_]->k

ff[xHold[Module[{},1+(2+3 4)]]]//Trace

Note that Sequence heads are stripped out:

ff[xHold[Module[{},1+Sequence[2]]]]//Trace

because xHold has attribute HoldAll, and not HoldAllComplete:

xHold[1,Sequence[2]]//Trace

HoldComplete[1,Sequence[2]]

The function fails when head is Slot or SlotSequence:

ff[xHold[Slot[1+(2+3)]]]

We need an additional definition for those cases (In Mathematica 6.0 this new definition is placed last and the problem persists). We break recursion and do not look in the interior of the slots. QUESTION: Are these two the only functions with this problem?

ff[xHold[k:(_Slot|_SlotSequence)]]:=xHold[k]

ff[xHold[Slot[1+(2+3)]]]

Remove[ff,head,elements,k]
EndExamples[]

This is finally the idea that will be used to construct ReplaceIndex in xTensor.

2.7. Formatting strings

2.7.0. On linear syntax

See the tutorial/StringRepresentationOfBoxes for an introduction to this. Remember the correspondence:

	\^	SuperscriptBox
	\_	SubscriptBox
	\&	OverscriptBox
	\+	UnderscriptBox

2.7.1. Underlining strings without blanks: Underline

We shall underline patterns in Output format. This function underlines any expression without blanks:

?Underline

The kind of input used in the main definition here generates an Information message complaining about the double quotes and the notebook preferences options ShowStringCharacters->False. We cannot turn it to True because then there would be quotes around the indices of the tensors in StandardForm. QUESTION: Can we detect blanks?

One argument:

Format::blank="Empty string cannot be `1`.";
Underline[""]:=Throw@Message[Format::blank,"underlined"];
Underline[x_String]:=StringJoin["\!\(",x,"\+_\)"];
Underline[x_]:=Underline[ToString[x]];

Two arguments (colored line):

Underline["",color_]:=Throw@Message[Format::blank,"underlined"];
Underline[x_String,color_]:=StringJoin["\!\(",x,"\+\*StyleBox[\(_\),FontColor->",ToString[color],"]\)"];
Underline[x_,color_]:=Underline[ToString[x],color];
SetNumberOfArguments[Underline,{1,2}];
Protect[Underline];

BeginExamples[]

Underline[hello]

Underline["hello"]

%//FullForm

Underline["ab"]

%//FullForm

Catch@Underline[""]

Underline["hello",RGBColor[1,0,0]]

The blank is not detected in the next three cases. This is odd, because Overline (having the same code) does not have this problem:

Underline["a b"]

Underline[a b]

Underline[" "]

Remove[a,b,hello]

EndExamples[]

2.7.2. Tilding strings without blanks: TildeString

We shall use tildes to denote the weight of densities (Ashtekar notation)

?TildeString

Format::ntilde="Number of tildes `1` should be an integer. Replaced by 1.";

One argument:

TildeString[x_]:=TildeString[x,1];

Two arguments (uncolored tilde):

TildeString["",n_]:=Throw[Message[Format::blank,"tilded"]];
TildeString[x_String,0]:=x;
TildeString[x_String,n_Integer?Positive]:=StringJoin["\!\(",x,Table["\&~",{n}],"\)"];
TildeString[x_String,n_Integer?Negative]:=StringJoin["\!\(",x,Table["\+~",{-n}],"\)"];
TildeString[x_String,n_]:=(Message[Format::ntilde,n];TildeString[x,1]);
TildeString[x_,n_]:=TildeString[ToString[x],n];

Three arguments (colored tilde):

TildeString["",n_,color_]:=Throw[Message[Format::blank,"tilded"]];
TildeString[x_String,0,color_]:=x;
TildeString[x_String,n_Integer?Positive,color_]:=With[{colortilde=StringJoin["\&\*StyleBox[\"~\",FontColor->",ToString[color],"]"]},StringJoin["\!\(",x,Table[colortilde,{n}],"\)"]];
TildeString[x_String,n_Integer?Negative,color_]:=With[{colortilde=StringJoin["\+\*StyleBox[\"~\",FontColor->",ToString[color],"]"]},StringJoin["\!\(",x,Table[colortilde,{-n}],"\)"]];
TildeString[x_String,n_,color_]:=(Message[Format::ntilde,n];TildeString[x,1,color]);
TildeString[x_,n_,color_]:=TildeString[ToString[x],n,color];
SetNumberOfArguments[TildeString,{1,3}];
Protect[TildeString];

Examples:

BeginExamples[]

TildeString[x,3]

%//FullForm

TildeString[x,-3]

%//FullForm

"\!\(x\+~\%~"<>"\)"

TildeString[x,3,Hue[0]]

%//FullForm

TildeString[x,-3,Hue[0]]

%//FullForm

Error messages:

TildeString[x,1/2]

Again, the blank is not detected:

TildeString[x x,1]

TildeString["x x",1]

Remove[x]

EndExamples[]

2.7.3. Coloring strings: ColorString

We shall color the basis indices, and some other heads like ERROR.

?ColorString

We need to map N on the color to convert rational numbers into real numbers. Otherwise ToString does stupid things... Thanks to Alessandro for reporting this problem.

(*ColorString[x_String,color_]:="\!\(\*StyleBox[\""<>x<>"\",FontColor->"<>ToString[N/@color]<>"]\)";*)
(* Replaced by the following line, as suggested by Thomas, to be able to change the color of an already colored string *)
ColorString[x_String,color_]:="\!\(\*StyleBox[\""<>StringReplace[x,StringExpression["\!\(\*StyleBox[\"",y___,"\",FontColor->",col__,"]\)"]:>y]<>"\",FontColor->"<>ToString[N/@color]<>"]\)";
ColorString[x_Symbol,color_]:=ColorString[ToString[x],color];
ColorString[x_Integer,color_]:=ColorString[ToString[x],color];
ColorString[x_,_]:=(Message[Format::nouse,"xTensor`Private`ColorString",x];x);
SetNumberOfArguments[ColorString,2];
Protect[ColorString];

BeginExamples[]

ColorString[Underline[a],Hue[0]]

Underline[ColorString[a,Hue[0]]]

ColorString[-1,Hue[0]]

ColorString[a,RGBColor[0,1,0]]

ColorString["▽",Hue[0]]<>"Hello"

FullForm[%]

ColorString["▽▽",Hue[0]]<>"Hello"

ColorString[-a,RGBColor[0,1,0]]

ColorString[a+b,RGBColor[0,1,0]]

Remove[a,b]

EndExamples[]

2.7.4. Overlining strings: Overline

We shall use overlining for some daggered expressions:

?Overline

One argument:

Format::blank="Empty string cannot be `1`.";
Overline[""]:=Throw@Message[Format::blank,"overlined"];
Overline[x_String]:=StringJoin["\!\(",x,"\&_\)"];
Overline[x_]:=Overline[ToString[x]];

Two arguments (colored line):

Overline["",color_]:=Throw@Message[Format::blank,"overlined"];
Overline[x_String,color_]:=StringJoin["\!\(",x,"\&\*StyleBox[\(_\),FontColor->",ToString[color],"]\)"];
Overline[x_,color_]:=Overline[ToString[x],color];
SetNumberOfArguments[Overline,{1,2}];
Unprotect[Overline];

BeginExamples[]

Overline[hello]

Overline["hello"]

%//FullForm

Overline["ab"]

%//FullForm

Catch@Overline[""]

Overline["hello",RGBColor[1,0,0]]

Overline["a b"]

Overline[a b]

Overline[" "]

Remove[a,b,hello]

EndExamples[]

2.7.5. Hatted strings without blanks: HatString

?HatString

Format::nhat="Number of hats `1` should be an integer. Replaced by 1.";

One argument:

HatString[x_]:=HatString[x,1];

Two arguments (uncolored hat):

HatString["",n_]:=Throw[Message[Format::blank,"hatted"]];
HatString[x_String,0]:=x;
HatString[x_String,n_Integer?Positive]:=StringJoin["\!\(",x,Table["\&^",{n}],"\)"];
HatString[x_String,n_Integer?Negative]:=StringJoin["\!\(",x,Table["\+^",{-n}],"\)"];
HatString[x_String,n_]:=(Message[Format::nhat,n];HatString[x,1]);
HatString[x_,n_]:=HatString[ToString[x],n];

Three arguments (colored hat):

HatString["",n_,color_]:=Throw[Message[Format::blank,"hatted"]];
HatString[x_String,0,color_]:=x;
HatString[x_String,n_Integer?Positive,color_]:=With[{colorhat=StringJoin["\&\*StyleBox[\"^\",FontColor->",ToString[color],"]"]},StringJoin["\!\(",x,Table[colorhat,{n}],"\)"]];
HatString[x_String,n_Integer?Negative,color_]:=With[{colorhat=StringJoin["\+\*StyleBox[\"^\",FontColor->",ToString[color],"]"]},StringJoin["\!\(",x,Table[colorhat,{-n}],"\)"]];
HatString[x_String,n_,color_]:=(Message[Format::nhat,n];TildeString[x,1,color]);
HatString[x_,n_,color_]:=HatString[ToString[x],n,color];
SetNumberOfArguments[HatString,{1,3}];
Protect[HatString];

Examples:

BeginExamples[]

HatString[x,3]

%//FullForm

HatString[x,-3]

%//FullForm

HatString[x,3,Hue[0]]

%//FullForm

HatString[x,-3,Hue[0]]

%//FullForm

Error messages:

HatString[x,1/2]

Again, the blank is not detected:

HatString[x x,1]

HatString["x x",1]

Remove[x]

EndExamples[]

2.8. xUpvalues

xUpSet

We introduce functions that generalize UpSet, UpSetDelayed, AppendTo and DeleteCases, dealing with the possibility of having protected symbols. Note that we evaluate rhs before the assignment and that xUpAppendTo initializes with {} the value of the expression if it does not have a value. Note also that xUpSet only accepts as first arguments expressions with a single argument, and not several as UpSet does.

??UpSet

?xUpSet

SetAttributes[xUpSet,{HoldFirst,SequenceHold}];
xUpSet[head_[symbol_],rhs_]:=With[{protected=Unprotect@@{SubHead[symbol]}},
head[symbol]^=rhs;
Protect[protected];
head[symbol]];
xUpSet[head_[symbol_]]:=With[{subhead=SubHead[symbol],protected=Unprotect@@{SubHead[symbol]}},
TagUnset[subhead,head[symbol]];
Protect[protected];
];
SetNumberOfArguments[xUpSet,{1,2}];
Protect[xUpSet];

xUpSetDelayed

??UpSetDelayed

?xUpSet

SetAttributes[xUpSetDelayed,{HoldAll,SequenceHold}];
xUpSetDelayed[head_[symbol_],rhs_]:=With[{protected=Unprotect@@{SubHead[symbol]}},
head[symbol]^:=rhs;
Protect[protected];
head[symbol]];
xUpSetDelayed[head_[symbol_]]:=With[{subhead=SubHead[symbol],protected=Unprotect@@{SubHead[symbol]}},
TagUnset[subhead,head[symbol]];
Protect[protected];
];
SetNumberOfArguments[xUpSetDelayed,{1,2}];
Protect[xUpSetDelayed];

xUpAppendTo

??AppendTo

?xUpAppendTo

SetAttributes[xUpAppendTo,HoldFirst];
xUpAppendTo[head_[symbol_],element_]:=xUpSet[head[symbol],Append[If[ValueQ[head[symbol]],head[symbol],{}],element]];
SetNumberOfArguments[xUpAppendTo,2];
Protect[xUpAppendTo];

xUpDeleteCases

??DeleteCases

?xUpDeleteCasesTo

SetAttributes[xUpDeleteCasesTo,HoldFirst];
xUpDeleteCasesTo[head_[symbol_],cases_]:=xUpSet[head[symbol],DeleteCases[head[symbol],cases]];
SetNumberOfArguments[xUpDeleteCasesTo,2];
Protect[xUpDeleteCasesTo];

xTagSet

Now we do the same for the Tag functions. Note the following absurd point: All Set functions hold their first argument only, and the SetDelayed functions hold all arguments. However, both TagSet and TagSetDelayed hold all arguments. I do not want to do that, because then TagSet and TagSetDelayed are equivalent. Therefore we slightly modify the notation to pack together the arguments to be held:

??TagSet

?xTagSet

SubHead[symbol_Symbol]:=symbol;
SubHead[expr_]:=NestWhile[Head,expr,Function[!AtomQ[#]]];

SetAttributes[xTagSet,{HoldFirst,SequenceHold}];
xTagSet[{expr_,lhs_},rhs_]:=With[{symbol=SubHead[expr]},
With[{protected=Unprotect[symbol]},
TagSet[symbol,lhs,rhs];
Protect[protected];
rhs]
];
SetNumberOfArguments[xTagSet,2];
Protect[xTagSet];

xTagSetDelayed

??TagSetDelayed

?xTagSetDelayed

SetAttributes[xTagSetDelayed,{HoldAll,SequenceHold}];
xTagSetDelayed[{expr_,lhs_},rhs_]:=With[{symbol=SubHead[expr]},
With[{protected=Unprotect[symbol]},
TagSetDelayed[symbol,lhs,rhs];
Protect[protected];
]
];
SetNumberOfArguments[xTagSetDelayed,2];
Protect[xTagSetDelayed];

Examples

BeginExamples[]

example[pp]^={hello1};
Protect[example,pp];
xUpAppendTo[example[pp],hello2]

If the expression does not have a value, it is initialized to the empty list:

Protect[example2];
xUpAppendTo[example2[pp],hello3]

??pp

xUpDeleteCasesTo[example[pp],hello1]

??pp

If the expression does not have a value, nothing happens:

xUpDeleteCasesTo[example3[pp],hello4]

Unprotect[example,example2,pp];
Remove[example,example2,example3,hello1,hello2,hello3,hello4,pp]

EndExamples[]

2.9. On rules

2.9.1. ReplaceLast

This function maps ReplaceAll with a given set of rules to the last element of an expression. It is very useful to replace rules in the rhs of other rules. It is not being used right now.

ReplaceLast[expr_,rules_]:=ReplacePart[expr,Extract[expr,-1,Hold]/.rules,-1,1];
SetNumberOfArguments[ReplaceLast,2];
Protect[ReplaceLast];

We do not need to switch to the Global` context here:

ReplaceLast[RuleDelayed[1+1,1+1],1->2]//Trace

2.9.2. MapRule

To act on the left of right hand sides of rules we introduce these two simple functions (not being used right now):

?MapRuleR

MapRuleR[f_,list_List]:=Map[MapRuleR[f,#]&,list];
MapRuleR[f_,Rule[x_,y_]]:=Rule[x,f[y]];
MapRuleR[f_,RuleDelayed[x_,y_]]:=RuleDelayed[x,f[y]];
MapRuleR[f_,FoldedRule[rules__,last_]]:=FoldedRule[rules,MapRuleR[f,last]];
MapRuleR[f_,expr_]:=expr;
SetNumberOfArguments[MapRuleR,2];
Protect[MapRuleR];

?MapRuleL

MapRuleL[f_,list_List]:=Map[MapRuleL[f,#]&,list];
MapRuleL[f_,Rule[x_,y_]]:=Rule[f[x],y];
MapRuleL[f_,RuleDelayed[x_,y_]]:=RuleDelayed[f[x],y];
MapRuleL[f_,FoldedRule[rules__,last_]]:=FoldedRule[rules,MapRuleL[f,last]];
MapRuleL[f_,expr_]:=expr;
SetNumberOfArguments[MapRuleL,2];
Protect[MapRuleL];

2.10. FoldedRule

2.10.1. Definition

We introduce the useful concept of folded-rules. Note that it can be used with both Rule and DelayedRule. These definitions instruct ReplaceAll and ReplaceRepeated (but not Replace or ReplaceList) on how to use it:

?FoldedRule

Attributes[FoldedRule]={Flat,OneIdentity};
FoldedRule/:ReplaceAll[expr_,FoldedRule[rules___]]:=Fold[ReplaceAll,expr,{rules}];
FoldedRule/:ReplaceRepeated[expr_,FoldedRule[rules___]]:=Fold[ReplaceRepeated,expr,{rules}];
Protect[FoldedRule];

BeginExamples[]

FoldedRule[]

x+t/.FoldedRule[{x->y,t->x},{y->z}]

x//.FoldedRule[x->y,y->z]//Trace

Note the Flat attribute:

FoldedRule[a,b,FoldedRule[c,FoldedRule[d]],e,f]

Attributes[RuleDelayed]

Note that the first 1+1 is not evaluated initially, but the second is, due to the HoldRest attribute of RuleDelayed:

x+t/.FoldedRule[{x:>1+1},{1+1:>hello}]//Trace

QUESTION: There is a problem with lists of rules, and I don't know how to solve it:

x+y/.{x->a,a->b,y->c}

x+y/.{FoldedRule[x->a,a->b],y->c}

Remove[a,b,c,d,e,f,hello,t,x,y,z]

EndExamples[]

2.10.2. CollapseFoldedRule

Sometimes we want to collapse the FoldedRule, obtaining a sequence of lists of rules directly in terms of the independent objects. We also introduce an intermediate function f which can be used to arrange or simplify intermediate steps of the computation. Note that the last set of rules of the FoldedRule (the "independent" rules) are not touched by this function f.

maprule[f_][head_[lhs_,rhs_]]:=head[lhs,f[rhs]];

collapse1[FoldedRuleTMP[rules_],f_]:=Flatten[{rules}];
collapse1[FoldedRuleTMP[rules___,rulesm2_,rulesm1_],f_]:=FoldedRuleTMP[rules,Flatten[{Map[maprule[f],Flatten[{rulesm2/.rulesm1}],{1}],rulesm1}]];
collapse[FoldedRule[rules__],f_]:=Nest[collapse1[#,f]&,FoldedRuleTMP[rules],Length[{rules}]];

To increase flexibility we imitate the positional notation of Take, and so there are lots of different cases:

?CollapseFoldedRule

CollapseFoldedRule::pos="Cannot collapse positions `1`.";
CollapseFoldedRule[frule_]:=CollapseFoldedRule[frule,{1,Length[frule]},Identity];
CollapseFoldedRule[frule_,All,f_:Identity]:=CollapseFoldedRule[frule,{1,Length[frule]},f];
CollapseFoldedRule[frule_,0|{0,0},f_:Identity]:=frule;
CollapseFoldedRule[frule_,n_Integer?Positive,f_:Identity]:=CollapseFoldedRule[frule,{1,n},f];
CollapseFoldedRule[frule_,n_Integer?Negative,f_:Identity]:=CollapseFoldedRule[frule,{n+1,0}+Length[frule],f];
CollapseFoldedRule[frule_,{first_Integer?Negative,last_Integer?Negative},f_:Identity]:=CollapseFoldedRule[frule,{first,last}+Length[frule]+1,f];
CollapseFoldedRule[frule_,{first_Integer?Positive,last_Integer?Negative},f_:Identity]:=CollapseFoldedRule[frule,{first,last+1+Length[frule]},f];
CollapseFoldedRule[frule_,{first_Integer?Positive,last_Integer?Positive}/;last≥first,f_:Identity]:=FoldedRule[Take[frule,{1,first-1}],collapse[Take[frule,{first,last}],f],Take[frule,{last+1,Length[frule]}]];
CollapseFoldedRule[frule_,positions_,f_:Identity]:=Throw[Message[CollapseFoldedRule::pos,positions]];
SetNumberOfArguments[CollapseFoldedRule,{1,3}];
Protect[CollapseFoldedRule];

Examples:

BeginExamples[]

FRule=FoldedRule[a->b,b->c,c->d,{d->e,x->e},e->f];

{a,b,c,d,e,f,x}/.FRule//Trace

collapsedFRule=CollapseFoldedRule[FRule]

{a,b,c,d,e,f,x}/.collapsedFRule//Trace

Positive arguments:

CollapseFoldedRule[FRule,1]

CollapseFoldedRule[FRule,2]

CollapseFoldedRule[FRule,3]

CollapseFoldedRule[FRule,4]

CollapseFoldedRule[FRule,5]

%===collapsedFRule

Negative arguments:

CollapseFoldedRule[FRule,-1]

CollapseFoldedRule[FRule,-2]

CollapseFoldedRule[FRule,-3]

CollapseFoldedRule[FRule,-4]

CollapseFoldedRule[FRule,-5]

%===collapsedFRule

Additional function:

CollapseFoldedRule[FRule,{1,1},hello]

CollapseFoldedRule[FRule,{1,2},hello]

CollapseFoldedRule[FRule,{1,3},hello]

CollapseFoldedRule[FRule,{1,4},hello]

CollapseFoldedRule[FRule,{1,5},hello]

Intermediate cases:

CollapseFoldedRule[FRule,{2,4}]

CollapseFoldedRule[FRule,{3,5}]

Remove[a,b,c,d,e,f,x,hello,FRule,collapsedFRule]

EndExamples[]

2.10.3. Dependent and Independent

Given a list or an array of rules we usually need to separate the "dependent rules", for which some components can be given in terms of other components, the "independent components". There are some List's and Flatten's to ensure that the output is always a list (not an array) of rules.

?DependentRules

?IndependentRules

This is not being used now:

DependentRules[list_]:=List@@DeleteCases[list,HoldPattern[x_->x_]];
DependentRules[frule_FoldedRule]:=Flatten[Join@@Map[List,Drop[frule,-1]]];
IndependentRules[list_]:=Cases[list,HoldPattern[x_->x_]];
IndependentRules[frule_FoldedRule]:=Flatten[{Last[frule]}];
SetNumberOfArguments[DependentRules,1];
SetNumberOfArguments[IndependentRules,1];
Protect[DependentRules,IndependentRules];

2.11. AppendToUnevaluated

The builtin AppendTo has attribute HoldFirst, but actually evaluates its first argument:

list={a};
a=1;

AppendTo[list,b]

a=.

list

There is no way to get {a,b} back.

SetAttributes[AppendToUnevaluated,HoldFirst];
append[Hold[{values___}],value_]:=Hold[{values,value}];
AppendToUnevaluated[symbol_Symbol,value_]:=Set[OwnValues[symbol],ruledelayed[HoldPattern[symbol],append[Extract[OwnValues[symbol],{1,2},Hold],value]]];
ruledelayed[LHS_,Hold[RHS_]]:=RuleDelayed[LHS,RHS];
Protect[AppendToUnevaluated];

list={a};
a=1;

AppendToUnevaluated[list,b]

list

a=.

list

2.12. xTension

MakexTensions[defcommand_Symbol,moment_String,args__]:=ReleaseHold[#][args]&/@Cases[DownValues[xTension],rule_[holdpattern_[xTension[package_,defcommand,moment,___]],action_]:>Hold[action]];

2.13. Changing configuration variables and options

Report changes in configuration variables:

Exit

ValueQ[$PrePrint]

SetAttributes[ReportSet,HoldFirst];
ReportSet[var_,value_]:=If[var=!=value,
If[ValueQ[var],
Print["** Variable ",Unevaluated[var]," changed from ",var," to ",value],
Print["** Variable ",Unevaluated[var]," assigned value ",value]
];
Set[var,value]
];
Protect[SetConfigurationVariable];

ReportSetOption[symbol_,option_->value_]:=If[(option/.Options[symbol])=!=value,
Print["** Option ",option," of ",symbol," changed from ",option/.Options[symbol]," to ",value];
SetOptions[symbol,option->value]
];
Protect[ReportSetOption];

2.14. A tests system

We use xTest instead of Test to avoid conflicts with the Test functionality of WorkBench.

This is a simple way to perform a set of tests and report the results. Tests are associated to a given symbol and execute and expression. We compare the result with a prestored result and also check whether messages were produced:

Clear[xTest,TestResult,TestCounter,AllTests];

SetAttributes[xTest,HoldAll];
SetAttributes[{TestResult,TestCounter,AllTests},HoldFirst];

TestCounter[]:=(TestCounter[]=0);
TestCounter[symbol_]:=(TestCounter[symbol]=0);

xTest[symbol_,expr_,expected_,messageQ_:False,postprocess_:Null]:=Module[{eval,result},
TestCounter[]++;
TestCounter[symbol]++;
eval=(
TestResult[symbol,TestCounter[symbol]]=
Check[SameQ[result=With[{res=Catch[expr]},Hold[res]],Hold[expected]],messageQ]
);
If[!eval,Print["Obtained instead: ",result]];
postprocess;
{HoldForm[symbol],TestCounter[symbol],eval}
];

This collects the results of all tests, or of all tests for a given symbol:

AllTests[]:=Last/@DownValues[TestResult];
AllTests[symbol_]:=
Cases[DownValues[TestResult],_[_[TestResult[symbol,_]],result_]:>result]

Check whether the tests passed or failed:

CheckTests[symbol___]:=With[{alltests=AllTests[symbol]},
If[And@@alltests &&Length@alltests===TestCounter[],

Print["All ",Length[alltests]," tests passed"],

Print["These tests failed: "];Print[(First/@DownValues[TestResult][[Flatten@Position[alltests,False]]])/.{HoldPattern->HoldForm,TestResult->List}//Column]

]
];

2.15. Patterns

NoPattern[x_PatternTest]:=NoPattern[First[x]];
NoPattern[x_Pattern]:=NoPattern[First[x]];
NoPattern[x_Blank]:=NoPattern[First[x]];
NoPattern[f_[args___]]:=NoPattern[f]@@(NoPattern/@{args});
NoPattern[x_]:=x;
Protect[NoPattern];

3. Symbols and names

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

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

3.0. Comments

If[$ReadingVerbose,Print["Reading section 1: Symbols, names and messages."],Null,Null]

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. If a tensor M and a manifold M are needed then use symbols ManifoldM or TensorM instead of Manifold`M or Tensor`M.
	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 that 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 do it.

3.1. Names in Mathematica

3.1.0. Comments

We will use symbols in xAct obeying these properties:
	- They have valid names in Mathematica. (Copied from Reference Guide A.2.4: Symbol names and contexts can contain any characters that are treated by Mathematica as letters or letter-like forms. They can contain digits but cannot start with them.)
	- Their names are not LockedNames or SpecialOutputNames (see below).
	- When trying to use a symbol which is protected or readprotected, we issue a warning and stop. The attribute must be removed (under responsibility of the user; we advise against this) before the object can be defined.

Classification of names (subcategories of SystemNames are overlapping)

* Names:
	* PrivateNames
	* MathematicaNames:
		* SystemNames:
			* SpecialOutputNames
			* LockedNames
			* ProtectedNames
			* ReadProtectedNames
			* LengthOneNames
			* other
		* ContextualNames
	* EMNames
	* xCoreNames
	* xPermNames
	* xTableauNames
	* xTensorNames
	* xCobaNames
	* InvarNames
	* HarmonicsNames
	* xPertNames
	* SpinorsNames
	
	* Objects: manifolds, vector bundles, abstract-indices, tensors, forms, covariant derivatives, constant symbols, scalar functions, inert heads, bases, charts

3.1.2. Names variables

Note: the variable Verbose, already present as a SystemName, will be redefined by xTensor:

??Verbose

Verbose

xAct`xTensor`Verbose

We see that xAct`xTensor`Verbose will be found before System`Verbose. That means that everything defined before xTensor is loaded will continue working, but everything we define now using the internal Verbose must be properly defined. I don't know what System`Verbose is, and so I guess this is not a problem.

We can already define (For Mathematica 8 we remove two symbols that are not supported under Unix/Linux):

$EMNames=Names["xAct`ExpressionManipulation`*"];
$xCoreNames=Names["xAct`xCore`*"];
$SystemNames=DeleteCases[Names["System`*"],"$DefaultImagingDevice"|"$ImagingDevices"];

Length/@{$EMNames,$xCoreNames,$SystemNames}

Other eight variables will be initialized when reading the corresponding packages:

$xPermNames:={};
$xTableauNames:={};
$xTensorNames:={};
$xCobaNames:={};
$InvarNames:={};
$HarmonicsNames:={};
$xPertNames:={};
$SpinorsNames:={};

$xActNames:=Join[$EMNames,$xCoreNames,$xPermNames,$xTableauNames,$xTensorNames,$xCobaNames,$InvarNames,$HarmonicsNames,$xPertNames,$SpinorNames];

Note that in total, including many other packages and their private symbols:

Length[Names[]]

Seven SystemNames, plus 113 global dollar-variables (plus 13 colors, starting 5.2) have special output and therefore are not valid as names in xTensor (to avoid interfeering with their Format definitions):

Note of October 2011: There is some bug in Mathematica 8 that makes this line interfere with the syntax coloring routines. We deactivative this now:

$SpecialOutputNames=Select[$SystemNames,(#=!=ToString@FullForm@ToExpression@#)&]

FullForm/@ToExpression/@$SpecialOutputNames[[Range[7]]]

$SpecialOutputNames={};

It is interesting (and confusing) to analyze the information on one of these objects:

Attributes[DirectedInfinity]

Unprotect[DirectedInfinity]

ClearAttributes[DirectedInfinity,ReadProtected]

??DirectedInfinity

SetAttributes[DirectedInfinity,{Protected,ReadProtected}]

Nine SystemNames (and symbol I) are locked and therefore we cannot associate new values to them (note that Attributes accepts both symbols and their names):

LockedQ[symbol_]:=MemberQ[Attributes[symbol],Locked]
$LockedNames=Select[Complement[$SystemNames,$SpecialOutputNames],LockedQ]

??TooBig

but most SystemNames are just protected. We advise against their use in xTensor, but it is possible to do it, under responsibility of the user, removing the protection.

ProtectedQ[symbol_]:=MemberQ[Attributes[symbol],Protected]
$ProtectedNames=Select[Complement[$SystemNames,$SpecialOutputNames,$LockedNames],ProtectedQ];

Length[$ProtectedNames]

We also have readprotected SystemNames:

ReadProtectedQ[symbol_]:=MemberQ[Attributes[symbol],ReadProtected]
$ReadProtectedNames=Select[Complement[$SystemNames,$SpecialOutputNames],ReadProtectedQ];

Length[$ReadProtectedNames]

and interestingly, not all of them are protected. Note that most of them are related to I/O processes:

Complement[$ReadProtectedNames,$ProtectedNames]

3.1.3. Classification of $HeldNames

Nothing in this subsection goes into the package.

It is also interesting to know which symbols have Hold Attributes:

HeldQ[symbol_]:=MemberQ[Attributes[symbol],HoldAllComplete|HoldAll|HoldFirst|HoldRest|NHoldAll|NHoldFirst|NHoldRest|SequenceHold]
$HeldNames=Select[$SystemNames,HeldQ];

Length[$HeldNames]

It is important to study these names to get an idea of what situations need a Hold attribute:

First we have assignment functions, which are all Protected. Important observations: 
	1) They all hold the first argument at least.
	2) Set functions have HoldFirst, whereas SetDelayed functions have HoldAll.
	3) Functions like AddTo use HoldFirst.
	4) Set, UpSet and TagSet (and their Delayed versions) use SequenceHold. QUESTION: Why?

assignment=ToString/@{Set,UpSet,Unset,SetDelayed,TagSet,TagSetDelayed,TagUnset,UpSetDelayed,Clear,Protect,Unprotect,UpValues,DownValues,Attributes,ClearAttributes,SetAttributes,DefaultValues,FormatValues,NValues,OwnValues,ClearAll,Remove,SubValues,Alias,UnAlias,EditDefinition,Increment,Decrement,PreIncrement,PreDecrement,AddTo,SubtractFrom,TimesBy,DivideBy,AppendTo,PrependTo};

And@@(ProtectedQ/@assignment)

{#,DeleteCases[Attributes[#],Protected]}&/@assignment//TableForm

Then we have functions that move around definitions and messages. Note that MakeBoxes and InterpretationBox have attribute HoldAllComplete.

information=ToString/@{Save,DumpSave,Definition,FullDefinition,Information,Messages,On,Off,Message,MessageName,MessagePacket,ConsoleMessage,ConsolePrint,Catch,Check,CheckAbort,CheckAll,AbortProtect,InterpretationBox,MakeBoxes,Trace,TraceDialog,TracePrint,TraceScan,Debug,Context};

All but three are protected:

And@@(ProtectedQ/@DeleteCases[information,"ConsoleMessage"|"ConsolePrint"|"MakeBoxes"])

{#,DeleteCases[Attributes[#],Protected]}&/@information//TableForm

Now rules and patterns. Comments:
	1) Rule and RuleDelayed do not hold their first argument (compare with assignment functions). They also use SequenceHold.
	2) Blank, Pattern, PatternTest and Condition are all different!

rulepatterns=ToString/@{Rule,RuleDelayed,RuleCondition,Blank,Pattern,PatternTest,Condition};

And@@(ProtectedQ/@rulepatterns)

{#,DeleteCases[Attributes[#],Protected]}&/@rulepatterns//TableForm

FullForm[x_h?Q]

Remove[x,h,Q]

Actual operators and mathematical functions. Comments:
	1) Those functions that have arguments pinpointing parts use NHoldRest on them so that they are not affected by N.
	2) Mathematical functions with an Integer index use NHoldFirst for the same reason
	3) Other heads have attribute HoldAll

operators=ToString/@{
Drop,Extract,HeldPart,Part,Take,
Product,Sum,Root,FindRoot,FindMinimum,NIntegrate,NProduct,NSum,
Plot,Plot3D,ParametricPlot,ParametricPlot3D,DensityPlot,ContourPlot,
MathieuC,MathieuCharacteristicA,MathieuCharacteristicB,MathieuCPrime,MathieuS,MathieuSPrime,StieltjesGamma,PolyGamma,EllipticTheta,EllipticThetaPrime};

And@@(ProtectedQ/@operators)

{#,DeleteCases[Attributes[#],Protected]}&/@operators//TableForm

Functions that evaluate their arguments in special ways. QUESTION: Why Verbatim does not have a Hold attribute?

evaluation=ToString/@{Block,Module,With,Hold,HoldForm,HoldPattern,Literal,Verbatim,HoldComplete,Parenthesize,Unevaluated};

And@@(ProtectedQ/@evaluation)

{#,DeleteCases[Attributes[#],Protected]}&/@evaluation//TableForm

And functions that control the flow of evaluation. Note that If and Switch evaluate their first argument.

flow=ToString/@{And,Or,For,ForAll,Exists,CompoundExpression,Do,Which,While,Table,If,Switch};

{#,DeleteCases[Attributes[#],Protected]}&/@flow//TableForm

Other functions:

other=Complement[$HeldNames,assignment,rulepatterns,operators,evaluation,information,flow]

{#,DeleteCases[Attributes[#],Protected]}&/@other//TableForm

Complement[$HeldNames,Join[assignment,evaluation,flow,information,operators,other,rulepatterns]]

I'm really surprised with these pattern heads. I would assume they need holding attributes:

Complement[Join[assignment,evaluation,flow,information,operators,other,rulepatterns],$HeldNames]

Remove[assignment,rulepatterns,operators,evaluation,information,flow,other]

3.1.4. Capitals

There are several capital letters that could interfere with Mathematica:

Cases[$SystemNames,Alternatives@@CharacterRange["A","Z"]]

They are actually the only names with length 1. In Mathematica 5 we also have $.

$LengthOneNames=Select[$SystemNames,StringLength[#]==1&]

??$

Two of them have special output:

{C,D,E,I,K,N,O}

but the default output for E can be changed. In the past this was included in xTensor to allow E to be an index. Now it is not allowed and the output is not modified by default.

Unprotect[E];
MakeBoxes[E,_]^="E";
Protect[E];

{C,D,E,I,K,N,O}

However I is locked. Then I cannot be registered as a tensor or an index (I would really prefer to be a tensor, really... ).

Attributes[I]

Problem: values for D, E, O are ReadProtected and have associated MakeBoxes definitions.

Attributes/@{C,D,E,K,N,O}

Is there any problem in removing readprotection for them? At the moment I do not do it.

Another question is whether the declaration of C, D, K, N, O as indices might interfere with their Mathematica meanings. The answer depends on the context given to them. They have originally context System`. We have two options: using System`D as an index or using Global`D as an index, etc. The first option has the possible problem of interfeering definitions; the second option has the problem of requiring to write System`D when we want a derivative, etc.

Context/@$LengthOneNames

3.1.5. Lengths

withlengths=Split[Sort[{StringLength[#],#}&/@$SystemNames],First[#1]===First[#2]&];

Last/@withlengths[[1]]

Last/@withlengths[[2]]

Last/@withlengths[[3]]

withlengths[[-3]]

withlengths[[-2]]

withlengths[[-1]]

{First[First[#]],Length[#]}&/@withlengths

ListPlot[%,PlotStyle->{Hue[0],PointSize[0.02]}]

Remove[withlengths]

3.1.6. FindSymbols

We can detect all symbols of an expression using FindSymbols. Strings and numeric quantities are removed. The function Hold in the definition holds the symbols found by Level; the function Cases evaluates the result by default, but if we use a function f that holds its arguments then the symbols are not evaluated. Note that repeated elements appear several times:

?FindSymbols

SetAttributes[FindSymbols,HoldAllComplete];
FindSymbols[expr_,f_:Identity]:=Cases[Level[Unevaluated[expr],{-1},Hold,Heads->True],x_Symbol:>f[x]];
FindSymbols[]:={};
SetNumberOfArguments[FindSymbols,{0,2}];
Protect[FindSymbols];

It is only used by UnknownSymbols.

BeginExamples[]

FindSymbols[a1+a2[b]+a3[c][{d,1+2}]+a4[e[f[g]]][h i]+f["Hello"]]

FindSymbols[3a]

FindSymbols[a]

FindSymbols[{}]

FindSymbols[]

We can map the symbols with some head:

FindSymbols[3b+c]

FindSymbols[3b+c,f]

If a symbol can be evaluated, then it will be evaluated by default, but we can use a head with some Hold attribute to avoid it:

a=b;

FindSymbols[3a+c]

Trace[FindSymbols[3a+c,HoldForm]]

FindSymbols[Hold[3a+c]]

Trace[FindSymbols[FindSymbols[a[b]+c],Hold]]

Trace[FindSymbols[Sequence[a+b],HoldForm]]

Note that Evaluate does not really evaluate the symbol a in the next two examples. FindSymbols allows no evaluation at all due to its HoldAllComplete attribute

Trace[FindSymbols[Evaluate[a+b]]]

Trace[FindSymbols[Evaluate[a+b],HoldForm]]

Study these additional cases:

FindSymbols[Function[{a},a^2],HoldForm]

FindSymbols[x^2]

FindSymbols[#^2]

Remove[a,b,c,d,e,f,g,h,i,a1,a2,a3,a4,x]

EndExamples[]

3.2. ValidateSymbol

Detect whether a symbol (or character) is a capital in the System` context:

SystemCapitalQ[symbol_]:=And[MemberQ[$LengthOneNames,ToString[symbol]],Context[symbol]==="System`"];

With this function we check that a symbol is valid and that it is not already in use by xCore, xPerm, xTensor, ExpressionManipulation or Mathematica. The checks are performed in a slightly different order from that given in the usage message. As we said, this should be generalized to include other packages like xCoba.

?ValidateSymbol

We have separated invalid from protected messages due to the following reason: we can have indices which are protected symbols but not invalid symbols. The "locked" error has been moved to the first group because a locked symbol can never be used, even if it is one-character long.

ValidateSymbol::invalid="Symbol `1` is invalid because it `2`.";
ValidateSymbol::protected="Symbol `1` is `2`.";
ValidateSymbol::used="Symbol `1` is already used `2`.";

MemberQ[$SystemNames,"C"]

SetAttributes[ValidateSymbol,HoldFirst]
ValidateSymbol[symbol_]:=With[{name=ToString[Unevaluated[symbol]]},
Which[

(* Errors: generic problems *)
NumericQ[symbol],
Throw@Message[ValidateSymbol::invalid,name,"has numeric value"],
ValueQ[symbol],
Throw@Message[ValidateSymbol::invalid,name,"has an ownvalue"],
!AtomQ[symbol],
Throw@Message[ValidateSymbol::invalid,name,"is not atomic"],
LockedQ[Symbol[name]],
Throw@Message[ValidateSymbol::protected,name,"is Locked"],

(* Errors: xAct problems *)
MemberQ[$EMNames,name],
Throw@Message[ValidateSymbol::used,name,"by ExpressionManipulation"],
MemberQ[$xCoreNames,name],
Throw@Message[ValidateSymbol::used,name,"by xCore"],
MemberQ[$xPermNames,name],
Throw@Message[ValidateSymbol::used,name,"by xPerm"],
MemberQ[$xTableauNames,name],
Throw@Message[ValidateSymbol::used,name,"by xTableau"],
MemberQ[$xTensorNames,name],
Throw@Message[ValidateSymbol::used,name,"by xTensor"],
MemberQ[$xCobaNames,name],
Throw@Message[ValidateSymbol::used,name,"by xCoba"],
MemberQ[$InvarNames,name],
Throw@Message[ValidateSymbol::used,name,"by Invar"],
MemberQ[$HarmonicsNames,name],
Throw@Message[ValidateSymbol::used,name,"by Harmonics"],
MemberQ[$xPertNames,name],
Throw@Message[ValidateSymbol::used,name,"by xPert"],
MemberQ[$SpinorsNames,name],
Throw@Message[ValidateSymbol::used,name,"by Spinors"],

SystemCapitalQ[symbol],
Return[],

(* Errors: Mathematica problems *)
ProtectedQ[Symbol[name]],
Throw@Message[ValidateSymbol::protected,name,"Protected"],
ReadProtectedQ[Symbol[name]],
Throw@Message[ValidateSymbol::protected,name,"ReadProtected"],
MemberQ[$SystemNames,name]&&Context[name]=="System`",
Throw@Message[ValidateSymbol::used,name,"by Mathematica"]

]
];
SetNumberOfArguments[ValidateSymbol,1];
Protect[ValidateSymbol];

Examples:

BeginExamples[]

Checks of the number of arguments:

Catch@ValidateSymbol[]

Catch@ValidateSymbol[A,E]

Checks of first group of problems:

Catch@ValidateSymbol[E]

Catch@ValidateSymbol[I]

A=B;

Catch@ValidateSymbol[A]

A=.

Catch@ValidateSymbol[Space]

Catch@ValidateSymbol[{A,E}]

Catch@ValidateSymbol[A+B]

Checks of second group of problems:

Catch@ValidateSymbol[True]

Catch@ValidateSymbol[Hold]

Catch@ValidateSymbol[Install]

Checks of third group of problems:

Catch@ValidateSymbol[eP]

Catch@ValidateSymbol[xUpSet]

Catch@ValidateSymbol[Box]

Capitals C,D,K,N,O are used by Mathematica but do not throw an error:

ValidateSymbol[C]

Other symbols are valid:

ValidateSymbol[hello]

Again, don't follow the Trace of ValidateSymbol because it works with huge lists of names...

Remove[A,B,hello]

EndExamples[]

3.3. Precedence of symbols

Nothing here goes into the package.

We can compute the precedence of all SystemNames:

Length[$SystemNames]

precs=Precedence/@Symbol/@$SystemNames;

Most of them have precedence 680 in Mathematica 4 or 670 in Mathematica 5:

precMost=Switch[System`$VersionNumber,
4.,680.,
5.,670.,
5.1,670.,
5.2,670.
]

Actually only these do not have it:

nonMostprecs=Sort[DeleteCases[Transpose[{precs,$SystemNames}],{precMost,_}]];

Transpose[Join[{Range@Length@nonMostprecs},Transpose[nonMostprecs]]]//TableForm

We see that precedence of a symbol is a real number between 0 and 1000. Many precedences are repeated:

nonMostprecsJ=nonMostprecs//.{x___,{y_,s1__},{y_,s2__},z___}->{x,{y,s1,s2},z};

Length[nonMostprecsJ]

nonMostprecsJ//ColumnForm

Comments on ranges (this is just a rough organization):
	- 0 - 30: some output constructs.
	- 30 - 100: setting.
	- 100 - 200: low prec patterns and rules. Note that Pattern has changed from 670 in Math4 to 150 in Math5.
	- 200 - 300: logic operations. Nor, Xor, Nand, Not have been included in Maht5.
	- 300 - 600: mathematical operations, in the expected order.
	- 600 - 660: functional programming and recursion
	- 680 in Math4 or 670 in Math5: most SystemNames
	- 690 - 710: boxes: sub/super boxes have lower prec than under/over boxes. Low prec of SuperscriptBox (equal to that of Power): 590.
	- 670 - 740: high prec patterns.
	- 750: Intersection has a very high prec.
	- 1000: All symbols with these precedence are contained in $SpecialOutputNames, or are colors.

Remove[precs,precMost,nonMostprecs,nonMostprecsJ,z,s1,s2]

3.4. Combine symbols

3.4.1. SymbolJoin

This function generates a symbol joining together a sequence of atoms. It should be a Mathematica built-in.

?SymbolJoin

SymbolJoin[symbols__]:=Symbol@StringJoin[ToString/@{symbols}];
SymbolJoin[]:=Null;
Protect[SymbolJoin];

BeginExamples[]

SymbolJoin[a,b]

SymbolJoin[a,3,b]

Evaluate[SymbolJoin[a,b]]=3;

ab

SymbolJoin[a]//FullForm

SymbolJoin[]

If one of the symbols can be evaluated:

a=b;

SymbolJoin[a,b]

To avoid evaluation strings must be supplied:

SymbolJoin["a","b"]

Note the special case

SymbolJoin["a"]

This is because the generated symbol is again a, which can be evaluated:

Trace[SymbolJoin["a"]]

Remove[a,b,ab,bb,a3b]

EndExamples[]

In case the symbol should be held to avoid evaluation then the final Symbol@ must be dropped, and the name of the symbol (which is a string) must be handled with care to get a held symbol.

3.4.2. Linking symbols

As in the package Notations, we take the under-bracket as (private) default linking character:

?$LinkCharacter

$LinkCharacter="⎵";

It is very simple to join different symbols:

?LinkSymbols

LinkSymbols[symbols_List]:=SymbolJoin@@Insert[symbols,$LinkCharacter,Partition[Range[2,Length[symbols]],1]];
SetNumberOfArguments[LinkSymbols,1];
Protect[LinkSymbols];

It is a bit more complicated to undo the linking:

?UnlinkSymbol

UnlinkSymbol[symbol_Symbol]:=UnlinkSymbol2[ToString[symbol]];
UnlinkSymbol2[string_String]:=UnlinkSymbol3[string,First/@StringPosition[string,$LinkCharacter]];
UnlinkSymbol3[string_,{}]:={Symbol[string]};
UnlinkSymbol3[string_,positions_List]:=Map[Symbol,Map[StringTake[string,#]&,Transpose[{Prepend[positions+1,1],Append[positions-1,Length[Characters[string]]]}]]];
SetNumberOfArguments[UnlinkSymbol,1];
Protect[UnlinkSymbol];

Examples:

BeginExamples[]

list={a,bb,cc,ddd,eeee};

LinkSymbols[list]

UnlinkSymbol[%]

%===list

Note that LinkSymbols requires always a list and that UnlikSymbol on a single symbol gives a list:

LinkSymbols[{aaa}]

UnlinkSymbol[%]

Remove[a,aaa,a⎵bb⎵cc⎵ddd⎵eeee,bb,cc,ddd,eeee,list]

EndExamples[]

3.5. Dagger symbols

The "daggering" of objects will be controlled by several functions. Here we define the three private functions acting on symbols to detect, put or remove the $DaggerCharacter.

0) This is the character we shall use to create new names by appending it at the end. Do not protect it.

?$DaggerCharacter

$DaggerCharacter="†";

1) We need a function to construct the dagger symbols. The most important point is that the dagger of an already daggered symbol is a symbol without dagger, and not a symbol with two daggers. Therefore the first thing to do is constructing a function which detects whether a symbol contains the $DaggerCharacter (do not confuse it with DaggerQ in xTensor):

?HasDaggerCharacterQ

HasDaggerCharacterQ[-symbol_Symbol]:=HasDaggerCharacterQ[SymbolName[symbol]];
HasDaggerCharacterQ[symbol_Symbol]:=HasDaggerCharacterQ[SymbolName[symbol]];
HasDaggerCharacterQ[string_String]:=StringPosition[string,$DaggerCharacter]=!={};
HasDaggerCharacterQ[x_]:=Throw@Message[Validate::nouse,"HasDaggerCharacterQ",x];
SetNumberOfArguments[HasDaggerCharacterQ,1];
Protect[HasDaggerCharacterQ];

2) An additional problem is that we could have an index with a dollar.We shall follow the convention that the dollar always comes after the dagger (this is to avoid modifying the dollar functions). This function is needed as it is because sometimes we construct the dagger-index of a dollar index

?MakeDaggerSymbol

MakeDaggerSymbol[symbol_Symbol]:=ToExpression[StringJoin[Characters[ToString[symbol]]/.With[{dg=$DaggerCharacter},{{i__,dg,j___}->{i,j},{i__,"$",j___}->{i,dg,"$",j},{i__}->{i,dg}}]]];
MakeDaggerSymbol[x_]:=Throw@Message[Validate::nouse,"MakeDaggerSymbol",x];
SetNumberOfArguments[MakeDaggerSymbol,1];
Protect[MakeDaggerSymbol];

Examples of pairs:
	A	A†
	A$1	A†$1

4. End package

4.1. End

$Context

End[]

$Context

EndPackage[]

$Context

4.2. Statistics

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

{MaxMemoryUsed[],MemoryInUse[]}/1000/1024.

There are now (version 0.6.9) 65 registered symbols. Many of them are not really used in other packages.

?xAct`xCore`*