TensorBases.m

(* ::Package:: *)

(************************************************************************)
(* This file was generated automatically by the Mathematica front end.  *)
(* It contains Initialization cells from a Notebook file, which         *)
(* typically will have the same name as this file except ending in      *)
(* ".nb" instead of ".m".                                               *)
(*                                                                      *)
(* This file is intended to be loaded into the Mathematica kernel using *)
(* the package loading commands Get or Needs.  Doing so is equivalent   *)
(* to using the Evaluate Initialization Cells menu command in the front *)
(* end.                                                                 *)
(*                                                                      *)
(* DO NOT EDIT THIS FILE.  This entire file is regenerated              *)
(* automatically each time the parent Notebook file is saved in the     *)
(* Mathematica front end.  Any changes you make to this file will be    *)
(* overwritten.                                                         *)
(************************************************************************)



If["AllowInternetUse" /. SystemInformation["Network"],
Module[{TBCurPacletAddr,TBCurPaclet,TBCurVersion,
TBInstalledPaclet,TBInstalledVersion},

TBCurPacletAddr="https://github.com/satfra/TensorBases/raw/refs/heads/main/PacletInfo.m";
TBCurPaclet=(List@@Import[TBCurPacletAddr])[[1]];
TBCurVersion=TBCurPaclet["Version"];

TBInstalledPaclet=(List@@Import[FileNameJoin[{$UserBaseDirectory,"Applications","TensorBases","PacletInfo.m"}]])[[1]];
TBInstalledVersion=TBInstalledPaclet["Version"];

If[TBCurVersion=!=TBInstalledVersion,
If[ChoiceDialog[
TemplateApply["There is a newer TensorBases version on the internet. 
The installed version is `a`, whereas `b` is available. Do you want to install it?",<|"a"->TBInstalledVersion,"b"->TBCurVersion|>]
,WindowTitle->"Update TensorBases",WindowSize->{Medium,All}],
Import["https://raw.githubusercontent.com/satfra/TensorBases/main/TensorBasesInstaller.m"];
Echo["Please restart your Kernel."];Exit[],
Print["Consider updating the TensorBases package for bugfixes and new features!"];
];
];
];
];


Print["Mathematica package \!\(\*
StyleBox[\"TensorBases\",\nFontWeight->\"Bold\"]\)\!\(\*
StyleBox[\" \",\nFontWeight->\"Bold\"]\)loaded
\!\(\*
StyleBox[\"Authors\",\nFontWeight->\"Bold\"]\): Andreas Gei\[SZ]el, Franz Richard Sattler
\!\(\*
StyleBox[\"Version\",\nFontWeight->\"Bold\"]\): 1.0
\!\(\*
StyleBox[\"Year\",\nFontWeight->\"Bold\"]\): 2025

For a list of available bases, call \!\(\*
StyleBox[\"TBInfo\",\nFontColor->RGBColor[1, 0.5, 0]]\)[]. For further information on a particular basis, call \!\(\*
StyleBox[\"TBInfo\",\nFontColor->RGBColor[1, 0.5, 0]]\)[\"\!\(\*
StyleBox[\"BasisName\",\nFontColor->GrayLevel[0.5]]\)\"].

This package provides the methods \!\(\*
StyleBox[\"TBGetBasisElement\",\nFontColor->RGBColor[1, 0.5, 0]]\), \!\(\*
StyleBox[\"TBGetInnerProduct\",\nFontColor->RGBColor[1, 0.5, 0]]\), \!\(\*
StyleBox[\"TBGetMetric\",\nFontColor->RGBColor[1, 0.5, 0]]\), \!\(\*
StyleBox[\"TBGetInverseMetric\",\nFontColor->RGBColor[1, 0.5, 0]]\), \!\(\*
StyleBox[\"TBGetProjector\",\nFontColor->RGBColor[1, 0.5, 0]]\) for every tensor basis available.
For closer explanations, please call their usage messages, e.g. \!\(\*
StyleBox[\"TBGetProjector\",\nFontColor->RGBColor[1, 0.5, 0]]\)::\!\(\*
StyleBox[\"usage\",\nFontColor->RGBColor[0, 0, 1]]\).

Other useful tools include \!\(\*
StyleBox[\"TBBasisTransformation\",\nFontColor->RGBColor[1, 0.5, 0]]\), \!\(\*
StyleBox[\"TBVertexTransformation\",\nFontColor->RGBColor[1, 0.5, 0]]\), \!\(\*
StyleBox[\"TBGetIdentityMatrix\",\nFontColor->RGBColor[1, 0.5, 0]]\), \!\(\*
StyleBox[\"TBGetBasisSize\",\nFontColor->RGBColor[1, 0.5, 0]]\),\!\(\*
StyleBox[\" \",\nFontColor->RGBColor[1, 0.5, 0]]\)\!\(\*
StyleBox[\"TBGetIndexSet\",\nFontColor->RGBColor[1, 0.5, 0]]\),\!\(\*
StyleBox[\" \",\nFontColor->RGBColor[1, 0.5, 0]]\)\!\(\*
StyleBox[\"TBMakePropagator\",\nFontColor->RGBColor[1, 0.5, 0]]\).

To build or manipulate bases, please call \!\(\*
StyleBox[\"TBInfo\",\nFontColor->RGBColor[1, 0.5, 0]]\)[\"BaseBuilder\"].

To show information on the used notation, call \!\(\*
StyleBox[\"TBInfo\",\nFontColor->RGBColor[1, 0.5, 0]]\)[\"Notation\"].
"]


FormTracerLoaded[]:=(Length[Select[$Packages,#=="FormTracer`"&]]>0);
FormTracerInstalled[]:=Module[{FTDirectory},
FTDirectory=SelectFirst[
Join[
{
FileNameJoin[{$UserBaseDirectory,"Applications","FormTracer"}],
FileNameJoin[{$BaseDirectory,"Applications","FormTracer"}],
FileNameJoin[{$InstallationDirectory,"AddOns","Applications","FormTracer"}],
FileNameJoin[{$InstallationDirectory,"AddOns","Packages","FormTracer"}],
FileNameJoin[{$InstallationDirectory,"AddOns","ExtraPackages","FormTracer"}]
},
Select[$Path,StringContainsQ[#,"FormTracer"]&]
],
DirectoryQ[#]&
]<>"/"//Quiet;
If[Head[FTDirectory]=!=String,Return[False]];
Return[True];
];

If[Not@FormTracerInstalled[],
If[ChoiceDialog["FormTracer does not seem to be installed. Do you want to install it?",WindowTitle->"Install FormTracer",WindowSize->{Medium,All}],
Import["https://raw.githubusercontent.com/FormTracer/FormTracer/master/src/FormTracerInstaller.m"],
Print["The \!\(\*
StyleBox[\"TensorBases\",\nFontWeight->\"Bold\"]\) package requires \!\(\*
StyleBox[\"FormTracer\",\nFontWeight->\"Bold\"]\) to run."];Abort[];
];
];

If[Not@FormTracerLoaded[],
Block[{Print},Get["FormTracer`"]];
If[FormTracerLoaded[],
Print["\!\(\*
StyleBox[\"FormTracer\",\nFontWeight->\"Bold\"]\) package loaded. "];,
Print["Error: Could not load \!\(\*
StyleBox[\"FormTracer\",\nFontWeight->\"Bold\"]\)\!\(\*
StyleBox[\" \",\nFontWeight->\"Bold\"]\)package."];Abort[];
],
Print["\!\(\*
StyleBox[\"FormTracer\",\nFontWeight->\"Bold\"]\) package already loaded. "];
Print["Clearing all extra variables for compatibility!\n"];
FormTracer`DefineExtraVars[];
];

Block[{Print},FiniteT[True];]
Block[{Print},FastGamma5Trace[True];]

If[Head[$DistributedContexts]=!=List,$DistributedContexts={}];
$DistributedContexts=$DistributedContexts\[Union]{$Context,"TensorBases`Private`","TensorBases`","FormTracer`","FormTracer`Private`"}


Print["To see all (user-defined and package-defined) FormTracer definitions, call \!\(\*
StyleBox[\"TBInfo\",\nFontColor->RGBColor[1, 0.5, 0]]\)[\"FormTracer\"].
Furthermore, \!\(\*
StyleBox[\"TensorBases\",\nFontWeight->\"Bold\"]\)\!\(\*
StyleBox[\" \",\nFontWeight->\"Bold\"]\)extends \!\(\*
StyleBox[\"FormTracer\",\nFontWeight->\"Bold\"]\). To see all extensions, call \!\(\*
StyleBox[\"TBInfo\",\nFontColor->RGBColor[1, 0.5, 0]]\)[\"Extensions\"]"];


Print["\nTo see all momentum transformations that can be performed by \!\(\*
StyleBox[\"TensorBases\",\nFontWeight->\"Bold\"]\), call \!\(\*
StyleBox[\"TBInfo\",\nFontColor->RGBColor[1, 0.5, 0]]\)[\"Momenta\"].\n"];


GetFormTracerGroups::usage="GetFormTracerGroups[]";
FormTracerGroupExistsQ::usage="GetFormTracerGroupList[name_Symbol]";
GetFormTracerGroupList::usage="GetFormTracerGroupList[name_Symbol]";
AddGroupTensors::usage="AddGroupTensors[groupDef_List]";
GetFormTracerGroupConstants::usage="GetFormTracerGroupConstants[]";
GetFormTracerGroupConstant::usage="GetFormTracerGroupConstant[name_Symbol]";
AddFormTracerGroup::usage="AddFormTracerGroup[{ingroupName_Symbol,inkind_Symbol,inconstant_}]";
UseLorentzLinearitySP::usage="";
UseLorentzLinearityVec::usage="";
UseLorentzLinearity::usage="";
TBInsertCombinedLorentzTensors::usage="";


ShowFormTracerExtensions[]:=Module[{},
Print["\!\(\*
StyleBox[\"TensorBases\",\nFontWeight->\"Bold\"]\) defines the following functions in extension to \!\(\*
StyleBox[\"FormTracer\",\nFontWeight->\"Bold\"]\) functionality.
In order to get detailed information on each of those, please call their usage messages, e.g. \!\(\*
StyleBox[\"GetFormTracerGroups\",\nFontColor->RGBColor[1, 0.5, 0]]\)::\!\(\*
StyleBox[\"usage\",\nFontColor->RGBColor[0, 0, 1]]\).

\!\(\*
StyleBox[\"GetFormTracerGroups\",\nFontColor->RGBColor[1, 0.5, 0]]\),
\!\(\*
StyleBox[\"FormTracerGroupExists\",\nFontColor->RGBColor[1, 0.5, 0]]\),
\!\(\*
StyleBox[\"GetFormTracerGroupList\",\nFontColor->RGBColor[1, 0.5, 0]]\),
\!\(\*
StyleBox[\"AddGroupTensors\",\nFontColor->RGBColor[1, 0.5, 0]]\),
\!\(\*
StyleBox[\"AddFormTracerGroup\",\nFontColor->RGBColor[1, 0.5, 0]]\),
\!\(\*
StyleBox[\"GetFormTracerGroupConstants\",\nFontColor->RGBColor[1, 0.5, 0]]\),
\!\(\*
StyleBox[\"GetFormTracerGroupConstant\",\nFontColor->RGBColor[1, 0.5, 0]]\),
\!\(\*
StyleBox[\"UseLorentzLinearitySP\",\nFontColor->RGBColor[1, 0.5, 0]]\),
\!\(\*
StyleBox[\"UseLorentzLinearityVec\",\nFontColor->RGBColor[1, 0.5, 0]]\),
\!\(\*
StyleBox[\"UseLorentzLinearity\",\nFontColor->RGBColor[1, 0.5, 0]]\),
\!\(\*
StyleBox[\"TBInsertCombinedLorentzTensors\",\nFontColor->RGBColor[1, 0.5, 0]]\)"];
];


GetFormTracerGroups[]:=FormTracer`Private`groupNames;
FormTracerGroupExistsQ[name_Symbol]:=Module[{},
If[Not@MemberQ[GetFormTracerGroups[],name],
Return[False];,
Return[True];
];
];
GetFormTracerGroupTypes[]:=FormTracer`Private`groupTypes;
GetFormTracerGroupNamesAndTypes[]:=Transpose[{FormTracer`Private`groupNames,FormTracer`Private`groupTypes}]

GetFormTracerGroupList[name_Symbol]:=Module[{idx,type,constant,mRules,funcs},
If[Not@FormTracerGroupExistsQ[name],
Print["Logic error: "~~ToString[name]~~" is not an already defined group"];
Abort[];
];
idx=Flatten[Position[FormTracer`Private`groupNames,name]][[1]];
type=FormTracer`Private`groupTypes[[idx]];
constant=FormTracer`Private`groupConstantsTable[[idx]][[1]];
mRules=Select[Normal[FormTracer`Private`groupTensorReplacementRulesOutput],MemberQ[#,name,Infinity]&];
funcs=mRules//.(a_:>b_):>b//.a_[b___,FormTracer`Private`a$]->a[b,i,j,k];

Join[{type, {name, constant}},funcs]
];
AddGroupTensors[groupDef_List]:=Module[{alreadyPresent},
alreadyPresent=Map[GetFormTracerGroupList,FormTracer`Private`groupNames];
DefineGroupTensors[Join[
alreadyPresent,
{groupDef}
]]
]


RemoveGroupTensor[name_]:=Module[{alreadyPresent,obj},
alreadyPresent=Map[GetFormTracerGroupList,FormTracer`Private`groupNames];
obj=Select[alreadyPresent,MemberQ[#,name,Infinity]&];
If[Length[obj]===0,Print["No group called "<>ToString[name]<>" present!"];Abort[]];
DefineGroupTensors[
DeleteCases[alreadyPresent,obj[[1]]]
]
];


SetNf[3]:=Module[{},
RemoveGroupTensor[flavor];

Unprotect[Nf];
ClearAll[Nf];
Nf=3;
Protect[Nf];

AddGroupTensors[{FormTracer`SU3fundexplicit, {flavor,3}, deltaAdjFlav[a, b], FFlav[a, b, c], deltaFundFlav[a, b], TFlav[a, b, c], epsAdjFlav[a, b, c],epsFundFlav[a, b, c]}];
]
SetNf[2]:=Module[{},
RemoveGroupTensor[flavor];

Unprotect[Nf];
ClearAll[Nf];
Nf=2;
Protect[Nf];

AddGroupTensors[{FormTracer`SU2fundexplicit, {flavor,2}, deltaAdjFlav[a, b], FFlav[a, b, c], deltaFundFlav[a, b], TFlav[a, b, c], epsAdjFlav[a, b, c],epsFundFlav[a, b, c]}];
]
SetNf[]:=Module[{},
RemoveGroupTensor[flavor];

Unprotect[Nf];
ClearAll[Nf];
AddFormTracerGroup[{flavor,SUNfund,Nf}];
]
SetNf[i_]:=Print["Can only set flavor group number to 2 or 3; to set it to Nf, use SetNf[]"]


SetNc[3]:=Module[{},
RemoveGroupTensor[color];

Unprotect[Nc];
ClearAll[Nc];
Nc=3;
Protect[Nc];

AddGroupTensors[{FormTracer`SU3fundexplicit, {color,3}, deltaAdjCol[a, b], FCol[a, b, c], deltaFundCol[a, b], TCol[a, b, c],epsAdjCol[a, b, c], epsFundCol[a, b, c]}];
]
SetNc[2]:=Module[{},
RemoveGroupTensor[color];

Unprotect[Nc];
ClearAll[Nc];
Nc=2;
Protect[Nc];

AddGroupTensors[{FormTracer`SU2fundexplicit, {color,2}, deltaAdjCol[a, b], FCol[a, b, c], deltaFundCol[a, b], TCol[a, b, c],epsAdjCol[a, b, c], epsFundCol[a, b, c]}];
]
SetNc[]:=Module[{},
RemoveGroupTensor[color];

Unprotect[Nc];
ClearAll[Nc];
Protect[Nc];

AddFormTracerGroup[{color,SUNfund,Nc}];
]
SetNc[i_]:=Print["Can only set color group number to 2 or 3; to set it to Nc, use SetNc[]"]


GetFormTracerGroupConstants[]:=Module[{},
Return[FormTracer`Private`groupConstantsTable[[All,1]]];
];
GetFormTracerGroupConstant[name_Symbol]:=Module[{idx},
idx=Position[GetFormTracerGroups[],name][[1,1]];
Return[GetFormTracerGroupConstants[][[idx]]]
]


MakeConstant[name_Symbol]:=Module[{stripped},
Return[Symbol[SymbolName[name]]];
]
MakeConstant[number_Integer]:=number;


AddFormTracerGroup[{ingroupName_Symbol,inkind_Symbol,inconstant_}]:=Module[
{
groupName,kind,constant,args,
a,b,c
},

groupName=Symbol[SymbolName[ingroupName]];
kind=Symbol["FormTracer`"~~SymbolName[inkind]];
constant=Evaluate[Global`MakeConstant[inconstant]];

If[groupName===color,
Unprotect[color,Nc];
If[Not@FormTracerGroupExistsQ[color],
ClearAll[color];
Print["\!\(\*
StyleBox[\"Group\",\nFontSize->10]\)\!\(\*
StyleBox[\" \",\nFontSize->10]\)\!\(\*
StyleBox[\"with\",\nFontSize->10]\)\!\(\*
StyleBox[\" \",\nFontSize->10]\)\!\(\*
StyleBox[\"name\",\nFontSize->10]\)\!\(\*
StyleBox[\" \",\nFontSize->10]\)\!\(\*
StyleBox[\"color\",\nFontSize->10,\nFontColor->RGBColor[0.5, 0, 0.5]]\)\!\(\*
StyleBox[\" \",\nFontSize->10]\)\!\(\*
StyleBox[\"undefined\",\nFontSize->10]\)\!\(\*
StyleBox[\",\",\nFontSize->10]\)\!\(\*
StyleBox[\" \",\nFontSize->10]\)\!\(\*
StyleBox[\"using\",\nFontSize->10]\)\!\(\*
StyleBox[\" \",\nFontSize->10]\)\!\(\*
StyleBox[\"default\",\nFontSize->10]\)\!\(\*
StyleBox[\" \",\nFontSize->10]\)\!\(\*
StyleBox[\"names\",\nFontSize->10]\)\!\(\*
StyleBox[\".\",\nFontSize->10]\)"];
If[IntegerQ[Nc]&&2<=Nc<=3,Print["Nc is set to ", Nc],
ClearAll[Nc]];
AddGroupTensors[{FormTracer`SUNfund, {color,Global`Nc}, deltaAdjCol[a, b], FCol[a, b, c], deltaFundCol[a, b], TCol[a, b, c],epsAdjCol[a, b, c], epsFundCol[a, b, c]}];
];
Protect[color,Nc];
Return[];
];

If[groupName===flavor,
Unprotect[flavor,Nf];
If[Not@FormTracerGroupExistsQ[flavor],
ClearAll[flavor];
Print["\!\(\*
StyleBox[\"Group\",\nFontSize->10]\)\!\(\*
StyleBox[\" \",\nFontSize->10]\)\!\(\*
StyleBox[\"with\",\nFontSize->10]\)\!\(\*
StyleBox[\" \",\nFontSize->10]\)\!\(\*
StyleBox[\"name\",\nFontSize->10]\)\!\(\*
StyleBox[\" \",\nFontSize->10]\)\!\(\*
StyleBox[\"flavor\",\nFontSize->10,\nFontColor->RGBColor[0.5, 0, 0.5]]\)\!\(\*
StyleBox[\" \",\nFontSize->10]\)\!\(\*
StyleBox[\"undefined\",\nFontSize->10]\)\!\(\*
StyleBox[\",\",\nFontSize->10]\)\!\(\*
StyleBox[\" \",\nFontSize->10]\)\!\(\*
StyleBox[\"using\",\nFontSize->10]\)\!\(\*
StyleBox[\" \",\nFontSize->10]\)\!\(\*
StyleBox[\"default\",\nFontSize->10]\)\!\(\*
StyleBox[\" \",\nFontSize->10]\)\!\(\*
StyleBox[\"names\",\nFontSize->10]\)\!\(\*
StyleBox[\".\",\nFontSize->10]\)"];
If[IntegerQ[Nf]&&2<=Nf<=3,Print["Nc is set to ", Nc],
ClearAll[Nf]];
AddGroupTensors[{FormTracer`SUNfund, {flavor,Global`Nf}, deltaAdjFlav[a, b], FFlav[a, b, c], deltaFundFlav[a, b], TFlav[a, b, c], epsAdjFlav[a, b, c],epsFundFlav[a, b, c]}];
];
Protect[flavor,Nf];
Return[];
];

Unprotect[Evaluate[groupName]];
If[Not@FormTracerGroupExistsQ[groupName],
ClearAll[Evaluate[groupName]];
Print["\!\(\*
StyleBox[\"Group\",\nFontSize->10]\)\!\(\*
StyleBox[\" \",\nFontSize->10]\)\!\(\*
StyleBox[\"with\",\nFontSize->10]\)\!\(\*
StyleBox[\" \",\nFontSize->10]\)\!\(\*
StyleBox[\"name\",\nFontSize->10]\)\!\(\*
StyleBox[\" \",\nFontSize->10]\)"~~ToString[Style[ToString[groupName],Purple]]~~"\!\(\*
StyleBox[\" \",\nFontSize->10]\)\!\(\*
StyleBox[\"undefined\",\nFontSize->10]\)\!\(\*
StyleBox[\",\",\nFontSize->10]\)\!\(\*
StyleBox[\" \",\nFontSize->10]\)\!\(\*
StyleBox[\"using\",\nFontSize->10]\)\!\(\*
StyleBox[\" \",\nFontSize->10]\)\!\(\*
StyleBox[\"default\",\nFontSize->10]\)\!\(\*
StyleBox[\" \",\nFontSize->10]\)\!\(\*
StyleBox[\"names\",\nFontSize->10]\)\!\(\*
StyleBox[\".\",\nFontSize->10]\)"];
If[IntegerQ[constant]&&2<=constant<=3,Print["Group constant is set to ", constant],
Unprotect[Evaluate[constant]];ClearAll[Evaluate[constant]]];
args={kind, {groupName,constant}, deltaAdj[groupName,a, b], F[groupName,a, b, c], deltaFund[groupName,a, b], T[groupName,a, b, c],epsAdj[groupName,a, b, c], epsFund[groupName,a, b, c]};
AddGroupTensors@args;
];
If[Not@IntegerQ[constant],Protect[constant]];
Protect[Evaluate[groupName]];
];


If[Length[Normal[FormTracer`Private`lorentzTensorReplacementRulesInput]]==0,
Print["\!\(\*
StyleBox[\"Lorentz\",\nFontSize->10,\nFontColor->RGBColor[0.5, 0, 0.5]]\)\!\(\*
StyleBox[\" \",\nFontSize->10]\)\!\(\*
StyleBox[\"group\",\nFontSize->10]\)\!\(\*
StyleBox[\" \",\nFontSize->10]\)\!\(\*
StyleBox[\"undefined\",\nFontSize->10]\)\!\(\*
StyleBox[\",\",\nFontSize->10]\)\!\(\*
StyleBox[\" \",\nFontSize->10]\)\!\(\*
StyleBox[\"using\",\nFontSize->10]\)\!\(\*
StyleBox[\" \",\nFontSize->10]\)\!\(\*
StyleBox[\"default\",\nFontSize->10]\)\!\(\*
StyleBox[\" \",\nFontSize->10]\)\!\(\*
StyleBox[\"names\",\nFontSize->10]\)\!\(\*
StyleBox[\".\",\nFontSize->10]\)"];
DefineLorentzTensors[deltaLorentz[mu, nu], vec[p, mu], sp[p, q], epsLorentz[i, j, k], deltaDirac[i, j], gamma[mu, i, j], gamma5[i, j], vecs[p, mu], sps[p, q]];
];


TBInsertOutputNaming[expr_]:=Module[
{outputRulesLorentzTensors,outputRulesGroupTensors,outputRules},

outputRulesLorentzTensors=Normal[FormTracer`Private`lorentzTensorReplacementRulesOutput]/.{(a_[c___]:>b_):>(Symbol["Global`TB"~~StringSplit[ToString[a],"FTx"][[-1]]][c]:>b)};
outputRulesGroupTensors=Normal[FormTracer`Private`groupTensorReplacementRulesOutput]/.{(a_[c___]:>b_):>(Symbol["Global`TB"~~StringSplit[ToString[a],"FTx"][[-1]]][c]:>b)};
outputRules=Join[outputRulesLorentzTensors,outputRulesGroupTensors];

Return[expr//.outputRules];
];


TBInsertLorentzNames[expr_]:=Module[
{outputNameRulesLorentzTensors},
outputNameRulesLorentzTensors=Normal[FormTracer`Private`lorentzTensorReplacementRulesOutput]/.{(a_[c___]:>b_[d___]):>(Symbol["Global`TB"~~StringSplit[ToString[a],"FTx"][[-1]]]:>b)};
Return[Evaluate[expr//.outputNameRulesLorentzTensors]];
]


Unprotect[UseLorentzLinearity,UseLorentzLinearitySP,UseLorentzLinearityVec];


UseLorentzLinearitySP[expr_]:=Module[{eval,conv=TBInsertLorentzNames},
SetAttributes[Evaluate[conv[TBsps]],Orderless];
SetAttributes[Evaluate[conv[TBsp]],Orderless];

conv[TBsp][0,a_]=0;
conv[TBsp][a_,0]=0;
conv[TBsp][0,0]=0;

conv[TBsps][0,a_]=0;
conv[TBsps][a_,0]=0;
conv[TBsps][0,0]=0;

conv[TBsp][a_,b_+c_]:= conv[TBsp][a,b]+conv[TBsp][a,c];
conv[TBsp][a_,-1b_]:= -conv[TBsp][a,b];
conv[TBsp][b_,a_?NumericQ c_]:= a conv[TBsp][b,c];

conv[TBsps][a_,b_+c_]:= conv[TBsps][a,b]+conv[TBsps][a,c];
conv[TBsps][a_,-1b_]:= -conv[TBsps][a,b];
conv[TBsps][b_,a_?NumericQ c_]:= a conv[TBsps][b,c];

eval=Evaluate[expr];
ClearAll[
Evaluate[conv[TBsps]],
Evaluate[conv[TBsp]]
];
Return[eval];
];


UseLorentzLinearityVec[expr_]:=Module[{eval,conv=TBInsertLorentzNames},
conv[TBvec][0,mu_]=0;

conv[TBvecs][0,mu_]=0;
conv[TBvecs][p_,0]=0;

conv[TBvec][p_+q_,mu_]:=conv[TBvec][p,mu]+conv[TBvec][q,mu];
conv[TBvec][-1 p_,mu_]:= -conv[TBvec][p,mu];
conv[TBvec][n_?NumericQ a_,mu_]:=n conv[TBvec][a,mu];

conv[TBvecs][p_+q_,mu_]:=conv[TBvecs][p,mu]+conv[TBvecs][q,mu];
conv[TBvecs][-1 p_,mu_]:= -conv[TBvecs][p,mu];
conv[TBvecs][n_?NumericQ a_,mu_]:=n conv[TBvecs][a,mu];

eval=Evaluate[expr];
ClearAll[
Evaluate[conv[TBvec]],
Evaluate[conv[TBvecs]]
];
Return[eval];
];


UseLorentzLinearity[expr_]:=UseLorentzLinearitySP[UseLorentzLinearityVec[expr]];

Protect[UseLorentzLinearity,UseLorentzLinearitySP,UseLorentzLinearityVec];


Unprotect[sigma,pdash,psdash];

sigma[v1_,v2_,d1_,d2_]:=Module[{dint1,dint2},TBInsertOutputNaming[I/2 (TBgamma[v1,d1,dint1]TBgamma[v2,dint1,d2]-TBgamma[v2,d1,dint2]TBgamma[v1,dint2,d2])]];pdash[p_,i_,j_]:=Module[{mu},TBInsertOutputNaming[TBgamma[mu,i,j]TBvec[p,mu]]];
psdash[p_,i_,j_]:=Module[{mu},TBInsertOutputNaming[TBgamma[mu,i,j]TBvecs[p,mu]]];

Protect[sigma,pdash,psdash];


TensorBases`Private`LTCache=
FormTracer`Private`combinedLorentzTensorInputCache;
removeObj[expr_]:=Module[{pos},
pos=FirstPosition[TensorBases`Private`LTCache,expr][[1]];
If[IntegerQ[pos],
TensorBases`Private`LTCache=Delete[TensorBases`Private`LTCache,pos]
];
];
removeObj/@{transProj[_,_,_],transProj[_,_,_,_],longProj[_,_,_],transProjMagnetic[_,_,_],transProjElectric[_,_,_]};
ClearAll[removeObj];


DefineCombinedLorentzTensors[
TBInsertOutputNaming[Union[
TensorBases`Private`LTCache,
{
(*zero temperature*)
{
transProj[p,mu,nu],
TBdeltaLorentz[mu,nu]-TBvec[p,mu]TBvec[p,nu]/TBsp[p,p]
},
{
transProj[p,q,mu,nu],
TBdeltaLorentz[mu,nu]-TBvec[p,mu]TBvec[q,nu]/TBsp[p,q]
},
{
longProj[p,mu,nu],
TBvec[p,mu]TBvec[p,nu]/TBsp[p,p]
},
(*finite temperature*)
{
transProjMagnetic[p,mu,nu],
TBdeltaLorentz[mu,nu]-(TBvecs[p,mu]TBvecs[p,nu])/TBsps[p,p]-TBdeltaLorentz[mu,0]*TBdeltaLorentz[nu,0]
},
{
transProjElectric[p,mu,nu],
TBdeltaLorentz[mu,0] TBdeltaLorentz[nu,0]-(TBvec[p,mu] TBvec[p,nu])/TBsp[p,p]+(TBvecs[p,mu] TBvecs[p,nu])/TBsps[p,p]
}
}
]]
];


TensorBases`Private`LTCache=
FormTracer`Private`lorentzTensorIdentitiesInputCache;
removeObj[expr_]:=Module[{pos},
pos=FirstPosition[TensorBases`Private`LTCache,expr][[1]];
If[IntegerQ[pos],
TensorBases`Private`LTCache=Delete[TensorBases`Private`LTCache,pos]
];
];
removeObj/@{transProj[_,_,_],transProj[_,_,_,_],longProj[_,_,_],transProjMagnetic[_,_,_],transProjElectric[_,_,_]};
ClearAll[removeObj];


DefineLorentzTensorIdentities[Union[TensorBases`Private`LTCache,{
(*zero temperature*)
{transProj[p,mu,rho]transProj[p,rho,nu],transProj[p,mu,nu]},
{transProj[p,mu,rho]transProj[p,nu,rho],transProj[p,mu,nu]},
{transProj[p,rho,mu]transProj[p,rho,nu],transProj[p,mu,nu]},

{longProj[p,mu,rho]longProj[p,rho,nu],longProj[p,mu,nu]},
{longProj[p,mu,rho]longProj[p,nu,rho],longProj[p,mu,nu]},
{longProj[p,rho,mu]longProj[p,rho,nu],longProj[p,mu,nu]},

{transProj[p,mu,rho]longProj[p,rho,nu],0},
{transProj[p,rho,mu]longProj[p,rho,nu],0},
{transProj[p,mu,rho]longProj[p,nu,rho],0},

(*finite temperature*)
{transProjMagnetic[p,mu,rho]transProjMagnetic[p,rho,nu],transProjMagnetic[p,mu,nu]},
{transProjMagnetic[p,mu,rho]transProjMagnetic[p,nu,rho],transProjMagnetic[p,mu,nu]},
{transProjMagnetic[p,rho,mu]transProjMagnetic[p,rho,nu],transProjMagnetic[p,mu,nu]},

{transProjElectric[p,mu,rho]transProjElectric[p,rho,nu],transProjElectric[p,mu,nu]},
{transProjElectric[p,mu,rho]transProjElectric[p,nu,rho],transProjElectric[p,mu,nu]},
{transProjElectric[p,rho,mu]transProjElectric[p,rho,nu],transProjElectric[p,mu,nu]},

{transProjMagnetic[p,mu,rho]transProjElectric[p,rho,nu],0},
{transProjMagnetic[p,mu,rho]transProjElectric[p,nu,rho],0},
{transProjMagnetic[p,rho,mu]transProjElectric[p,rho,nu],0},

{transProjMagnetic[p,mu,rho]longProj[p,rho,nu],0},
{transProjMagnetic[p,mu,rho]longProj[p,nu,rho],0},
{transProjMagnetic[p,rho,mu]longProj[p,rho,nu],0},

{transProjElectric[p,mu,rho]longProj[p,rho,nu],0},
{transProjElectric[p,mu,rho]longProj[p,nu,rho],0},
{transProjElectric[p,rho,mu]longProj[p,rho,nu],0}
}]
];


TBReplacementsLorentzTensors=Flatten[{
(*zero temperature*)
{transProj[p_,mu_,rho_]transProj[p_,rho_,nu_]:>transProj[p,mu,nu]},
{transProj[p_,mu_,rho_]transProj[p_,nu_,rho_]:>transProj[p,mu,nu]},
{transProj[p_,rho_,mu_]transProj[p_,rho_,nu_]:>transProj[p,mu,nu]},

{longProj[p_,mu_,rho_]longProj[p_,rho_,nu_]:>longProj[p,mu,nu]},
{longProj[p_,mu_,rho_]longProj[p_,nu_,rho_]:>longProj[p,mu,nu]},
{longProj[p_,rho_,mu_]longProj[p_,rho_,nu_]:>longProj[p,mu,nu]},

{transProj[p_,mu_,rho_]longProj[p_,rho_,nu_]:>0},
{transProj[p_,rho_,mu_]longProj[p_,rho_,nu_]:>0},
{transProj[p_,mu_,rho_]longProj[p_,nu_,rho_]:>0}
}];
TBCombinedLorentzTensorsList={
transProj[p_,mu_,nu_]:>TBInsertOutputNaming[TBdeltaLorentz[mu,nu]-TBvec[p,mu]TBvec[p,nu]/TBsp[p,p]],
transProj[p_,q_,mu_,nu_]:>TBInsertOutputNaming[TBdeltaLorentz[mu,nu]-TBvec[p,mu]TBvec[q,nu]/TBsp[p,q]],
longProj[p_,mu_,nu_]:>TBInsertOutputNaming[TBvec[p,mu]TBvec[p,nu]/TBsp[p,p]],
(*finite temperature*)
transProjMagnetic[p_,mu_,nu_]:>TBInsertOutputNaming[TBdeltaLorentz[mu,nu]-(TBvecs[p,mu]TBvecs[p,nu])/TBsps[p,p]-TBdeltaLorentz[mu,0]*TBdeltaLorentz[nu,0]],
transProjElectric[p_,mu_,nu_]:>TBInsertOutputNaming[TBdeltaLorentz[mu,0] TBdeltaLorentz[nu,0]-(TBvec[p,mu] TBvec[p,nu])/TBsp[p,p]+(TBvecs[p,mu] TBvecs[p,nu])/TBsps[p,p]]
};
TBInsertCombinedLorentzTensors[expr_]:=expr//.TBReplacementsLorentzTensors//.TBCombinedLorentzTensorsList;


ShowFormTracerDefinitions[]:=Module[{els},
Print["FormTracer Names:          ",TableForm[Join[
{
{"\!\(\*SubscriptBox[\(\[Delta]\), \(ij\)]\) in Lorentz group",TBdeltaLorentz[i,j]},
{"\!\(\*SubscriptBox[\(p\), \(\[Mu]\)]\) Lorentz vector",TBvec[p,\[Mu]]},
{"\!\(\*SubscriptBox[\(p\), \(i\)]\) spatial Lorentz vector",TBvecs[p,i]},
{"\!\(\*SubscriptBox[\(p\), \(\[Mu]\)]\)\!\(\*SubscriptBox[\(q\), \(\[Mu]\)]\) scalar product",TBsp[p,q]},
{"\!\(\*SubscriptBox[\(p\), \(i\)]\)\!\(\*SubscriptBox[\(q\), \(i\)]\) spatial calar product ",TBsps[p,q]},
{"",""},

{"\!\(\*SubscriptBox[\(\[Delta]\), \(ij\)]\) in Spinor group",TBdeltaDirac[i,j]},
{"\!\(\*SubscriptBox[\(\[Gamma]\), \(\[Mu]\)]\)",TBgamma[\[Mu],d1,d2]},
{"\!\(\*SubscriptBox[\(\[Gamma]\), \(5\)]\)",TBgamma5[d1,d2]},
{"\!\(\*SubscriptBox[\(\[Epsilon]\), \(\[Mu]\[Nu]\[Rho]\)]\)",TBepsLorentz[\[Mu],\[Nu],\[Rho]]},
{"",""}
},
Flatten[Map[{
{"adjoint \!\(\*SubscriptBox[\(\[Delta]\), \(ab\)]\)",TBdeltaAdj[#,a,b]},
{"fundamental \!\(\*SubscriptBox[\(\[Delta]\), \(AB\)]\)",TBdeltaFund[#,A,B]},
{"\!\(\*FractionBox[SubscriptBox[\(f\), \(abc\)], \(2\)]\)",TBF[#,a, b, c]},
{"(\!\(\*SubscriptBox[\(t\), \(a\)]\)\!\(\*SubscriptBox[\()\), \(BC\)]\)",TBT[#,a, B, C]},
{"\!\(\*SubscriptBox[\(\[Epsilon]\), \(abc\)]\)",TBepsAdj[#,a, b, c]},
{"\!\(\*SubscriptBox[\(\[Epsilon]\), \(ABC\)]\)",TBepsFund[#,A, B, C]},
{"group constant",GetFormTracerGroupConstant[#]},
{"",""}}&,GetFormTracerGroups[]],1]
]//TBInsertOutputNaming
,TableHeadings->{Join[
{"Lorentz","","","","","",
"spinor","","","",""},
Flatten[Map[{#,"","","","","","",""}&,
Map[ToString[#[[1]]]<>"("<>ToString[#[[2]]]<>")"&,GetFormTracerGroupNamesAndTypes[]]
],1]
]
, {"object","name"}},TableSpacing->{3, 3}]];

els=Transpose[{
TBCombinedLorentzTensorsList//.(a_[b___]:>f_):>a@@ToExpression[StringReplace[ToString[{b}],"_"->""]],
TBCombinedLorentzTensorsList//.(a_[b___]:>f_):>f
}];
Print["\nCombined Lorentz tensors:   ",TableForm[Transpose[{els[[All,2]]}],TableHeadings->{els[[All,1]],{"replacement","name"}},TableSpacing->{3, 5}]];
Print["\nThese can be explicitly evaluated by using e.g. \!\(\*
StyleBox[\"TBInsertCombinedLorentzTensors\",\nFontColor->RGBColor[1, 0.5, 0]]\)[transProj[p,\[Mu],\[Nu]]]"];

Print["\n
TensorBases defines additionally the following Lorentz tensors:
   sigma[\[Mu],\[Nu],\!\(\*SubscriptBox[\(d\), \(1\)]\),\!\(\*SubscriptBox[\(d\), \(2\)]\)] : \!\(\*FractionBox[\(\[ImaginaryI]\), \(2\)]\)[\!\(\*SubscriptBox[\(\[Gamma]\), \(\[Mu]\)]\),\!\(\*SubscriptBox[\(\[Gamma]\), \(\[Nu]\)]\)\!\(\*SubscriptBox[\(]\), \(\*SubscriptBox[\(d\), \(1\)] \*SubscriptBox[\(d\), \(2\)]\)]\)
   pdash[p,\!\(\*SubscriptBox[\(d\), \(1\)]\),\!\(\*SubscriptBox[\(d\), \(2\)]\)] : (\!\(\*SubscriptBox[\(\[Gamma]\), \(\[Mu]\)]\)\!\(\*SubscriptBox[\(p\), \(\[Mu]\)]\)\!\(\*SubscriptBox[\()\), \(\*SubscriptBox[\(d\), \(1\)] \*SubscriptBox[\(d\), \(2\)]\)]\)
   psdash[p,\!\(\*SubscriptBox[\(d\), \(1\)]\),\!\(\*SubscriptBox[\(d\), \(2\)]\)] : (\!\(\*SubscriptBox[\(\[Gamma]\), \(i\)]\)\!\(\*SubscriptBox[\(p\), \(i\)]\)\!\(\*SubscriptBox[\()\), \(\*SubscriptBox[\(d\), \(1\)] \*SubscriptBox[\(d\), \(2\)]\)]\)

Further useful functions defined by TensorBases:
\!\(\*
StyleBox[\"UseLorentzLinearity\",\nFontColor->RGBColor[1, 0.5, 0]]\)[expr] expands all scalar products and vectors in expr (e.g. sp[p1,p2-p3] -> sp[p1,p2]-sp[p1,p3])
\!\(\*
StyleBox[\"AddFormTracerGroup\",\nFontColor->RGBColor[1, 0.5, 0]]\)[{name,kind,constant}] adds a group to FormTracer where name is an identifier, kind is one of {SUNfund, SONfund, SU3fundexplicit, SU2fundexplicit,SPNfund} (see also FormTracer`ShowGroupTemplates[]) and constant is the identifier for the group constant.
\!\(\*
StyleBox[\"RemoveFormTracerGroup\",\nFontColor->RGBColor[1, 0.5, 0]]\)[name] removes a group from FormTracer where name is an identifier.
\!\(\*
StyleBox[\"SetNf\",\nFontColor->RGBColor[1, 0.5, 0]]\)[3],\!\(\*
StyleBox[\"SetNf\",\nFontColor->RGBColor[1, 0.5, 0]]\)[2],\!\(\*
StyleBox[\"SetNf\",\nFontColor->RGBColor[1, 0.5, 0]]\)[] sets the flavor number to 3, 2 or the general Nf.
\!\(\*
StyleBox[\"SetNc\",\nFontColor->RGBColor[1, 0.5, 0]]\)[3],\!\(\*
StyleBox[\"SetNc\",\nFontColor->RGBColor[1, 0.5, 0]]\)[2],\!\(\*
StyleBox[\"SetNc\",\nFontColor->RGBColor[1, 0.5, 0]]\)[] sets the color number to 3, 2 or the general Nc.
"];
];


BeginPackage["TensorBases`"];
Unprotect["TensorBases`*"];
Unprotect["TensorBases`Private`*"];
ClearAll["TensorBases`*"];
ClearAll["TensorBases`Private`*"];


If[Head[$DistributedContexts]=!=List,$DistributedContexts={}];
$DistributedContexts=$DistributedContexts\[Union]{$Context,"TensorBases`Private`","TensorBases`","FormTracer`","FormTracer`Private`"}


Tensor::usage="Symbol used by TensorBases to express vertex structures";
Tensor1::usage="Symbol used by TensorBases to express inner & canonical products";
Tensor2::usage="Symbol used by TensorBases to express inner & canonical products";


TBGetBasisElement::usage = "TBGetBasisElement[BasisName_String,n_Integer,indices___]
Obtains the n-th element of the specified basis. The given indices must match the ones specified by the basis, see TBInfo[].
If no indices are given, the standard indices specified by the basis are used.
TBGetBasisElement[BasisName_String,All,indices___]
Returns a list with all elements of the specified basis. The given indices must match the ones specified by the basis, see TBInfo[].
If no indices are given, the standard indices specified by the basis are used.";

TBGetVertex::usage = "TBGetVertex[BasisName_String,n_Integer,indices___]
Obtains the n-th vertex of the specified basis. The given indices must match the ones specified by the basis, see TBInfo[].
If no indices are given, the standard indices specified by the basis are used.
TBGetVertex[BasisName_String,All,indices___]
Returns a list with all vertices of the specified basis. The given indices must match the ones specified by the basis, see TBInfo[].
If no indices are given, the standard indices specified by the basis are used.";

TBGetInnerProduct::usage = "TBGetInnerProduct[BasisName_String]
Returns the bilinear operator \[ScriptCapitalO] that represents the inner product of the specified basis. 
It can be called as \[ScriptCapitalO][Tensor1, n, Tensor2, m], where Tensor1 and Tensor2 are functions with signatures Tensor[BasisName_String, n_Integer, indices___].
For example, \[ScriptCapitalO][TBGetBasisElement, 2, TBGetBasisElement, 1] returns <\!\(\*SubscriptBox[\(e\), \(2\)]\),\!\(\*SubscriptBox[\(e\), \(1\)]\)>.";

TBGetCanonicalProduct::usage = "TBGetCanonicalProduct[BasisName_String]
Returns the bilinear operator \[ScriptCapitalO] that represents the canonical product (i.e. the euclidean inner product) of the specified basis. 
It can be called as \[ScriptCapitalO][Tensor1, n, Tensor2, m], where Tensor1 and Tensor2 are functions with signatures Tensor[BasisName_String, n_Integer, indices___].
For example, \[ScriptCapitalO][TBGetBasisElement, 2, TBGetBasisElement, 1] returns <\!\(\*SubscriptBox[\(e\), \(2\)]\),\!\(\*SubscriptBox[\(e\), \(1\)]\)\!\(\*SubscriptBox[\(>\), \(can\)]\).";

TBGetMetric::usage = "TBGetMetric[BasisName_String]
Returns the metric of the specified basis, i.e. the matrix \!\(\*SubscriptBox[\(g\), \(ij\)]\) = <\!\(\*SubscriptBox[\(e\), \(i\)]\),\!\(\*SubscriptBox[\(e\), \(j\)]\)>, where the \!\(\*SubscriptBox[\(e\), \(i\)]\) are the basis elements of the basis.";

TBGetInverseMetric::usage = "TBGetInverseMetric[BasisName_String]
Returns the inverse of the metric of the specified basis, i.e. the matrix \!\(\*SuperscriptBox[SubscriptBox[\(g\), \(ij\)], \(-1\)]\) = (<\!\(\*SubscriptBox[\(e\), \(i\)]\),\!\(\*SubscriptBox[\(e\), \(j\)]\)>\!\(\*SuperscriptBox[\()\), \(-1\)]\), where the \!\(\*SubscriptBox[\(e\), \(i\)]\) are the basis elements of the basis.";

TBGetBasisFields::usage = "TBGetBasisFields[BasisName_String]
Returns the field content in the order as used for the indices of the basis.";

TBGetProjector::usage = "TBGetBasisProjector[BasisName_String,n_Integer,indices___]
Returns the n-th projector, which is defined by \!\(\*SuperscriptBox[SubscriptBox[\(g\), \(nj\)], \(-1\)]\)\!\(\*SubscriptBox[\(e\), \(j\)]\). The given indices must match the ones specified by the basis, see TBInfo[]. 
If no indices are given, the standard indices specified by the basis are used.
TBGetVertex[BasisName_String,All,indices___]
Returns a list with all projectors of the specified basis, defined by \!\(\*SuperscriptBox[SubscriptBox[\(g\), \(nj\)], \(-1\)]\)\!\(\*SubscriptBox[\(e\), \(j\)]\). The given indices must match the ones specified by the basis, see TBInfo[].
If no indices are given, the standard indices specified by the basis are used.";

TBInfo::usage = "TBInfo[_String]
Return information on a given object. 
TBInfo[] prints all available bases with some usage information. 
TBInfo[BasisName] prints detailed information provided by this basis.
TBInfo[\"FormTracer\"] prints all defined groups and identites which FormTracer currently knows.
TBInfo[\"Extensions\"] prints all extensions to FormTracer, defined by the TensorBases package.
TBInfo[\"Momenta\"] prints all momentum transformations that can be performed by the TensorBases package.";

TBImportBasis::usage = "TBImportBasis[BasisDefinitionFile_String,CacheDirectory_String:\"./TBCache\"]
Import a custom basis definition file. The optional argument CacheDirectory can be set to choose a specific location where the intermediate files from processing the basis are stored.";

TBExportBasis::usage = "TBExportBasis[BasisName_String,folder_String:\"./\"]
Export a basis definition file. The basis with the name BasisName has to be loaded in memory. If the optional argument folder is given, this will be the location where the exported basis definition will be placed.";

TBRestrictBasis::usage = "TBRestrictBasis[inBasisName_String, outBasisName_String, {indices__Integer}, CacheDirectory_String:\"./TBCache\"]
Restrict an existing basis. The new basis will be called outBasisName and only contain the basis elements specified by the given indices.";

TBConstructBasis::usage = "TBConstructBasis[options...]

Construct a new basis from a given set of Tensors.
Example call:
TBConstructBasis[\[IndentingNewLine]\"Name\"->\"FourFermionBasis\",\[IndentingNewLine]\"Vertex\"->{psibar,psi,psibar,psi},\[IndentingNewLine]\"VertexStructure\"->2(Tensor[1,2,3,4]-Tensor[1,4,3,2]),\[IndentingNewLine]\"InnerProduct\"->2Tensor1[1,2,3,4](Tensor2[2,1,4,3]-Tensor2[4,1,2,3]),\[IndentingNewLine]\"Indices\"->{{p1,d1},{p2,d2},{p3,d3},{p4,d4}},\[IndentingNewLine]\"Tensors\"->{{deltaDirac[d1,d2]deltaDirac[d3,d4],gamma[mu,d1,d2]gamma[mu,d3,d4],gamma5[d1,d2]gamma5[d3,d4],gamma[mu,d1,dint1]gamma5[dint1,d2]gamma[mu,d3,d3int]gamma5[d3int,d4],sigma[mu,nu,d1,d2]sigma[mu,nu,d3,d4]\[IndentingNewLine]}}\[IndentingNewLine]]
For all possible options, see Options[TBConstructBasis]

";

TBConstructVertexBasis::usage = "TBConstructVertexBasis[options...]

Construct a new vertex basis from a given set of Tensors.
Example call:
TBConstructBasis[\[IndentingNewLine]\"Name\"->\"FourFermionBasis\",\[IndentingNewLine]\"Vertex\"->{psibar,psi,psibar,psi},\[IndentingNewLine]\"VertexStructure\"->2(Tensor[1,2,3,4]-Tensor[1,4,3,2]),\[IndentingNewLine]\"Indices\"->{{p1,d1},{p2,d2},{p3,d3},{p4,d4}},\[IndentingNewLine]\"Tensors\"->{{deltaDirac[d1,d2]deltaDirac[d3,d4],gamma[mu,d1,d2]gamma[mu,d3,d4],gamma5[d1,d2]gamma5[d3,d4],gamma[mu,d1,dint1]gamma5[dint1,d2]gamma[mu,d3,d3int]gamma5[d3int,d4],sigma[mu,nu,d1,d2]sigma[mu,nu,d3,d4]\[IndentingNewLine]}}\[IndentingNewLine]]
For all possible options, see Options[TBConstructBasis]

";

TBExportCache::usage = "TBExportCache[BasisName_String,CacheFolder_String:\"./TBCache\"]
Exports everything in memory of the Basis BasisName onto disk in the folder CacheFolder.";

TBUnregister::usage = "TBUnregister[BasisName_String]
Remove an existing basis from internal memory. This does not delete or change any files on disk.";

TBBasisExists::usage = "TBBasisExists[BasisName_String]
Returns True or False, depending if the given Basis exists in memory.";

TBList::usage = "TBList[]
Returns as a list all basis names in memory.";


TBBasisTransformation::usage = "TBBasisTransformation[toBasis_String,fromBasis_String]
Returns a matrix for the transformation of coordinates (i.e. dressings) from the basis \"fromBasis\" to the basis \"toBasis\".
I.e. given a set of dressings dress = {d1,d2,d3...} in \"fromBasis\", we get the set of dressings dressbar = {db1,db2,db3,...} in \"toBasis\" from dressbar = TBBasisTransformation[toBasis,fromBasis].dress";

TBVertexTransformation::usage = "TBVertexTransformation[toBasis_String,fromBasis_String]
Returns a matrix for the transformation of coordinates (i.e. (!) vertex dressings) from the basis \"fromBasis\" to the basis \"toBasis\".
I.e. given a set of (!) vertex dressings dress = {d1,d2,d3...} in \"fromBasis\", we get the set of dressings dressbar = {db1,db2,db3,...} in \"toBasis\" from dressbar = TBBasisTransformation[toBasis,fromBasis].dress";


TBGetIdentityMatrix::usage = "TBGetIdentityMatrix[BasisName_String,indices___]
Returns an identity matrix for the given two-point function BasisName. Works only for two-point functions.
If no indices are given, the standard indices specified by the basis are used.";

TBGetBasisSize::usage = "TBGetBasisSize[BasisName_String]
Get the size of a basis of with name \"BasisName\".";

TBGetIndexSet::usage = "TBGetIndexSet[BasisName_String,id_Integer,p_Symbol]
Get a unique index set for particle id in the Basis \"BasisName\" with momentum p.
TBGetIndexSet[set_List,p_]
Change the momentum of an index set to p.
";

TBGetBasis::usage= "TBGetBasis[BasisName_String,indices___]
Returns a list with all basis elements.
If no indices are given, the standard indices specified by the basis are used.";

TBMakePropagator::usage = "TBMakePropagator[BasisName_String,InvProp_List]
For a two-point basis \"BasisName\", obtain a propagator for a given inverse propagator.
InvProp should be a list of basis element coefficients making up the inverse propagator.
For example, {\[ImaginaryI], Mq[p]} for the Basis \"qbq\" for the standard quark propagator in vacuum.
TBMakePropagator[BasisName_String,InvProp_List,p]
Uses the momentum p in the output.";


TB3PToS0S1SPhi::usage="TB3PToS0S1SPhi[p1_Symbol,p2_Symbol,p3_Symbol,S0_Symbol,S1_Symbol,SPhi_Symbol]
Given three momenta p1,p2,p3, obtain a function which transforms these to the representation in terms of S0,S1 and SPhi.
Returns a function which takes one argument, the expression to be transformed.

TB3PToS0S1SPhi[p1_Symbol,p2_Symbol,p3_Symbol,q_Symbol,S0_Symbol,S1_Symbol,SPhi_Symbol]
If an additional momentum q is supplied, it is included in the transformation. Currently this assumes that q is a four-dimensional vector and is described by
q={cos1,\!\(\*SqrtBox[\(1 - \*SuperscriptBox[\(cos2\), \(2\)]\)]\)cos1,\!\(\*SqrtBox[\(1 - \*SuperscriptBox[\(cos1\), \(2\)]\)]\)\!\(\*SqrtBox[\(1 - \*SuperscriptBox[\(cos2\), \(2\)]\)]\)Cos[phi],\!\(\*SqrtBox[\(1 - \*SuperscriptBox[\(cos1\), \(2\)]\)]\)\!\(\*SqrtBox[\(1 - \*SuperscriptBox[\(cos2\), \(2\)]\)]\)Sin[phi]}
";

TB3PFromS0S1SPhi::usage="TB3PFromS0S1SPhi[p1_Symbol,p2_Symbol,p3_Symbol,S0_Symbol,S1_Symbol,SPhi_Symbol]
Given three momenta p1,p2,p3, obtain a function which transforms from the representation in terms of S0,S1 and SPhi back to the momenta p1,p2,p3.
Returns a function which takes one argument, the expression to be transformed.
";

TB3PToS0S1SPhiQk::usage="TB3PToS0S1SPhi[Q_Symbol,k_Symbol,S0_Symbol,S1_Symbol,SPhi_Symbol]
Given two momenta Q,k obtain a function which transforms these to the representation in terms of S0,S1 and SPhi.
Returns a function which takes one argument, the expression to be transformed.

TB3PToS0S1SPhi[Q_Symbol,k_Symbol,q_Symbol,S0_Symbol,S1_Symbol,SPhi_Symbol]
If an additional momentum q is supplied, it is included in the transformation. Currently this assumes that q is a four-dimensional vector and is described by
q={cos1,\!\(\*SqrtBox[\(1 - \*SuperscriptBox[\(cos2\), \(2\)]\)]\)cos1,\!\(\*SqrtBox[\(1 - \*SuperscriptBox[\(cos1\), \(2\)]\)]\)\!\(\*SqrtBox[\(1 - \*SuperscriptBox[\(cos2\), \(2\)]\)]\)Cos[phi],\!\(\*SqrtBox[\(1 - \*SuperscriptBox[\(cos1\), \(2\)]\)]\)\!\(\*SqrtBox[\(1 - \*SuperscriptBox[\(cos2\), \(2\)]\)]\)Sin[phi]}
";

TB3PFromS0S1SPhiQk::usage="TB3PFromS0S1SPhi[Q_Symbol,k_Symbol,S0_Symbol,S1_Symbol,SPhi_Symbol]
Given two momenta Q,k, obtain a function which transforms from the representation in terms of S0,S1 and SPhi back to the momenta Q,k.
Returns a function which takes one argument, the expression to be transformed.
";

TB3PToS0as::usage="TB3PToS0as[p1_Symbol,p2_Symbol,p3_Symbol,S0_Symbol,a_Symbol,s_Symbol]
Given three momenta p1,p2,p3, obtain a function which transforms these to the representation in terms of S0, a and s.
Returns a function which takes one argument, the expression to be transformed.

TB3PToS0as[p1_Symbol,p2_Symbol,p3_Symbol,q_Symbol,S0_Symbol,a_Symbol,s_Symbol]
If an additional momentum q is supplied, it is included in the transformation. Currently this assumes that q is a four-dimensional vector and is described by
q={cos1,\!\(\*SqrtBox[\(1 - \*SuperscriptBox[\(cos2\), \(2\)]\)]\)cos1,\!\(\*SqrtBox[\(1 - \*SuperscriptBox[\(cos1\), \(2\)]\)]\)\!\(\*SqrtBox[\(1 - \*SuperscriptBox[\(cos2\), \(2\)]\)]\)Cos[phi],\!\(\*SqrtBox[\(1 - \*SuperscriptBox[\(cos1\), \(2\)]\)]\)\!\(\*SqrtBox[\(1 - \*SuperscriptBox[\(cos2\), \(2\)]\)]\)Sin[phi]}
";

TB3PFromS0as::usage="TB3PFromS0as[p1_Symbol,p2_Symbol,p3_Symbol,S0_Symbol,a_Symbol,s_Symbol]
Given three momenta p1,p2,p3, obtain a function which transforms from the representation in terms of S0, a and s back to the momenta p1,p2,p3.
Returns a function which takes one argument, the expression to be transformed.
";

TBProjectToSymmetricPoint::usage="TBProjectToSymmetricPoint[expr_,q_Symbol,p_Symbol,momenta___Symbol]
Project an expression with internal loop momentum q to the symmetric point with average momentum p. The last arguments should be all involved momenta. 
According to their number, the correct symmetric-point configuration is chosen.
";

TBProjectToSymmetricPointSpatial::usage="TBProjectToSymmetricPointSpatial[expr_,q_Symbol,p_Symbol,momenta___Symbol]
Project an expression with internal loop momentum q to the symmetric point in the d-1 dimensional subspace with average momentum p.
This is useful for applications at finite temperature, where the 0th component is discrete.
The last arguments should be all involved momenta. According to their number, the correct symmetric-point configuration is chosen.
";


TBInfo["FormTracer"]:=Global`ShowFormTracerDefinitions[];
TBInfo["Extensions"]:=Global`ShowFormTracerExtensions[];


TBInfo["BaseBuilder"]:=Print@"TensorBases provides facilities for exporting and importing bases:
\nTBImportBasis and TBExportBasis allow for importing user-written basis definition files and automatic export of bases in memory to such definition files.
\nTBExportCache writes any basis data in memory to disk at a specified location.
\nTBUnregister allows to remove basis names from the registry, which allows one to overwrite bases by custom imports.
\nTBRestrictBasis creates a new basis from an old one by simple restriction.
\nTBConstructBasis creates a new basis from a set of primitive tensors. The method automatically takes tensor products of multiple given tensor spaces and reduces any overcomplete set using a given inner product to a minimal basis (a maximal linearly independent set).
\nTBConstructVertexBasis creates a new vertex basis from a set of primitive tensors. 
\nFor usage help with the aforementioned functions, please call their usage messages, e.g. TBConstructBasis::usage.
";


TBInfo["Notation"]:=Print@"\!\(\*
StyleBox[\"TensorBases\",\nFontWeight->\"Bold\"]\) uses the following conventions and notation:
For a given group, \!\(\*SuperscriptBox[\(T\), \(a\)]\) denotes the generators of the group in the fundamental representation, \!\(\*SuperscriptBox[\(t\), \(a\)]\) denotes the generators in the adjoint representation.
\!\(\*SubscriptBox[\(\[Epsilon]\), \(abc\)]\) is the fully anti-symmetric Levi-Civita symbol.
The \!\(\*SuperscriptBox[\(T\), \(a\)]\) are normalised as 
	tr[\!\(\*SuperscriptBox[\(T\), \(a\)]\)\!\(\*SuperscriptBox[\(T\), \(b\)]\)] = \!\(\*FractionBox[\(1\), \(2\)]\)\!\(\*SubscriptBox[\(\[Delta]\), \(ab\)]\).
The \!\(\*SubscriptBox[\(\[Gamma]\), \(\(\[Mu]\)\(\\\ \)\)]\)denote Euclidean gamma matrices and accordingly \!\(\*SubscriptBox[\(\[Gamma]\), \(\(5\)\(\\\ \)\)]\)= \!\(\*SubscriptBox[\(\[Gamma]\), \(0\)]\)\!\(\*SubscriptBox[\(\[Gamma]\), \(1\)]\)\!\(\*SubscriptBox[\(\[Gamma]\), \(2\)]\)\!\(\*SubscriptBox[\(\[Gamma]\), \(3\)]\)
";


Begin["`Private`"];


If[Head[$DistributedContexts]=!=List,$DistributedContexts={}];
$DistributedContexts=$DistributedContexts\[Union]{$Context,"TensorBases`Private`","TensorBases`","FormTracer`","FormTracer`Private`"}


GlobalContext[expr_]:=Module[{$ContextOld,result},
$ContextOld=$Context;
$Context="Global`";
result=ReleaseHold[expr];
$Context=$ContextOld;
Return[result];
];
SetAttributes[GlobalContext,HoldAll]
WithinContext[context_String,expr_]:=Module[{$ContextOld,result},
$ContextOld=$Context;
$Context=context;
Begin[context];
Print["Changed to context", $Context];
result=ReleaseHold[expr];
End[];
$Context=$ContextOld;
Return[result];
];
SetAttributes[WithinContext,HoldRest]


FormTracerNaming[]:=Module[
{outputRulesLorentzTensors,outputRulesGroupTensors,outputRules,
privateOutputRulesLorentzTensors,privateOutputRulesGroupTensors,privateOutputRules},

outputRulesLorentzTensors=Normal[FormTracer`Private`lorentzTensorReplacementRulesOutput]/.{(a_[c___]:>b_):>(Symbol["TB"~~StringSplit[ToString[a],"FTx"][[-1]]][c])};
outputRulesGroupTensors=Normal[FormTracer`Private`groupTensorRep:qlacementRulesOutput]/.{(a_[c___]:>b_):>(Symbol["TB"~~StringSplit[ToString[a],"FTx"][[-1]]][c])};
outputRules=Join[outputRulesLorentzTensors,outputRulesGroupTensors];

Print["Lorentz group:   ",outputRulesLorentzTensors//TableForm];
Print[""];
Print["color group:     ",Select[outputRulesGroupTensors,MemberQ[#,color,Infinity]&]//TableForm];
Print[""];
Print["flavor group:    ",Select[outputRulesGroupTensors,MemberQ[#,flavor,Infinity]&]//TableForm];
];


InsertOutputNaming[expr_]:=Module[
{
groups,
outputRulesLorentzTensors,outputRulesGroupTensors,outputRules,
privateOutputRulesLorentzTensors,privateOutputRulesGroupTensors,privateOutputRules,
otherRules
},

outputRulesLorentzTensors=Normal[FormTracer`Private`lorentzTensorReplacementRulesOutput]/.{(a_[c___]:>b_):>(Symbol["TB"~~StringSplit[ToString[a],"FTx"][[-1]]][c]:>b)};
outputRulesGroupTensors=Normal[FormTracer`Private`groupTensorReplacementRulesOutput]/.{(a_[c___]:>b_):>(Symbol["TB"~~StringSplit[ToString[a],"FTx"][[-1]]][c]:>b)};
outputRules=Join[outputRulesLorentzTensors,outputRulesGroupTensors];

privateOutputRulesLorentzTensors=Normal[FormTracer`Private`lorentzTensorReplacementRulesOutput]/.{(a_[c___]:>b_):>(Symbol["TensorBases`Private`TB"~~StringSplit[ToString[a],"FTx"][[-1]]][c]:>b)};
privateOutputRulesGroupTensors=Normal[FormTracer`Private`groupTensorReplacementRulesOutput]/.{(a_[c___]:>b_):>(Symbol["TensorBases`Private`TB"~~StringSplit[ToString[a],"FTx"][[-1]]][c]:>b)};
privateOutputRules=Join[privateOutputRulesLorentzTensors,privateOutputRulesGroupTensors];

groups={
TensorBases`Private`flavor->Global`flavor,
TensorBases`Private`color->Global`color
};

otherRules={
TensorBases`Private`sigma:>Global`sigma,
TensorBases`Private`pdash:>Global`pdash,
TensorBases`Private`psdash:>Global`psdash,

TensorBases`Private`transProj:>Global`transProj,
TensorBases`Private`longProj:>Global`longProj,
TensorBases`Private`transProjMagnetic:>Global`transProjMagnetic,
TensorBases`Private`transProjElectric:>Global`transProjElectric
};

Return[expr//.groups//.outputRules//.privateOutputRules//.otherRules/.a_Symbol/;Context[a]=="TensorBases`Private`":>Symbol["Global`"<>SymbolName[a]]];
];


InsertInputNaming[expr_]:=Module[
{
inputRulesLorentzTensors,inputRulesGroupTensors
},

inputRulesLorentzTensors=Select[Normal[FormTracer`Private`lorentzTensorReplacementRulesInput],MatchQ[_[__]:>_[__]]]/.{
(a_[d__]:>b_[c__]):>(a[d]->Symbol["TB"~~StringSplit[ToString[b],"FTx"][[-1]]][c])
};
inputRulesGroupTensors=Select[Normal[FormTracer`Private`groupTensorReplacementRulesInput],MatchQ[_[__]:>_[__]]]/.{
(a_[d__]:>b_[c__]):>(a[d]->Symbol["TB"~~StringSplit[ToString[b],"FTx"][[-1]]][c])
};

Return[expr//.inputRulesLorentzTensors//.inputRulesGroupTensors];
];


TBFormTrace[expr_]:=Module[{processedExpr,result},
processedExpr=InsertOutputNaming[expr];
result=GlobalContext[FormTracer`FormTrace[processedExpr]];
Return[result];
];


SetAttributes[TBsps,Orderless]
SetAttributes[TBsp,Orderless]

TBsp[0,a_]=0;
TBsp[a_,0]=0;
TBsp[0,0]=0;

TBsps[0,a_]=0;
TBsps[a_,0]=0;
TBsps[0,0]=0;

TBvec[0,mu_]=0;

TBvecs[0,mu_]=0;
TBvecs[p_,0]=0;

TBsp[a_,b_+c_]:= TBsp[a,b]+TBsp[a,c];
TBsp[a_,-1b_]:= -TBsp[a,b];
TBsp[b_,a_?NumericQ c_]:= a TBsp[b,c];

TBsps[a_,b_+c_]:= TBsps[a,b]+TBsps[a,c];
TBsps[a_,-1b_]:= -TBsps[a,b];
TBsps[b_,a_?NumericQ c_]:= a TBsps[b,c];

TBvec[p_+q_,mu_]:=TBvec[p,mu]+TBvec[q,mu];
TBvec[-1 p_,mu_]:= -TBvec[p,mu];
TBvec[n_?NumericQ a_,mu_]:=n TBvec[a,mu];

TBvecs[p_+q_,mu_]:=TBvecs[p,mu]+TBvecs[q,mu];
TBvecs[-1 p_,mu_]:= -TBvecs[p,mu];
TBvecs[n_?NumericQ a_,mu_]:=n TBvecs[a,mu];


TBPrint[thing_,level_Integer]:=If[IntegerQ[Global`TBVerbose]&&Global`TBVerbose>=level,Print[thing]];TBPrint[thing_List,level_Integer]:=If[IntegerQ[Global`TBVerbose]&&Global`TBVerbose>=level,Print@@thing];


AlreadyUnique[x_Symbol]:=Module[{split,tailNumbers},
split=StringSplit[ToString[x],"$"];
If[Length[split]==1,Return[False]];
tailNumbers=DigitQ[split[[-1]]];
Return[tailNumbers];
]
UniqueStem[x_Symbol]:=Module[{split},
split=StringSplit[ToString[x],"$"];
Return[split[[1]]];
]


TBUnique[x_Symbol]:=Module[{},
Return[
Unique[Symbol[UniqueStem[x]]]
];
]


GetAllSymbols[expr_]:=DeleteDuplicates@Cases[{expr},_Symbol,Infinity]


MakeIndexList[len_Integer,expr___]:=Module[{list},
If[Length[{expr}]==1&&Head[{expr}[[1]]]===List,
list=expr,
list={expr}
];
If[Length[list]==0,Print["Index list is empty!"];Abort[];];
If[Length[list]!=len,Print["Index list must have "~~ToString[len]~~" elements!"];Abort[];];
If[AnyTrue[list,Head[#]=!=List&],Print["An index list must consist of one list for every particle!"];Abort[];];
Return[list];
]


(* ::Input::Initialization:: *)
TBDirectory=SelectFirst[
Join[
{
FileNameJoin[{$UserBaseDirectory,"Applications","TensorBases"}],
FileNameJoin[{$BaseDirectory,"Applications","TensorBases"}],
FileNameJoin[{$InstallationDirectory,"AddOns","Applications","TensorBases"}],
FileNameJoin[{$InstallationDirectory,"AddOns","Packages","TensorBases"}],
FileNameJoin[{$InstallationDirectory,"AddOns","ExtraPackages","TensorBases"}]
},
Select[$Path,StringContainsQ[#,"TensorBases"]&]
],
DirectoryQ[#]&
]<>"/";
If[Head[TBDirectory]=!=String,
Print["\n!!!!!!!!!!\nCannot find valid TensorBases installation! Cached tensor data is not available, loading the package may take an extremely long time.\n!!!!!!!!!!\n"]
];


AutoSaveRestore[fileName_String,expr_,dir_String:TBDirectory]:=Module[{mdir,file,ret},
mdir=ReleaseHold[dir];
If[StringTake[mdir,{-1}]!="/",mdir=StringJoin[mdir,"/"]];

file=mdir<>fileName<>".m";

If[FileExistsQ[file],
ret=Import[file];
,
ret=ReleaseHold[expr];
Export[file,ret];
];

Return[ret];
];
SetAttributes[AutoSaveRestore,HoldRest]


TBGetBasisElement[name_String,All,indices___]:=Module[{},
Print["Unknown basis "~~name~~". Aborting"];Abort[]
];
TBGetBasisElement[name_String,n_Integer,indices___]:=Module[{},
Print["Unknown basis "~~name~~". Aborting"];Abort[]
];
TBGetBasisElement[name_String,All]:=Module[{},
Print["Unknown basis "~~name~~". Aborting"];Abort[]
];
TBGetBasisElement[name_String,n_Integer]:=Module[{},
Print["Unknown basis "~~name~~". Aborting"];Abort[]
];
TBGetBasisElement[args___]/;Length[{args}]<2:=Module[{},Print["TBGetBasisElement[...] requires at least two arguments! Aborting"];Abort[]];


TBGetVertex[name_String,All,indices___]:=Module[{},
Print["Unknown basis "~~name~~". Aborting"];Abort[]
];
TBGetVertex[name_String,n_Integer,indices___]:=Module[{},
Print["Unknown basis "~~name~~". Aborting"];Abort[]
];
TBGetVertex[name_String,All]:=Module[{},
Print["Unknown basis "~~name~~". Aborting"];Abort[]
];
TBGetVertex[name_String,n_Integer]:=Module[{},
Print["Unknown basis "~~name~~". Aborting"];Abort[]
];
TBGetVertex[args___]/;Length[{args}]<2:=Module[{},Print["TBGetVertex[...] requires at least two arguments! Aborting"];Abort[]];


TBGetMetric[name_String]:=Module[{},
Print["Unknown basis "~~name~~". Aborting"];Abort[]
];
TBGetMetric[args___]/;Length[{args}]<1:=Module[{},Print["TBGetMetric[...] requires an argument! Aborting"];Abort[]];


TBGetInverseMetric[name_String]:=Module[{},
Print["Unknown basis "~~name~~". Aborting"];Abort[]
];
TBGetInverseMetric[args___]/;Length[{args}]<1:=Module[{},Print["TBGetInverseMetric[...] requires an argument! Aborting"];Abort[]];


TBGetProjector[name_String,All,indices___]:=Module[{},
Print["Unknown basis "~~name~~". Aborting"];Abort[]
];
TBGetProjector[name_String,n_Integer,indices___]:=Module[{},
Print["Unknown basis "~~name~~". Aborting"];Abort[]
];
TBGetProjector[name_String,All]:=Module[{},
Print["Unknown basis "~~name~~". Aborting"];Abort[]
];
TBGetProjector[name_String,n_Integer]:=Module[{},
Print["Unknown basis "~~name~~". Aborting"];Abort[]
];
TBGetProjector[args___]/;Length[{args}]<2:=Module[{},Print["TBGetProjector[...] requires at least two arguments! Aborting"];Abort[]];


GetBasisName[BasisDefinitionFile_String]:=Module[{},
If[StringPart[BasisDefinitionFile,-2;;]=!={".","m"},Print["File "~~BasisDefinitionFile~~" is not a Mathematica script!"];Abort[]];
Return[StringSplit[StringJoin[StringPart[BasisDefinitionFile,;;-3]],"/"][[-1]]]
];

TBCheck[BasisName_String,Trait_String,f_]:=f[Symbol["TB"~~Trait][BasisName]];
TBCheckBasisDefinitions[BasisName_String]:=Module[{errorPrefix},
errorPrefix="AutoDefineBasis:"~~BasisName~~": ";
If[Not@TBCheck[BasisName,"AutoDefine",#===True&],Return[False];];
If[Not@TBCheck[BasisName,"Vertex",ListQ],TBPrint[errorPrefix~~"Vertex definition missing!",0];Abort[]];
If[Not@TBCheck[BasisName,"VertexStructure",Head[#]=!=TBVertexStructure&],TBPrint[errorPrefix~~"Vertex structure missing!",0];Abort[]];
If[Not@TBCheck[BasisName,"Comment",StringQ],TBPrint[errorPrefix~~"Comment definition missing!",2];TBComment[BasisName]=""];
If[Not@TBCheck[BasisName,"Author",StringQ],TBPrint[errorPrefix~~"Author definition missing!",2];TBAuthor[BasisName]=""];
If[Not@TBCheck[BasisName,"VertexBasis",BooleanQ],TBPrint[errorPrefix~~"VertexBasis setting missing, setting to False!",2];TBVertexBasis[BasisName]=False];
If[Not@TBCheck[BasisName,"MomentumConservation",ListQ],TBPrint[errorPrefix~~"Momentum conservation missing!",2];TBMomentumConservation[BasisName]={}];
If[Not@TBCheck[BasisName,"Usage",Head[#]=!=TBUsage&],TBPrint[errorPrefix~~"Usage definition missing!",0];Abort[]];
If[Not@TBCheck[BasisName,"Indices",ListQ],TBPrint[errorPrefix~~"Indices definition missing!",0];Abort[]];
If[Not@TBCheck[BasisName,"Basis",ListQ],TBPrint[errorPrefix~~"Basis definition missing!",0];Abort[]];
If[Not@TBCheck[BasisName,"InnerProduct",Head[#]=!=TBInnerProduct&],TBPrint[errorPrefix~~"InnerProduct definition missing!",0];Abort[]];
If[Not@TBCheck[BasisName,"CanonicalProduct",Head[#]=!=TBCanonicalProduct&],TBPrint[errorPrefix~~"CanonicalProduct definition missing! Some functions may/will break.",1]];
If[Not@TBCheck[BasisName,"Replacements",ListQ],TBPrint[errorPrefix~~"Replacements definition missing!",2];TBReplacements[BasisName]={}];
Return[True];
];

TBCheckVertexBasisDefinitions[BasisName_String]:=Module[{errorPrefix},
errorPrefix="AutoDefineBasis:"~~BasisName~~": ";
If[Not@TBCheck[BasisName,"AutoDefine",#===True&],Return[False];];
If[Not@TBCheck[BasisName,"Vertex",ListQ],TBPrint[errorPrefix~~"Vertex definition missing!",0];Abort[]];
If[Not@TBCheck[BasisName,"Comment",StringQ],TBPrint[errorPrefix~~"Comment definition missing!",2];TBComment[BasisName]=""];
If[Not@TBCheck[BasisName,"Author",StringQ],TBPrint[errorPrefix~~"Author definition missing!",2];TBAuthor[BasisName]=""];
If[Not@TBCheck[BasisName,"MomentumConservation",ListQ],TBPrint[errorPrefix~~"Momentum conservation missing!",2];TBMomentumConservation[BasisName]={}];
If[Not@TBCheck[BasisName,"VertexBasis",BooleanQ],TBPrint[errorPrefix~~"VertexBasis setting missing!",0];Abort[]];
If[Not@TBCheck[BasisName,"Usage",Head[#]=!=TBUsage&],TBPrint[errorPrefix~~"Usage definition missing!",0];Abort[]];
If[Not@TBCheck[BasisName,"Indices",ListQ],TBPrint[errorPrefix~~"Indices definition missing!",0];Abort[]];
If[Not@TBCheck[BasisName,"Basis",ListQ],TBPrint[errorPrefix~~"Basis definition missing!",0];Abort[]];
If[Not@TBCheck[BasisName,"CanonicalProduct",Head[#]=!=TBCanonicalProduct&],TBPrint[errorPrefix~~"CanonicalProduct definition missing!",0];Abort[]];
If[Not@TBCheck[BasisName,"Replacements",ListQ],TBPrint[errorPrefix~~"Replacements definition missing!",2];TBReplacements[BasisName]={}];
Return[True];
];

TBCheckRequirements[BasisName_String]:=Module[{errorPrefix,toString,groups},
errorPrefix="AutoDefineBasis:"~~BasisName~~": ";
If[Not@TBCheck[BasisName,"RequiredGroups",ListQ],Print[errorPrefix,"RequiredGroups definition missing!"];Abort[]];
toString[a_Symbol]:=SymbolName[a];
toString[a_]:=ToString[a];
groups=Map[toString,TBRequiredGroups[BasisName],{2}];
TBPrint["Basis "~~BasisName~~" requires "~~ToString[groups],1];
GlobalContext[Map[Global`AddFormTracerGroup,TBRequiredGroups[BasisName]]];
Return[True];
];


chooseMap[obj_]:=If[ByteCount[obj]>30000,ParallelMap,Map];
chooseMap[size_Integer]:=If[size>8,ParallelMap,Map];

chooseTable[obj_]:=If[ByteCount[obj]>30000,ParallelTable,Table];
chooseTable[size_Integer]:=If[size>8,ParallelTable,Table];


TBMakeBasis[BasisName_String]:=Module[
{rawBasis=TBBasis[BasisName],momentumConservation},

momentumConservation=InsertOutputNaming[TBMomentumConservation[BasisName]];

Return[FullSimplify@(InsertOutputNaming[rawBasis]//.momentumConservation)];
];

TBBasisLength[BasisName_String]:=TBBasis[BasisName]//Length;


TBEvaluateBasisElement[BasisName_String,n_Integer,indices___]:=Module[{rawBasisElement,idxList,originalIndices,newIndices,replacements},
If[n>TBInternal[BasisName,"Length"]||n<1,Print[n," is outside of range [1,"~~ToString[TBInternal[BasisName,"Length"]]~~"] for basis "~~BasisName];Abort[]];

fixIndices[expr_]:=Module[{closedIndices,IndexReplacements},
closedIndices=FormTracer`GetClosedIndices[InsertOutputNaming@TBInternal[BasisName,"Basis"][[n]]];
IndexReplacements:=Thread[closedIndices->Map[TBUnique,closedIndices]];
Return[expr//.IndexReplacements];
];

rawBasisElement=InsertOutputNaming@TBInternal[BasisName,"Basis"][[n]]//fixIndices;

idxList=MakeIndexList[TBInternal[BasisName,"Indices"]//Length,indices];
originalIndices=Flatten[TBInternal[BasisName,"Indices"]];
newIndices=Flatten[idxList];
replacements=Thread[originalIndices->newIndices];
rawBasisElement=rawBasisElement/.replacements;

Return[rawBasisElement]
];


TBMakeInnerProduct[BasisName_String]:=Module[
{Indices,product,operator},
Indices=TBInternal[BasisName,"Indices"];

product=If[TBVertexBasis[BasisName]===True,
TBCanonicalProduct[BasisName]/.Tensor1[a___]:>Tensor1@@Map[Indices[[#]]&,{a}],
TBInnerProduct[BasisName]/.Tensor1[a___]:>Tensor1@@Map[Indices[[#]]&,{a}]
];
product=product/.Tensor2[a___]:>Tensor2@@Map[Indices[[#]]&,{a}];

operator[t1_,i_,t2_,j_]:=Module[{},
Return[product/.Tensor1[indices___]:>t1[BasisName,i,indices]/.Tensor2[indices___]:>t2[BasisName,j,indices]];
];

Return[operator]
];


TBMakeCanonicalProduct::canonical="The canonical products of the given bases \"`1`\" and \"`2`\" do not agree.";
TBMakeCanonicalProduct::noProduct="The canonical product for the basis \"`1`\" has not been defined!";

TBMakeCanonicalProduct[BasisName1_String,BasisName2_String]:=Module[
{Indices1,Indices2,product,operator},
Indices1=TBInternal[BasisName1,"Indices"];
Indices2=TBInternal[BasisName2,"Indices"];

If[(Head[Evaluate[TBCanonicalProduct[BasisName1]]]===TBCanonicalProduct)||(TBCanonicalProduct[BasisName1]===Null),
Message[TBMakeCanonicalProduct::noProduct,BasisName1];Abort[]];
If[TBCanonicalProduct[BasisName1]=!=TBCanonicalProduct[BasisName1],
Message[TBMakeCanonicalProduct::canonical,BasisName1,BasisName2];Abort[]];

product=TBCanonicalProduct[BasisName1]/.Tensor1[a___]:>Tensor1@@Map[Indices1[[#]]&,{a}];
product=product/.Tensor2[a___]:>Tensor2@@Map[Indices2[[#]]&,{a}];

operator[t1_,i_,t2_,j_]:=Module[{},
Return[product/.Tensor1[indices___]:>t1[BasisName1,i,indices]/.Tensor2[indices___]:>t2[BasisName2,j,indices]];
];

Return[operator]
];


TBMakeCanonicalProduct[BasisName_String]:=Module[
{Indices,product,operator},
Indices=TBInternal[BasisName,"Indices"];

product=TBCanonicalProduct[BasisName]/.Tensor1[a___]:>Tensor1@@Map[Indices[[#]]&,{a}];
product=product/.Tensor2[a___]:>Tensor2@@Map[Indices[[#]]&,{a}];

operator[t1_,i_,t2_,j_]:=Module[{},
If[
(Head[Evaluate[TBCanonicalProduct[BasisName]]]===TBCanonicalProduct)||(TBCanonicalProduct[BasisName]===Null),
Print["The canonical product for the basis \""<>BasisName<>"\" has not been defined!"];Abort[]];
Return[product/.Tensor1[indices___]:>t1[BasisName,i,indices]/.Tensor2[indices___]:>t2[BasisName,j,indices]];
];

Return[operator]
];


TBMakeVertices[BasisName_String]:=Module[
{Indices=TBInternal[BasisName,"Indices"],vertices,
rawBasis=TBBasis[BasisName],momentumConservation},

If[TBVertexBasis[BasisName]===True,
momentumConservation=InsertOutputNaming[TBMomentumConservation[BasisName]];
Return[FullSimplify@(InsertOutputNaming[rawBasis]//.momentumConservation)];
];

vertices=TBVertexStructure[BasisName]/.Tensor[a___]:>Tensor@@Map[Indices[[#]]&,{a}];

vertices=chooseMap[TBInternal[BasisName,"Length"]][
FullSimplify[vertices/.Tensor[indices___]:>TBEvaluateBasisElement[BasisName,#,indices]]&,
Table[i,{i,1,TBInternal[BasisName,"Length"]}]
];

Return[vertices];
];


TBEvaluateVertex[BasisName_String,n_Integer,indices___]:=Module[{rawVertex,idxList,originalIndices,newIndices,replacements},
If[n>TBInternal[BasisName,"Length"]||n<1,
Print[n," is outside of range [1,"~~ToString[TBInternal[BasisName,"Length"]]~~"] for basis "~~BasisName];Abort[]];

fixIndices[expr_]:=Module[{closedIndices,IndexReplacements},
closedIndices=FormTracer`GetClosedIndices[InsertOutputNaming@TBInternal[BasisName,"Vertices"][[n]]];
IndexReplacements:=Thread[closedIndices->Map[TBUnique,closedIndices]];
Return[expr//.IndexReplacements];
];

rawVertex=InsertOutputNaming@TBInternal[BasisName,"Vertices"][[n]]//fixIndices;

idxList=MakeIndexList[TBInternal[BasisName,"Indices"]//Length,indices];
originalIndices=Flatten[TBInternal[BasisName,"Indices"]];
newIndices=Flatten[idxList];
replacements=Thread[originalIndices->newIndices];
rawVertex=rawVertex/.replacements;

Return[rawVertex]
];


TBBuildMetric[BasisName_String]:=Module[
{metric,momentumConservation},

momentumConservation=InsertOutputNaming[TBMomentumConservation[BasisName]];

If[TBVertexBasis[BasisName]===True,
metric=Table[
TBFormTrace[
TBInternal[BasisName,"InnerProduct"][
TBEvaluateVertex,i,
TBEvaluateVertex,j
]//.momentumConservation
]//.momentumConservation//.TBInternal[BasisName,"Replacements"]//Global`UseLorentzLinearity
,{i,1,TBInternal[BasisName,"Length"]},{j,1,TBInternal[BasisName,"Length"]}];

metric=chooseMap[metric][FullSimplify,metric];

Return[metric]
];

metric=Table[
TBFormTrace[
TBInternal[BasisName,"InnerProduct"][
TBEvaluateBasisElement,i,
TBEvaluateBasisElement,j
]//.momentumConservation
]//.momentumConservation//.TBInternal[BasisName,"Replacements"]//Global`UseLorentzLinearity
,{i,1,TBInternal[BasisName,"Length"]},{j,1,TBInternal[BasisName,"Length"]}];

metric=chooseMap[metric][FullSimplify,metric];

Return[metric]
];


TBBuildInverseMetric[BasisName_String]:=Module[
{det,inverseMetric},
det=FullSimplify[Det[TBInternal[BasisName,"Metric"]]];

If[det===0,
Print["AutoDefineBasis:"~~BasisName~~": Basis is overcomplete! Determinand is "~~ToString[det]~~""];Abort[];];

inverseMetric=Simplify[Inverse[TBInternal[BasisName,"Metric"]]];

Return[inverseMetric]
];


TBBuildProjectors[BasisName_String]:=Module[
{projectors,i,j},

If[TBVertexBasis[BasisName]===True,
projectors=chooseTable[TBInternal[BasisName,"Length"]][
Simplify[
Sum[TBInternal[BasisName,"InverseMetric"][[i,j]]TBEvaluateVertex[BasisName,j,TBInternal[BasisName,"Indices"]],{j,1,TBInternal[BasisName,"Length"]}]//.TBInternal[BasisName,"Replacements"]
],
{i,1,TBInternal[BasisName,"Length"]}
];

Return[projectors]
];

projectors=chooseTable[TBInternal[BasisName,"Length"]][
Simplify[
Sum[TBInternal[BasisName,"InverseMetric"][[i,j]]TBEvaluateBasisElement[BasisName,j,TBInternal[BasisName,"Indices"]],{j,1,TBInternal[BasisName,"Length"]}]//.TBInternal[BasisName,"Replacements"]
],
{i,1,TBInternal[BasisName,"Length"]}
];

Return[projectors]
];


TBEvaluateProjector[BasisName_String,n_Integer,indices___]:=Module[{rawProjector,idxList,originalIndices,newIndices,replacements},
If[n>TBInternal[BasisName,"Length"]||n<1,
Print[n," is outside of range [1,"~~ToString[TBInternal[BasisName,"Length"]]~~"] for basis "~~BasisName];Abort[]];

fixIndices[expr_]:=Module[{closedIndices,IndexReplacements},
closedIndices=FormTracer`GetClosedIndices[InsertOutputNaming@TBInternal[BasisName,"Projectors"][[n]]];
IndexReplacements:=Thread[closedIndices->Map[TBUnique,closedIndices]];
Return[expr//.IndexReplacements];
];

rawProjector=InsertOutputNaming@TBInternal[BasisName,"Projectors"][[n]]//fixIndices;

idxList=MakeIndexList[TBInternal[BasisName,"Indices"]//Length,indices];
originalIndices=Flatten[TBInternal[BasisName,"Indices"]];
newIndices=Flatten[idxList];
replacements=Thread[originalIndices->newIndices];
rawProjector=rawProjector/.replacements;

Return[rawProjector]
];


TBUnDefineTBGetBasisElement[BasisName_String]:=Module[{},
TBGetBasisElement[BasisName,n_Integer,indices___]:=Module[{},
Print[BasisName~~" is a Vertex basis - no basis elements are available!"];Abort[];
];
TBGetBasisElement[BasisName,n_Integer]:=Module[{},
Print[BasisName~~" is a Vertex basis - no basis elements are available!"];Abort[];
];
TBGetBasisElement[BasisName,All,indices___]:=Module[{},
Print[BasisName~~" is a Vertex basis - no basis elements are available!"];Abort[];
];
TBGetBasisElement[BasisName,All]:=Module[{},
Nothing
(*Print[BasisName~~" is a Vertex basis - no basis elements are available!"];Abort[];*)
];
];


TBDefineTBGetBasisElement[BasisName_String]:=Module[{},
TBGetBasisElement[BasisName,n_Integer,indices___]:=Module[{},
Return[
InsertOutputNaming[
TBEvaluateBasisElement[BasisName,n,indices]
]
];
];
TBGetBasisElement[BasisName,n_Integer]:=Module[{},
Return[
InsertOutputNaming[
(TBEvaluateBasisElement[BasisName,n,##]&)@@TBInternal[BasisName,"Indices"]
]
];
];
TBGetBasisElement[BasisName,All,indices___]:=Module[{},
Return[
TBGetBasisElement[BasisName,#,indices]&/@Range[TBInternal[BasisName,"Length"]]
];
];
TBGetBasisElement[BasisName,All]:=Module[{},
Return[
TBGetBasisElement[BasisName,#]&/@Range[TBInternal[BasisName,"Length"]]
];
];
];
TBDefineTBGetVertex[BasisName_String]:=Module[{},
TBGetVertex[BasisName,n_Integer,indices___]:=Module[{},
Return[
InsertOutputNaming[
TBEvaluateVertex[BasisName,n,indices]
]
];
];
TBGetVertex[BasisName,n_Integer]:=Module[{},
Return[
InsertOutputNaming[
TBEvaluateVertex[BasisName,n,##]&@@TBInternal[BasisName,"Indices"]
]
];
];
TBGetVertex[BasisName,All,indices___]:=Module[{},
Return[
TBGetVertex[BasisName,#,indices]&/@Range[TBInternal[BasisName,"Length"]]
];
];
TBGetVertex[BasisName,All]:=Module[{},
Return[
TBGetVertex[BasisName,#]&/@Range[TBInternal[BasisName,"Length"]]
];
];
];
TBDefineTBGetMetric[BasisName_String]:=Module[{},
TBGetMetric[BasisName]:=Module[{},
Return[
InsertOutputNaming[
TBInternal[BasisName,"Metric"]
]
];
];
];
TBDefineTBGetInnerProduct[BasisName_String]:=Module[{},
TBGetInnerProduct[BasisName]:=Module[{},
Return[
TBInternal[BasisName,"InnerProduct"]
];
];
];
TBDefineTBGetCanonicalProduct[BasisName_String]:=Module[{},
TBGetCanonicalProduct[BasisName]:=Module[{},
Return[
TBInternal[BasisName,"CanonicalProduct"]
];
];
];
TBUnDefineTBGetInnerProduct[BasisName_String]:=Module[{},
TBGetInnerProduct[BasisName]:=Module[{},
Nothing
(*Print[BasisName~~" is a Vertex basis - no inner product is available!"];Abort[];*)
];
];
TBDefineTBGetInverseMetric[BasisName_String]:=Module[{},
TBGetInverseMetric[BasisName]:=Module[{},
Return[
InsertOutputNaming[
TBInternal[BasisName,"InverseMetric"]
]
];
];
];
TBDefineTBGetProjector[BasisName_String]:=Module[{},
TBGetProjector[BasisName,n_Integer,indices___]:=Module[{},
Return[
InsertOutputNaming[
TBEvaluateProjector[BasisName,n,indices]
]
];
];
TBGetProjector[BasisName,n_Integer]:=Module[{},
Return[
InsertOutputNaming[
TBEvaluateProjector[BasisName,n,##]&@@TBInternal[BasisName,"Indices"]
]
];
];
TBGetProjector[BasisName,All,indices___]:=Module[{},
Return[
TBGetProjector[BasisName,#,indices]&/@Range[TBInternal[BasisName,"Length"]]
];
];
TBGetProjector[BasisName,All]:=Module[{},
Return[
TBGetProjector[BasisName,#]&/@Range[TBInternal[BasisName,"Length"]]
];
];
];


TBDefineTBInfo[BasisName_String]:=Module[{},
(*TBInfo[BasisName]:=Module[{},
Print@@TBUsage[BasisName];
];*)
];
TBInfo[BasisName_String]:=Module[{},
Print@@TBUsage[BasisName];
];


TBAvailableBasisNames={};
TBBasisDocs={};
TBAddBasisDocumentation[BasisName_String]:=Module[{toString},
toString[a_Symbol]:=SymbolName[a];
toString[a_]:=ToString[a];

If[MemberQ[TBAvailableBasisNames,BasisName],Print["WARNING: TBAddBasisDocumentation: Possible doubling of bases detected!"];Return[]];
TBAvailableBasisNames=Append[TBAvailableBasisNames,BasisName];
TBBasisDocs=Append[TBBasisDocs,
<|
"Name"->BasisName,
"Vertex"->InsertOutputNaming@TBVertex[BasisName],
"Indices"->TBInternal[BasisName,"Indices"],
"Groups"->Map[toString,TBRequiredGroups[BasisName],{2}],
"InnerProduct"->Style[GlobalContext[StringReplace[ToString[InsertOutputNaming[TBInnerProduct[BasisName]]],{a:DigitCharacter~~" "~~b:LetterCharacter:>a~~" "~~b," "->"","]"->"] "}]],FontSize->10],
"Comment"->TBComment[BasisName],
"Author"->TBAuthor[BasisName]
|>
];
];


TBList[]:=TBAvailableBasisNames;
TBBasisExists[BasisName_]:=MemberQ[TBAvailableBasisNames,BasisName];


TBAutoDefineTensorBasis[BasisName_String,folderPrefix_String:TBDirectory<>"cache"]:=Module[
{errorPrefix,check},
TBPrint["\n-------------------------------\n",1];

check=TBCheckBasisDefinitions[BasisName];
check=check&&TBCheckRequirements[BasisName];

If[Not@check,TBPrint["Skipping processing of "~~BasisName~~".",1];Return[]];
TBPrint["Processing Tensor basis "~~BasisName~~".",1];

TBInternal[BasisName,"Replacements"]=InsertOutputNaming[TBReplacements[BasisName]];
TBInternal[BasisName,"Indices"]=InsertOutputNaming[TBIndices[BasisName]];
TBInternal[BasisName,"Basis"]=AutoSaveRestore[BasisName~~"/basis",
TBPrint[BasisName~~": Making Basis...",2];
TBMakeBasis[BasisName]//InsertInputNaming,
folderPrefix
];
TBInternal[BasisName,"Length"]=TBBasisLength[BasisName];
TBInternal[BasisName,"InnerProduct"]=TBMakeInnerProduct[BasisName];
TBInternal[BasisName,"CanonicalProduct"]=TBMakeCanonicalProduct[BasisName];
TBInternal[BasisName,"Vertices"]=AutoSaveRestore[BasisName~~"/vertices",
TBPrint[BasisName~~": Calculating Vertices...",2];
TBMakeVertices[BasisName]//InsertInputNaming,
folderPrefix
];
TBInternal[BasisName,"Metric"]=AutoSaveRestore[BasisName~~"/metric",
TBPrint[BasisName~~": Calculating Metric...",2];
TBBuildMetric[BasisName]//InsertInputNaming,
folderPrefix
];
TBInternal[BasisName,"InverseMetric"]=AutoSaveRestore[BasisName~~"/inverseMetric",
TBPrint[BasisName~~": Calculating InverseMetric...",2];
TBBuildInverseMetric[BasisName]//InsertInputNaming,
folderPrefix
];
TBInternal[BasisName,"Projectors"]=AutoSaveRestore[BasisName~~"/projectors",
TBPrint[BasisName~~": Calculating Projectors...",2];
TBBuildProjectors[BasisName]//InsertInputNaming,
folderPrefix
];

TBDefineTBGetBasisElement[BasisName];
TBDefineTBGetVertex[BasisName];
TBDefineTBGetMetric[BasisName];
TBDefineTBGetInnerProduct[BasisName];
TBDefineTBGetCanonicalProduct[BasisName];
TBDefineTBGetInverseMetric[BasisName];
TBDefineTBGetProjector[BasisName];
TBDefineTBInfo[BasisName];

TBAddBasisDocumentation[BasisName];

TBPrint[BasisName~~": done.",1];
]


TBAutoDefineVertexBasis[BasisName_String,folderPrefix_String:TBDirectory<>"cache"]:=Module[
{errorPrefix,check},
TBPrint["\n-------------------------------\n",1];

check=TBCheckVertexBasisDefinitions[BasisName];
check=check&&TBCheckRequirements[BasisName];

If[Not@check,TBPrint["Skipping processing of "~~BasisName~~".",1];Return[]];
TBPrint["Processing Vertex basis "~~BasisName~~".",1];

TBInternal[BasisName,"Replacements"]=InsertOutputNaming[TBReplacements[BasisName]];
TBInternal[BasisName,"Indices"]=InsertOutputNaming[TBIndices[BasisName]];
TBInternal[BasisName,"Length"]=TBBasisLength[BasisName];
TBInternal[BasisName,"InnerProduct"]=TBMakeInnerProduct[BasisName];
TBInternal[BasisName,"CanonicalProduct"]=TBMakeCanonicalProduct[BasisName];
TBInternal[BasisName,"Vertices"]=AutoSaveRestore[BasisName~~"/vertices",
TBPrint[BasisName~~": Calculating Vertices...",2];
TBMakeVertices[BasisName]//InsertInputNaming,
folderPrefix
];
TBInternal[BasisName,"Metric"]=AutoSaveRestore[BasisName~~"/metric",
TBPrint[BasisName~~": Calculating Metric...",2];
TBBuildMetric[BasisName]//InsertInputNaming,
folderPrefix
];
TBInternal[BasisName,"InverseMetric"]=AutoSaveRestore[BasisName~~"/inverseMetric",
TBPrint[BasisName~~": Calculating InverseMetric...",2];
TBBuildInverseMetric[BasisName]//InsertInputNaming,
folderPrefix
];
TBInternal[BasisName,"Projectors"]=AutoSaveRestore[BasisName~~"/projectors",
TBPrint[BasisName~~": Calculating Projectors...",2];
TBBuildProjectors[BasisName]//InsertInputNaming,
folderPrefix
];

TBUnDefineTBGetBasisElement[BasisName];
TBDefineTBGetVertex[BasisName];
TBDefineTBGetMetric[BasisName];
TBUnDefineTBGetInnerProduct[BasisName];
TBDefineTBGetCanonicalProduct[BasisName];
TBDefineTBGetInverseMetric[BasisName];
TBDefineTBGetProjector[BasisName];
TBDefineTBInfo[BasisName];

TBAddBasisDocumentation[BasisName];

TBPrint[BasisName~~": done.",1];
]


TBAutoDefineBasis[BasisDefinitionFile_String,folderPrefix_String:TBDirectory<>"cache"]:=Module[
{BasisName=GetBasisName[BasisDefinitionFile],oldDirectory,errorPrefix,check,contents},

oldDirectory=Directory[];
SetDirectory[DirectoryName[BasisDefinitionFile]];
Import[FileNameTake[BasisDefinitionFile,-1]];
SetDirectory[oldDirectory];

If[TBVertexBasis[BasisName]===True,
TBAutoDefineVertexBasis[BasisName,folderPrefix],
TBAutoDefineTensorBasis[BasisName,folderPrefix]
];
];


TBAutoDefineBasisNoLoad[BasisName_String,folderPrefix_String:TBDirectory<>"cache"]:=Module[
{},

If[TBVertexBasis[BasisName]===True,
TBAutoDefineVertexBasis[BasisName,folderPrefix],
TBAutoDefineTensorBasis[BasisName,folderPrefix]
];
];


Unprotect[TBInfo];
TBInfo[args___]/;Length[{args}]<1:=Module[{data},
data=Map[{#["Name"],#["Vertex"],Grid[#["Indices"]],#["InnerProduct"],Grid[#["Groups"]],#["Comment"],#["Author"]}&,TBBasisDocs];
Grid[
Join[{{"Name","Vertex","Indices","Inner product","Groups","Comment","Author"}},data],
Dividers->{{2->True},{2->True}},
ItemStyle->Directive[FontSize->13],
Spacings->{1.5,1.5},
ItemSize->{{Scaled[0.2],Scaled[0.1],Scaled[0.1],Scaled[0.15],Scaled[0.1],Scaled[0.25],Scaled[0.1]}}
]//Print;
]


MakeInnerProduct[innerProduct_,IndicesList_List]:=Module[{fixIndices,product},

fixIndices[expr_]:=Module[{closedIndices,IndexReplacements},
closedIndices=FormTracer`GetClosedIndices[expr];
IndexReplacements:=Thread[closedIndices->Map[TBUnique,closedIndices]];
Return[expr//.IndexReplacements];
];

product[t1_,t2_]:=Module[{ten1,ten2,res},
ten1[indices__]:=fixIndices[t1]/.Thread[Flatten[IndicesList]->Flatten[{indices}]];
ten2[indices__]:=fixIndices[t2]/.Thread[Flatten[IndicesList]->Flatten[{indices}]];

res=innerProduct/.Tensor1[a__]:>Tensor1@@Map[IndicesList[[#]]&,{a}]/.Tensor2[a__]:>Tensor2@@Map[IndicesList[[#]]&,{a}];
res=res/.Tensor1:>ten1/.Tensor2:>ten2;

Return[res];
];

Return[product];
]


ReduceTensorList[tensors_List,innerProduct_,{Indices__List}]:=Module[
{allInternalIndicesList,IndicesList,partIndicesList,product,rr,basisElements},

(*First, check for consistency of all indices in the tensors*)
allInternalIndicesList=Map[FormTracer`GetOpenIndices,tensors];
If[Not@(SameQ@@allInternalIndicesList),
Print["Tensor list "<>ToString[tensors,FormatType->InputForm]<> " has inconsistent open indices!"];Abort[];
];

(*Then, remove all external indices not relevant for the current tensor list and check for consistency with the tensor indices*)
IndicesList=Map[Join[{#[[1]]},Select[#[[2;;]],(MemberQ[allInternalIndicesList[[1]],#]&)]]&,{Indices}];
partIndicesList=Map[Select[#[[2;;]],(MemberQ[allInternalIndicesList[[1]],#]&)]&,{Indices}];

If[Not@SameQ[Sort@Flatten[{partIndicesList}],Sort@allInternalIndicesList[[1]]],
Print["Tensor list "<>ToString[tensors,FormatType->InputForm]<> " has inconsistent indices with external indices!"];Abort[];
];

(*Construct a metric*)
product=MakeInnerProduct[innerProduct,IndicesList];
rr=Table[product[tensors[[i]],tensors[[j]]]//TBFormTrace//Global`UseLorentzLinearity//Simplify,{i,1,Length@tensors},{j,1,Length@tensors}];

(*Find all linearly independent elements*)
rr=rr//Transpose//RowReduce;
basisElements=Flatten[FirstPosition[#,1,Nothing]&/@rr];

Return[tensors[[basisElements]]//Global`UseLorentzLinearity//Simplify];
]


(*TBConstructBasis[___]:=Module[{},Print["Please use the correct pattern for Basis construction: \n",TBConstructBasis::usage];Abort[];
];*)


Options[TBConstructBasis]={
"Name"->"",
"RequiredGroups"->{{}},
"Vertex"->"",
"VertexStructure"->Tensor,
"InnerProduct"->Tensor1*Tensor2,
"CanonicalProduct"->Null,
"Indices"->{{}},
"MomentumConservation"->{},
"Tensors"->{{}},
"Replacements"->{},
"Comment"->"",
"Author"->"User",
"Usage"->"",
"CacheDirectory"->"./TBCache"
};

TBConstructBasis::invalid="The argument \"`1`\" with value \"`2`\" is invalid."
TBConstructBasis::warning="The argument \"`1`\" with value \"`2`\" is missing. Some functions may/will break."

TBConstructBasis::InvalidArgument="TBConstructBasis takes only named arguments, see TBConstructBasis::usage";
TBConstructBasis[___]:=(Message[TBConstructBasis::InvalidArgument];Abort[]);

TBConstructBasis[OptionsPattern[]]:=Module[
{BasisName,RequiredGroups,Vertex,VertexStructure,InnerProduct,CanonicalProduct,Comment,Author,Usage,Indices,MomentumConservation,Tensors,Replacements,CacheDirectory},

BasisName=OptionValue["Name"];
If[Head@BasisName=!=String||BasisName==="",Message[TBConstructBasis::invalid,"Name",BasisName];Abort[]];

RequiredGroups=OptionValue["RequiredGroups"];
If[Head@RequiredGroups=!=List&&AnyTrue[RequiredGroups,Head[#]=!=List&],Message[TBConstructBasis::invalid,"RequiredGroups",RequiredGroups];Abort[]];

Vertex=OptionValue["Vertex"];
If[Head@Vertex=!=List||AnyTrue[Vertex,Head[#]=!=Symbol&],Message[TBConstructBasis::invalid,"Vertex",Vertex];Abort[]];

VertexStructure=OptionValue["VertexStructure"];
If[Head@VertexStructure===List||FreeQ[VertexStructure,Tensor,Infinity],Message[TBConstructBasis::invalid,"VertexStructure",VertexStructure];Abort[]];

InnerProduct=OptionValue["InnerProduct"];
If[Head@InnerProduct===List||FreeQ[InnerProduct,Tensor1,Infinity]||FreeQ[InnerProduct,Tensor2,Infinity],Message[TBConstructBasis::invalid,"InnerProduct",InnerProduct];Abort[]];

CanonicalProduct=OptionValue["CanonicalProduct"];
If[Head@InnerProduct===List||FreeQ[InnerProduct,Tensor1,Infinity]||FreeQ[InnerProduct,Tensor2,Infinity],Message[TBConstructBasis::warning,"CanonicalProduct",InnerProduct]];

Indices=OptionValue["Indices"];
If[Head@Indices=!=List||AnyTrue[Indices,Head[#]=!=List&],Message[TBConstructBasis::invalid,"Indices",Indices];Abort[]];

MomentumConservation=OptionValue["MomentumConservation"];
If[Head@MomentumConservation=!=List,Message[TBConstructBasis::invalid,"MomentumConservation",MomentumConservation];Abort[]];

Tensors=OptionValue["Tensors"];
If[Head@Tensors=!=List&&AnyTrue[Tensors,Head[#]=!=List&],Message[TBConstructBasis::invalid,"Tensors",Tensors];Abort[]];

Replacements=OptionValue["Replacements"];
If[Head@Replacements=!=List||AnyTrue[Replacements,(Head[#]=!=Rule&&Head[#]=!=RuleDelayed)&],Message[TBConstructBasis::invalid,"Replacements",Replacements];Abort[]];

Author=OptionValue["Author"];
Usage=OptionValue["Usage"];
Comment=OptionValue["Comment"];
CacheDirectory=OptionValue["CacheDirectory"];

TBConstructBasis[BasisName,RequiredGroups,Vertex,VertexStructure,InnerProduct,Comment,Author,Usage,Indices,MomentumConservation,Tensors,Replacements,CacheDirectory,CanonicalProduct]
];


TBConstructBasis[
	BasisName_String,
{RequiredGroups___List},
	Vertex_List,
	VertexStructure_,
	InnerProduct_,
	Comment_String,
	Author_String,
	Usage_,
	{Indices__List},
	MomentumConservation_List,
	{Tensors__List},
	Replacements_List,
	CacheDirectory_String:"./TBCache",
CanonicalProduct_:Null
  ]:=Module[{reducedTensors,maximalSet,basis},
If[MemberQ[TBAvailableBasisNames,BasisName],Print["Basis \""~~BasisName~~"\" has been already defined!"];Abort[]];

BeginPackage["TensorBases`"];
Begin["`Private`"];

TBReplacements[BasisName]=Replacements;
TBIndices[BasisName]={Indices};
TBMomentumConservation[BasisName]=MomentumConservation;
TBVertex[BasisName]=Vertex;
TBVertexBasis[BasisName]=False;
TBAuthor[BasisName]=Author;
TBComment[BasisName]=Comment;
TBUsage[BasisName]=Usage;
TBInnerProduct[BasisName]=InnerProduct;
TBCanonicalProduct[BasisName]=CanonicalProduct;
TBVertexStructure[BasisName]=VertexStructure;
TBRequiredGroups[BasisName]={RequiredGroups};

TBCheckRequirements[BasisName];

(*Build a maximal set by doing the tensor product*)
maximalSet=Flatten[TensorProduct@@{Tensors}]//.MomentumConservation;
(*If necessary, reduce it*)
TBBasis[BasisName]=ReduceTensorList[maximalSet,InnerProduct,{Indices}]//InsertInputNaming;

TBInternal[BasisName,"Indices"]=InsertOutputNaming[{Indices}];
TBInternal[BasisName,"Replacements"]=Replacements;
TBInternal[BasisName,"Basis"]=TBMakeBasis[BasisName]//InsertInputNaming;
TBInternal[BasisName,"Length"]=TBBasisLength[BasisName];
TBInternal[BasisName,"InnerProduct"]=TBMakeInnerProduct[BasisName];
TBInternal[BasisName,"CanonicalProduct"]=TBMakeCanonicalProduct[BasisName];

TBInternal[BasisName,"Vertices"]=TBMakeVertices[BasisName]//InsertInputNaming;
TBInternal[BasisName,"Metric"]=TBBuildMetric[BasisName]//InsertInputNaming;
TBInternal[BasisName,"InverseMetric"]=TBBuildInverseMetric[BasisName]//InsertInputNaming;
TBInternal[BasisName,"Projectors"]=TBBuildProjectors[BasisName]//InsertInputNaming;

Unprotect[TBGetBasisElement,TBGetMetric,TBGetInverseMetric,TBGetProjector,TBInfo,TBGetVertex,TBGetInnerProduct,TBGetCanonicalProduct];
TBDefineTBGetBasisElement[BasisName];
TBDefineTBGetVertex[BasisName];
TBDefineTBGetMetric[BasisName];
TBDefineTBGetInnerProduct[BasisName];
TBDefineTBGetCanonicalProduct[BasisName];
TBDefineTBGetInverseMetric[BasisName];
TBDefineTBGetProjector[BasisName];
TBDefineTBInfo[BasisName];
TBAddBasisDocumentation[BasisName];
Protect[TBGetBasisElement,TBGetMetric,TBGetInverseMetric,TBGetProjector,TBInfo,TBGetVertex,TBGetInnerProduct,TBGetCanonicalProduct];

TBPrint[BasisName~~": done.",1];

End[];
EndPackage[];
];


Options[TBConstructVertexBasis]={
"Name"->"",
"RequiredGroups"->{{}},
"Vertex"->"",
"VertexStructure"->Tensor,
"CanonicalProduct"->Null,
"Indices"->{{}},
"MomentumConservation"->{},
"Tensors"->{{}},
"Replacements"->{},
"Comment"->"",
"Author"->"User",
"Usage"->"",
"CacheDirectory"->"./TBCache"
};

TBConstructVertexBasis::invalid="The argument \"`1`\" with value \"`2`\" is invalid."
TBConstructVertexBasis::warning="The argument \"`1`\" with value \"`2`\" is missing. Some functions may/will break."

TBConstructVertexBasis::InvalidArgument="TBConstructBasis takes only named arguments, see TBConstructBasis::usage";
TBConstructVertexBasis[___]:=(Message[TBConstructVertexBasis::InvalidArgument];Abort[]);

TBConstructVertexBasis[OptionsPattern[]]:=Module[
{BasisName,RequiredGroups,Vertex,VertexStructure,CanonicalProduct,Comment,Author,Usage,Indices,MomentumConservation,Tensors,Replacements,CacheDirectory},

BasisName=OptionValue["Name"];
If[Head@BasisName=!=String||BasisName==="",Message[TBConstructVertexBasis::invalid,"Name",BasisName];Abort[]];

RequiredGroups=OptionValue["RequiredGroups"];
If[Head@RequiredGroups=!=List&&AnyTrue[RequiredGroups,Head[#]=!=List&],Message[TBConstructVertexBasis::invalid,"RequiredGroups",RequiredGroups];Abort[]];

Vertex=OptionValue["Vertex"];
If[Head@Vertex=!=List||AnyTrue[Vertex,Head[#]=!=Symbol&],Message[TBConstructVertexBasis::invalid,"Vertex",Vertex];Abort[]];

VertexStructure=OptionValue["VertexStructure"];
If[Head@VertexStructure===List||FreeQ[VertexStructure,Tensor,Infinity],Message[TBConstructVertexBasis::invalid,"VertexStructure",VertexStructure];Abort[]];

CanonicalProduct=OptionValue["CanonicalProduct"];
If[Head@CanonicalProduct===List||FreeQ[CanonicalProduct,Tensor1,Infinity]||FreeQ[CanonicalProduct,Tensor2,Infinity],Message[TBConstructVertexBasis::warning,"CanonicalProduct",CanonicalProduct]];

Indices=OptionValue["Indices"];
If[Head@Indices=!=List||AnyTrue[Indices,Head[#]=!=List&],Message[TBConstructVertexBasis::invalid,"Indices",Indices];Abort[]];

MomentumConservation=OptionValue["MomentumConservation"];
If[Head@MomentumConservation=!=List,Message[TBConstructVertexBasis::invalid,"MomentumConservation",MomentumConservation];Abort[]];

Tensors=OptionValue["Tensors"];
If[Head@Tensors=!=List&&AnyTrue[Tensors,Head[#]=!=List&],Message[TBConstructVertexBasis::invalid,"Tensors",Tensors];Abort[]];

Replacements=OptionValue["Replacements"];
If[Head@Replacements=!=List||AnyTrue[Replacements,(Head[#]=!=Rule&&Head[#]=!=RuleDelayed)&],Message[TBConstructVertexBasis::invalid,"Replacements",Replacements];Abort[]];

Author=OptionValue["Author"];
Usage=OptionValue["Usage"];
Comment=OptionValue["Comment"];
CacheDirectory=OptionValue["CacheDirectory"];

TBConstructVertexBasis[BasisName,RequiredGroups,Vertex,VertexStructure,Comment,Author,Usage,Indices,MomentumConservation,Tensors,Replacements,CacheDirectory,CanonicalProduct]
];


TBConstructVertexBasis[
	BasisName_String,
{RequiredGroups___List},
	Vertex_List,
	VertexStructure_,
	Comment_String,
	Author_String,
	Usage_,
	{Indices__List},
	MomentumConservation_List,
	{Tensors__List},
	Replacements_List,
	CacheDirectory_String:"./TBCache",
  CanonicalProduct_:Null
  ]:=Module[{reducedTensors,maximalSet,basis},
BeginPackage["TensorBases`"];
Begin["`Private`"];

If[MemberQ[TBAvailableBasisNames,BasisName],Print["Basis \""~~BasisName~~"\" has been already defined!"];Abort[]];

TBReplacements[BasisName]=Replacements;
TBIndices[BasisName]={Indices};
TBMomentumConservation[BasisName]=MomentumConservation;
TBVertex[BasisName]=Vertex;
TBVertexBasis[BasisName]=True;
TBAuthor[BasisName]=Author;
TBComment[BasisName]=Comment;
TBUsage[BasisName]=Usage;
TBCanonicalProduct[BasisName]=CanonicalProduct;
TBVertexStructure[BasisName]=VertexStructure;
TBRequiredGroups[BasisName]={RequiredGroups};

TBCheckRequirements[BasisName];

(*Build a maximal set by doing the tensor product*)
maximalSet=Flatten[TensorProduct@@{Tensors}]//.MomentumConservation;
(*If necessary, reduce it*)
TBBasis[BasisName]=ReduceTensorList[maximalSet,CanonicalProduct,{Indices}]//InsertInputNaming;

TBInternal[BasisName,"Indices"]=InsertOutputNaming[{Indices}];
TBInternal[BasisName,"Replacements"]=Replacements;
TBInternal[BasisName,"Length"]=TBBasisLength[BasisName];
TBInternal[BasisName,"InnerProduct"]=TBMakeInnerProduct[BasisName];
TBInternal[BasisName,"CanonicalProduct"]=TBMakeCanonicalProduct[BasisName];

TBInternal[BasisName,"Vertices"]=TBMakeVertices[BasisName]//InsertInputNaming;
TBInternal[BasisName,"Metric"]=TBBuildMetric[BasisName]//InsertInputNaming;
TBInternal[BasisName,"InverseMetric"]=TBBuildInverseMetric[BasisName]//InsertInputNaming;
TBInternal[BasisName,"Projectors"]=TBBuildProjectors[BasisName]//InsertInputNaming;

Unprotect[TBGetBasisElement,TBGetMetric,TBGetInverseMetric,TBGetProjector,TBInfo,TBGetVertex,TBGetInnerProduct,TBGetCanonicalProduct];
TBUnDefineTBGetBasisElement[BasisName];
TBDefineTBGetVertex[BasisName];
TBDefineTBGetMetric[BasisName];
TBUnDefineTBGetInnerProduct[BasisName];
TBDefineTBGetCanonicalProduct[BasisName];
TBDefineTBGetInverseMetric[BasisName];
TBDefineTBGetProjector[BasisName];
TBDefineTBInfo[BasisName];
TBAddBasisDocumentation[BasisName];

Protect[TBGetBasisElement,TBGetMetric,TBGetInverseMetric,TBGetProjector,TBInfo,TBGetVertex,TBGetInnerProduct,TBGetCanonicalProduct];

TBPrint[BasisName~~": done.",1];

End[];
EndPackage[];
];


TBRestrictBasis[inBasisName_String, outBasisName_String, {indices__Integer},CacheDirectory_String:"./TBCache"]:=Module[{indexList},
If[Not@MemberQ[TBAvailableBasisNames,inBasisName],Print["Unknown Basis \""~~inBasisName~~"\"!"];Abort[]];
If[MemberQ[TBAvailableBasisNames,outBasisName],Print["Basis \""~~outBasisName~~"\" already exists!"];Abort[]];

indexList={indices} ;
If[Not@AllTrue[indexList,(#<=Length[TBInternal[inBasisName,"Basis"]])&],Print["Indices out of range!"];Abort[]];

BeginPackage["TensorBases`"];
Begin["`Private`"];
TBAutoDefine[outBasisName]=True;
TBRequiredGroups[outBasisName]=TBRequiredGroups[inBasisName];
TBVertex[outBasisName]=TBVertex[inBasisName];
TBVertexStructure[outBasisName]=TBVertexStructure[inBasisName];
TBVertexBasis[outBasisName]=TBVertexBasis[inBasisName];
TBInnerProduct[outBasisName]=TBInnerProduct[inBasisName];
TBCanonicalProduct[outBasisName]=TBCanonicalProduct[inBasisName];
TBComment[outBasisName]=TBComment[inBasisName];
TBAuthor[outBasisName]=TBAuthor[inBasisName];
TBUsage[outBasisName]=TBUsage[inBasisName];
TBIndices[outBasisName]=TBIndices[inBasisName];
TBMomentumConservation[outBasisName]=TBMomentumConservation[inBasisName];
TBBasis[outBasisName]=Map[TBBasis[inBasisName][[#]]&,indexList];

Unprotect[TBGetBasisElement,TBGetMetric,TBGetInverseMetric,TBGetProjector,TBInfo,TBGetVertex,TBGetInnerProduct,TBGetCanonicalProduct];
TBAutoDefineBasisNoLoad[outBasisName,CacheDirectory];
Protect[TBGetBasisElement,TBGetMetric,TBGetInverseMetric,TBGetProjector,TBInfo,TBGetVertex,TBGetInnerProduct,TBGetCanonicalProduct];
End[];
EndPackage[];
]


TBUnregister[BasisName_String]:=Module[{},
If[Not@MemberQ[TBAvailableBasisNames,BasisName],Print["Unknown Basis \""~~BasisName~~"\"!"];Abort[]];

TBAvailableBasisNames=DeleteCases[TBAvailableBasisNames,BasisName];
]


TBImportBasis[BasisDefinitionFile_String,CacheDirectory_String:"./TBCache"]:=Module[
{BasisName=GetBasisName[BasisDefinitionFile]},
If[MemberQ[TBAvailableBasisNames,BasisName],Print["Basis \""~~BasisName~~"\" already exists! If you wish to overwrite it, use \!\(\*
StyleBox[\"TBUnregister\",\nFontColor->RGBColor[1, 0.5, 0]]\)."];Abort[]];

BeginPackage["TensorBases`"];
Begin["`Private`"];
Unprotect[TBGetBasisElement,TBGetMetric,TBGetInverseMetric,TBGetProjector,TBInfo,TBGetVertex,TBGetInnerProduct,TBGetCanonicalProduct];
TBAutoDefineBasis[BasisDefinitionFile,CacheDirectory];
Protect[TBGetBasisElement,TBGetMetric,TBGetInverseMetric,TBGetProjector,TBInfo,TBGetVertex,TBGetInnerProduct,TBGetCanonicalProduct];
End[];
EndPackage[];
]


TBExportTensorCache[BasisName_String,CacheFolder_String:"./TBCache"]:=Module[{},
If[Not@MemberQ[TBAvailableBasisNames,BasisName],Print["Unknown Basis \""~~BasisName~~"\"!"];Abort[]];

BeginPackage["TensorBases`"];
Begin["`Private`"];
Export[CacheFolder~~"/"~~BasisName~~"/basis.m",TBInternal[BasisName,"Basis"]];
Export[CacheFolder~~"/"~~BasisName~~"/vertices.m",TBInternal[BasisName,"Vertices"]];
Export[CacheFolder~~"/"~~BasisName~~"/metric.m",TBInternal[BasisName,"Metric"]];
Export[CacheFolder~~"/"~~BasisName~~"/inverseMetric.m",TBInternal[BasisName,"InverseMetric"]];
Export[CacheFolder~~"/"~~BasisName~~"/projectors.m",TBInternal[BasisName,"Projectors"]];
End[];
EndPackage[];
];

TBExportVertexCache[BasisName_String,CacheFolder_String:"./TBCache"]:=Module[{},
If[Not@MemberQ[TBAvailableBasisNames,BasisName],Print["Unknown Basis \""~~BasisName~~"\"!"];Abort[]];

BeginPackage["TensorBases`"];
Begin["`Private`"];
Export[CacheFolder~~"/"~~BasisName~~"/vertices.m",TBInternal[BasisName,"Vertices"]];
Export[CacheFolder~~"/"~~BasisName~~"/metric.m",TBInternal[BasisName,"Metric"]];
Export[CacheFolder~~"/"~~BasisName~~"/inverseMetric.m",TBInternal[BasisName,"InverseMetric"]];
Export[CacheFolder~~"/"~~BasisName~~"/projectors.m",TBInternal[BasisName,"Projectors"]];
End[];
EndPackage[];
];

TBExportCache[BasisName_String,CacheFolder_String:"./TBCache"]:=Module[{},
If[Not@MemberQ[TBAvailableBasisNames,BasisName],Print["Unknown Basis \""~~BasisName~~"\"!"];Abort[]];

If[TBVertexBasis[BasisName],
TBExportVertexCache[BasisName,CacheFolder],
TBExportTensorCache[BasisName,CacheFolder]
]
];


TBExportTensorBasis[BasisName_String,folder_String:"./"]:=Module[{outputCode},
If[Not@MemberQ[TBAvailableBasisNames,BasisName],Print["Unknown Basis \""~~BasisName~~"\"!"];Abort[]];

BeginPackage["TensorBases`"];
Begin["`Private`"];
outputCode="(* Basis Export from TensorBases package *)

TBAutoDefine[\""<>BasisName<>"\"]="<>ToString[TBAutoDefine[BasisName],FormatType->InputForm]<>";

TBRequiredGroups[\""<>BasisName<>"\"]="<>ToString[TBRequiredGroups[BasisName],FormatType->InputForm]<>";

TBVertex[\""<>BasisName<>"\"]="<>ToString[TBVertex[BasisName],FormatType->InputForm]<>";

TBVertexBasis[\""<>BasisName<>"\"]=False;

TBVertexStructure[\""<>BasisName<>"\"]="<>ToString[TBVertexStructure[BasisName],FormatType->InputForm]<>";

TBInnerProduct[\""<>BasisName<>"\"]="<>ToString[TBInnerProduct[BasisName],FormatType->InputForm]<>";

TBComment[\""<>BasisName<>"\"]="<>ToString[TBComment[BasisName],FormatType->InputForm]<>";

TBAuthor[\""<>BasisName<>"\"]="<>ToString[TBAuthor[BasisName],FormatType->InputForm]<>";

TBUsage[\""<>BasisName<>"\"]="<>ToString[TBUsage[BasisName],FormatType->InputForm]<>";

TBIndices[\""<>BasisName<>"\"]="<>ToString[TBIndices[BasisName],FormatType->InputForm]<>";

TBMomentumConservation[\""<>BasisName<>"\"]="<>ToString[TBMomentumConservation[BasisName],FormatType->InputForm]<>";

TBBasis[\""<>BasisName<>"\"]="<>ToString[TBBasis[BasisName],FormatType->InputForm]<>";
";
Export[folder~~"/"~~BasisName~~".m",outputCode,"Text"];

End[];
EndPackage[];
];

TBExportVertexBasis[BasisName_String,folder_String:"./"]:=Module[{outputCode},
If[Not@MemberQ[TBAvailableBasisNames,BasisName],Print["Unknown Basis \""~~BasisName~~"\"!"];Abort[]];

BeginPackage["TensorBases`"];
Begin["`Private`"];
outputCode="(* Basis Export from TensorBases package *)

TBAutoDefine[\""<>BasisName<>"\"]="<>ToString[TBAutoDefine[BasisName],FormatType->InputForm]<>";

TBRequiredGroups[\""<>BasisName<>"\"]="<>ToString[TBRequiredGroups[BasisName],FormatType->InputForm]<>";

TBVertex[\""<>BasisName<>"\"]="<>ToString[TBVertex[BasisName],FormatType->InputForm]<>";

TBVertexBasis[\""<>BasisName<>"\"]="<>ToString[TBVertexBasis[BasisName],FormatType->InputForm]<>";

TBCanonicalProduct[\""<>BasisName<>"\"]="<>ToString[TBCanonicalProduct[BasisName],FormatType->InputForm]<>";

TBComment[\""<>BasisName<>"\"]="<>ToString[TBComment[BasisName],FormatType->InputForm]<>";

TBAuthor[\""<>BasisName<>"\"]="<>ToString[TBAuthor[BasisName],FormatType->InputForm]<>";

TBUsage[\""<>BasisName<>"\"]="<>ToString[TBUsage[BasisName],FormatType->InputForm]<>";

TBIndices[\""<>BasisName<>"\"]="<>ToString[TBIndices[BasisName],FormatType->InputForm]<>";

TBMomentumConservation[\""<>BasisName<>"\"]="<>ToString[TBMomentumConservation[BasisName],FormatType->InputForm]<>";

TBBasis[\""<>BasisName<>"\"]="<>ToString[TBBasis[BasisName],FormatType->InputForm]<>";
";
Export[folder~~"/"~~BasisName~~".m",outputCode,"Text"];
End[];
EndPackage[];
];

TBExportBasis[BasisName_String,folder_String:"./"]:=Module[{outputCode},
If[Not@MemberQ[TBAvailableBasisNames,BasisName],Print["Unknown Basis \""~~BasisName~~"\"!"];Abort[]];

If[TBVertexBasis[BasisName],
TBExportVertexBasis[BasisName,folder],
TBExportTensorBasis[BasisName,folder]
]
];


ClearCache[BasisDefinitionFile_String]:=Module[{BasisName=GetBasisName[BasisDefinitionFile]},
If[Global`TBRebuildCache===True,
TBPrint["Removing cache in "~~TBDirectory~~"cache/"~~BasisName~~"/",1];
DeleteDirectory[TBDirectory~~"cache/"~~BasisName~~"/",DeleteContents->True]//Quiet;
];
];


ProcessBases[]:=Module[{startTime,endTime},
startTime=AbsoluteTime[];
TBPrint["\n\n  \!\(\*
StyleBox[\"Started\",\nFontSize->14]\)\!\(\*
StyleBox[\" \",\nFontSize->14]\)\!\(\*
StyleBox[\"processing\",\nFontSize->14]\)\!\(\*
StyleBox[\" \",\nFontSize->14]\)\!\(\*
StyleBox[\"of\",\nFontSize->14]\)\!\(\*
StyleBox[\" \",\nFontSize->14]\)\!\(\*
StyleBox[\"bases\",\nFontSize->14]\)\!\(\*
StyleBox[\".\",\nFontSize->14]\)",1];

If[Head[Global`TBBasisList]===List,
basisDefinitionFiles=Flatten[Map[FileNames[ToString[#]~~".m",TBDirectory~~"bases/"]&,Global`TBBasisList]],
basisDefinitionFiles=FileNames[__~~".m",TBDirectory~~"bases/"]
];

TBPrint[{"Processing files: ",TableForm[basisDefinitionFiles]},1];

TBAvailableBasisNames={};
TBBasisDocs={};
Unprotect[TBGetBasisElement,TBGetMetric,TBGetInverseMetric,TBGetProjector,TBInfo,TBGetVertex,TBGetInnerProduct,TBGetCanonicalProduct];
ClearCache/@basisDefinitionFiles;
TBAutoDefineBasis/@basisDefinitionFiles;
Protect[TBGetBasisElement,TBGetMetric,TBGetInverseMetric,TBGetProjector,TBInfo,TBGetVertex,TBGetInnerProduct,TBGetCanonicalProduct];

endTime=AbsoluteTime[];

TBPrint["\n-------------------------------\n",1];
TBPrint["  \!\(\*
StyleBox[\"Basis\",\nFontSize->14]\)\!\(\*
StyleBox[\" \",\nFontSize->14]\)\!\(\*
StyleBox[\"processing\",\nFontSize->14]\)\!\(\*
StyleBox[\" \",\nFontSize->14]\)finished after "~~ToString[Round[(endTime-startTime)/60]]~~"min\!\(\*
StyleBox[\".\",\nFontSize->14]\)",1]
TBPrint["",1];
];


If[Global`TBSkipBaseProcessing=!=True,
ProcessBases[]
];


TBBasisTransformation::vertex="Either the basis \"`1`\" or \"`2`\" is a pure vertex basis. Cannot infer the basis elements from the vertices!"; 

TBBasisTransformation[BasisName1_String,BasisName2_String]:=Module[
{isVertex=TBVertexBasis[BasisName1]||TBVertexBasis[BasisName1],
cProd,cProd1,cMetric12,cMetric11,cMetric11Inv,momentumConservation},
(*
   The projection operator to get Subscript[b, i] from a vector |v\[RightAngleBracket]=Subscript[\[CapitalSigma], i]Subscript[b, i]|i\[RightAngleBracket] reads (\[LeftAngleBracket]i'\[VerticalSeparator]i\[RightAngleBracket])^-1\[LeftAngleBracket]i'|.
Accordingly, to get Subscript[b, i] from |v\[RightAngleBracket]=Subscript[\[CapitalSigma], i]Subscript[b, i]|i\[RightAngleBracket]=Subscript[\[CapitalSigma], a]Subscript[c, a]|a\[RightAngleBracket], if given the representation in terms of Subscript[c, a], the transformation matrix reads (\[LeftAngleBracket]i'\[VerticalSeparator]i\[RightAngleBracket])^-1\[LeftAngleBracket]i'\[VerticalSeparator]a\[RightAngleBracket] = cMetric11Inv.cMetric12, as calculated below.
*)

If[isVertex,Message[TBBasisTransformation::vertex,BasisName1,BasisName2];Abort[]];

cProd=TBMakeCanonicalProduct[BasisName1,BasisName2];
cProd1=TBMakeCanonicalProduct[BasisName1,BasisName1];

momentumConservation=InsertOutputNaming[TBMomentumConservation[BasisName1]];

cMetric12=Table[
(cProd[TBGetBasisElement,i,TBGetBasisElement,j])//.momentumConservation
,
{i,1,TBGetBasisSize[BasisName1]},{j,1,TBGetBasisSize[BasisName2]}];
cMetric12=Map[
Simplify[Global`UseLorentzLinearity[TBFormTrace[#]]]&
,
cMetric12,{2}];

cMetric11=Table[
(cProd1[TBGetBasisElement,i,TBGetBasisElement,j])//.momentumConservation
,
{i,1,TBGetBasisSize[BasisName1]},{j,1,TBGetBasisSize[BasisName1]}];
cMetric11=Map[
Simplify[Global`UseLorentzLinearity[Simplify[TBFormTrace[#]]]]&
,
cMetric11,{2}];
cMetric11Inv=Inverse[cMetric11];

ParallelMap[Simplify,cMetric11Inv . cMetric12,{2}]
];
TBVertexTransformation[BasisName1_String,BasisName2_String]:=Module[
{cProd,cProd1,cMetric12,cMetric11,cMetric11Inv,momentumConservation},
(*
   The projection operator to get Subscript[b, i] from a vector |v\[RightAngleBracket]=Subscript[\[CapitalSigma], i]Subscript[b, i]|i\[RightAngleBracket] reads (\[LeftAngleBracket]i'\[VerticalSeparator]i\[RightAngleBracket])^-1\[LeftAngleBracket]i'|.
Accordingly, to get Subscript[b, i] from |v\[RightAngleBracket]=Subscript[\[CapitalSigma], i]Subscript[b, i]|i\[RightAngleBracket]=Subscript[\[CapitalSigma], a]Subscript[c, a]|a\[RightAngleBracket], if given the representation in terms of Subscript[c, a], the transformation matrix reads (\[LeftAngleBracket]i'\[VerticalSeparator]i\[RightAngleBracket])^-1\[LeftAngleBracket]i'\[VerticalSeparator]a\[RightAngleBracket] = cMetric11Inv.cMetric12, as calculated below.
*)

cProd=TBMakeCanonicalProduct[BasisName1,BasisName2];
cProd1=TBMakeCanonicalProduct[BasisName1,BasisName1];

momentumConservation=InsertOutputNaming[TBMomentumConservation[BasisName1]];

cMetric12=Table[
(cProd[TBGetVertex,i,TBGetVertex,j])//.momentumConservation
,
{i,1,TBGetBasisSize[BasisName1]},{j,1,TBGetBasisSize[BasisName2]}];

cMetric12=ParallelMap[
Simplify[Global`UseLorentzLinearity[TBFormTrace[#]]]&
,
cMetric12,{2}];

cMetric11=Table[
(cProd1[TBGetVertex,i,TBGetVertex,j])//.momentumConservation
,
{i,1,TBGetBasisSize[BasisName1]},{j,1,TBGetBasisSize[BasisName1]}];
cMetric11=ParallelMap[
Simplify[Global`UseLorentzLinearity[TBFormTrace[#]]]&
,
cMetric11,{2}];
cMetric11Inv=Inverse[cMetric11];

ParallelMap[Simplify,cMetric11Inv . cMetric12,{2}]
];


TBGetIdentityMatrix[BasisName_String]:=Module[{},
If[Not@MemberQ[TBAvailableBasisNames,BasisName],Print["Unknown Basis \""~~BasisName~~"\"!"];Abort[]];

Return[
(TBGetIdentityMatrix[BasisName,##]&)@@TBInternal[BasisName,"Indices"]
];
];


TBGetIndexSet[BasisName_String,id_Integer,p_]:=Module[{indices},
If[Not@MemberQ[TBAvailableBasisNames,BasisName],Print["Unknown Basis \""~~BasisName~~"\"!"];Abort[]];
If[id>Length[TBInternal[BasisName,"Indices"]],Print["Basis \""~~BasisName~~"\" has only "~~ToString[Length[TBInternal[BasisName,"Indices"]]]~~" elements!";]Abort[]];
indices=TBInternal[BasisName,"Indices"][[id]];
Return[
Join[{p},
Map[Unique[SymbolName[#]]&,indices[[2;;]]]
]
];
];
TBGetIndexSet[set_List,p_]:=Module[{},
Return[Join[{p},set[[2;;]]]];
];


TBGetIdentityMatrix[BasisName_String,indices___]:=Module[
{groups,diracIndices,lorentzIndices,fundIndices,adjIndices,
idxList,originalIndices,newIndices,replacements,
chooseDelta,deltas},
If[Not@MemberQ[TBAvailableBasisNames,BasisName],Print["Unknown Basis \""~~BasisName~~"\"!"];Abort[]];
If[Length[TBInternal[BasisName,"Indices"]]=!=2,
Print["Can only create an identity matrix for two-point functions!"];Abort[]
];

groups=If[Length[Flatten@TBRequiredGroups[BasisName]]>0
,
Map[Symbol[SymbolName[#]]&,TBRequiredGroups[BasisName][[All,1]]]
,
{}
];

diracIndices=FormTracer`GetOpenDiracIndices[InsertOutputNaming@TBInternal[BasisName,"Vertices"][[1]]];
lorentzIndices=FormTracer`GetOpenLorentzIndices[InsertOutputNaming@TBInternal[BasisName,"Vertices"][[1]]];
fundIndices=Map[FormTracer`GetOpenFundGroupIndices[InsertOutputNaming@TBInternal[BasisName,"Vertices"][[1]],#]&,groups];
adjIndices=Map[FormTracer`GetOpenAdjGroupIndices[InsertOutputNaming@TBInternal[BasisName,"Vertices"][[1]],#]&,groups];

chooseDelta[i_,j_]:=Module[{idx},
If[MemberQ[diracIndices,i],
Return[TBdeltaDirac[i,j]];
];
If[MemberQ[lorentzIndices,i],
Return[TBdeltaLorentz[i,j]];
];
For[idx=1,idx<=Length[groups],idx++,
If[MemberQ[fundIndices[[idx]],i],
Return[TBdeltaFund[groups[[idx]],i,j]];
];
];
For[idx=1,idx<=Length[groups],idx++,
If[MemberQ[adjIndices[[idx]],i],
Return[TBdeltaAdj[groups[[idx]],i,j]];
];
];
];

originalIndices=TBInternal[BasisName,"Indices"];
idxList=MakeIndexList[TBInternal[BasisName,"Indices"]//Length,indices];
newIndices=Flatten[idxList];
replacements=Thread[Flatten[originalIndices]->newIndices];

deltas=Map[chooseDelta[#[[1]],#[[2]]]&,Transpose[originalIndices][[2;;]]];

Return[
Times@@deltas/.replacements//InsertOutputNaming
];
];


TBGetBasisSize[BasisName_String]:=Module[{},
If[Not@MemberQ[TBAvailableBasisNames,BasisName],Print["Unknown Basis \""~~BasisName~~"\"!"];Abort[]];
Return[Length[TBInternal[BasisName,"Vertices"]]];
];


TBGetBasisFields[BasisName_String]:=Module[{},
If[Not@MemberQ[TBAvailableBasisNames,BasisName],Print["Unknown Basis \""~~BasisName~~"\"!"];Abort[]];
Return[InsertOutputNaming@TBVertex[BasisName]];
];


exclusions[a_]:=And@@{a=!=List,a=!=Complex,a=!=Plus,a=!=Power}
GetAllSymbols[expr_]:=DeleteDuplicates@Cases[Flatten[{expr}//.Times[a_,b__]:>{a,b}/.a_Symbol[b__]/;exclusions[a]:>{a,b}],_Symbol,Infinity]


TBGetProjector[BasisName,i,idxSet2,idxSet1]


GetIdentityVector[BasisName_,p_]:=Module[{idxSet1,idxSet2},
idxSet1=TBGetIndexSet[BasisName,1,p];
idxSet2=TBGetIndexSet[BasisName,1,p];

Table[
TBFormTrace[
TBGetProjector[BasisName,i,idxSet2,idxSet1]TBGetIdentityMatrix[BasisName,idxSet1,idxSet2]
]//FullSimplify,
{i,1,TBGetBasisSize[BasisName]}
]//Return;
];


TBGetBasis[BasisName_String]:=Module[{},
Return[
TBGetBasis[BasisName,##]&@@TBInternal[BasisName,"Indices"]
];
];

TBGetBasis[BasisName_String,indices___]:=Module[{
idxList,originalIndices,newIndices,replacements,
rawBasis,fixIndices
},

fixIndices[expr_]:=Module[{closedIndices,IndexReplacements},
closedIndices=FormTracer`GetClosedIndices[InsertOutputNaming@expr];
IndexReplacements:=Thread[closedIndices->Map[TBUnique,closedIndices]];
Return[expr//.IndexReplacements];
];

originalIndices=TBInternal[BasisName,"Indices"];
idxList=MakeIndexList[TBInternal[BasisName,"Indices"]//Length,indices];
newIndices=Flatten[idxList];
replacements=Thread[Flatten[originalIndices]->newIndices];

rawBasis=Map[fixIndices,InsertOutputNaming@TBInternal[BasisName,"Basis"]];

Return[rawBasis//.replacements]
];


TBMakePropagator[BasisName_String,InvProp_List]:=Module[{
idxSet1,idxSet2,idxSet3,invPropR,
Prop,T2,T3,
projections,idvec,identities,solution,
makeList,b,A,p
},

p=TBInternal[BasisName,"Indices"][[1,1]];

idxSet1=TBGetIndexSet[BasisName,1,p];
idxSet2=TBGetIndexSet[BasisName,1,p];
idxSet3=TBGetIndexSet[BasisName,1,p];

invPropR=Map[Unique["a"]&,InvProp];

Prop=Table[Unique["v"<>ToString[i]],{i,1,TBGetBasisSize[BasisName]}];
FormTracer`AddExtraVars@@(GetAllSymbols[Prop]\[Union]GetAllSymbols[invPropR]);

T2=Table[TBGetVertex[BasisName,i,{p,idxSet2[[2;;]]},{-p,idxSet3[[2;;]]}],{i,1,TBGetBasisSize[BasisName]}];
T3=Table[TBGetVertex[BasisName,i,{-p,idxSet3[[2;;]]},{p,idxSet1[[2;;]]}],{i,1,TBGetBasisSize[BasisName]}];

idvec=GetIdentityVector[BasisName,p];

projections=Table[
TBFormTrace[
TBGetProjector[BasisName,i,{p,idxSet1[[2;;]]},{-p,idxSet2[[2;;]]}](Prop . T2) (invPropR . T3)//InsertInputNaming
]//FullSimplify
,{i,1,TBGetBasisSize[BasisName]}
];

makeList[expr_]:=If[Head[expr]===Plus,List@@expr,{expr}];

identities=Map[(#[[1]]==#[[2]])&,Transpose[{projections,idvec}]];
{b,A}=CoefficientArrays[identities,Prop];

solution=LinearSolve[A,-b];

Return[solution/.Thread[invPropR->InvProp]];
];

TBMakePropagator[BasisName_String,InvProp_List,p_]:=Module[{prop},
prop=TBMakePropagator[BasisName,InvProp];
Return[prop/.TBInternal[BasisName,"Indices"][[1,1]]:>p];
]


Unprotect@TBInfo;
TBInfo["Momenta"]:=Print["Currently, the \!\(\*
StyleBox[\"TensorBases\",\nFontWeight->\"Bold\"]\)\!\(\*
StyleBox[\" \",\nFontWeight->\"Bold\"]\)package implements the following momentum transformations:
\!\(\*
StyleBox[\"Projections\",\nFontWeight->\"Bold\"]\)\!\(\*
StyleBox[\":\",\nFontWeight->\"Bold\"]\)\n\!\(\*
StyleBox[\"TBProjectToSymmetricPoint\",\nFontColor->RGBColor[1, 0.5, 0]]\),\!\(\*
StyleBox[\"TBProjectToSymmetricPointSpatial\",\nFontColor->RGBColor[1, 0.5, 0]]\)
\!\(\*
StyleBox[\"Three\",\nFontWeight->\"Bold\"]\)\!\(\*
StyleBox[\"-\",\nFontWeight->\"Bold\"]\)\!\(\*
StyleBox[\"Point\",\nFontWeight->\"Bold\"]\)\!\(\*
StyleBox[\" \",\nFontWeight->\"Bold\"]\)\!\(\*
StyleBox[\"functions\",\nFontWeight->\"Bold\"]\)\!\(\*
StyleBox[\":\",\nFontWeight->\"Bold\"]\)\n\!\(\*
StyleBox[\"TB3PToS0S1SPhi\",\nFontColor->RGBColor[1, 0.5, 0]]\), \!\(\*
StyleBox[\"TB3PToS0S1SPhi\",\nFontColor->RGBColor[1, 0.5, 0]]\)\!\(\*
StyleBox[\",\",\nFontColor->RGBColor[1, 0.5, 0]]\)\!\(\*
StyleBox[\"TB3PFromS0as\",\nFontColor->RGBColor[1, 0.5, 0]]\)\!\(\*
StyleBox[\",\",\nFontColor->RGBColor[1, 0.5, 0]]\)\!\(\*
StyleBox[\"TB3PToS0as\",\nFontColor->RGBColor[1, 0.5, 0]]\)\!\(\*
StyleBox[\",\",\nFontColor->RGBColor[1, 0.5, 0]]\)\!\(\*
StyleBox[\"TB3PFromS0S1SPhiQk\",\nFontColor->RGBColor[1, 0.5, 0]]\)\!\(\*
StyleBox[\",\",\nFontColor->RGBColor[1, 0.5, 0]]\)\!\(\*
StyleBox[\"TB3PToS0S1SPhiQk\",\nFontColor->RGBColor[1, 0.5, 0]]\)
"];
Protect@TBInfo;


TBProjectToSymmetricPoint[expr_,q_Symbol,p_Symbol,momenta___Symbol]:=Module[
{momentaList,nMomenta,rules,qf,
conv=InsertOutputNaming},
momentaList={momenta};
nMomenta=Length[momentaList];
qf=Symbol[ToString[q]<>"f"];
rules=Map[conv@TBsp[#[[1]],#[[2]]]->-(1/(nMomenta-1))conv@TBsp[p,p]&,Subsets[momentaList,{2}]]
\[Union]Map[conv@TBsp[#,#]->conv@TBsp[p,p]&,momentaList]
\[Union]Map[conv@TBsp[#,q]->Symbol["cos"~~StringJoin@(ToString/@Sort[{#,q}])] p q&,momentaList[[1;;nMomenta-1]]]
\[Union]Map[conv@TBsp[#,qf]->Symbol["cos"~~StringJoin@(ToString/@Sort[{#,qf}])] p qf&,momentaList[[1;;nMomenta-1]]]
\[Union]{momentaList[[nMomenta]]->-Total[momentaList[[1;;nMomenta-1]]]};
Global`UseLorentzLinearity[expr]//.rules
]


separateScalarProductsSpatial[expr_]:=Module[{conv=InsertOutputNaming,repl},
repl={
Head[conv[TBsp[a,b]]][q_,p_]:>conv[TBsps[q,p]+TBvec[q,0]TBvec[p,0]],
Head[conv[TBvec[a,b]]][p_,mu_/;mu=!=0]:>conv[TBvecs[p,mu]+TBdeltaLorentz[mu,0]TBvec[p,0]]
};
Global`UseLorentzLinearity[expr]//.repl
]


TBProjectToSymmetricPointSpatial[expr_,q_Symbol,p_Symbol,momenta___Symbol]:=Module[
{momentaList,nMomenta,rules,qf,out,
conv=InsertOutputNaming},
momentaList={momenta};
nMomenta=Length[momentaList];
qf=Symbol[ToString[q]<>"f"];
rules=Map[conv@TBsps[#[[1]],#[[2]]]->-(1/(nMomenta-1))conv@TBsps[p,p]&,Subsets[momentaList,{2}]]
\[Union]Map[conv@TBsps[#,#]->conv@TBsps[p,p]&,momentaList]
\[Union]Map[conv@TBsps[#,q]->Symbol["cos"~~StringJoin@(ToString/@Sort[conv@{#,q}])] p q&,momentaList[[1;;nMomenta-1]]]
\[Union]Map[conv@TBsps[#,qf]->Symbol["cos"~~StringJoin@(ToString/@Sort[conv@{#,qf}])] p qf&,momentaList[[1;;nMomenta-1]]]
\[Union]{momentaList[[nMomenta]]->-Total[momentaList[[1;;nMomenta-1]]]};
out=separateScalarProductsSpatial[Global`UseLorentzLinearity[expr]]//.rules;
Global`UseLorentzLinearity[out]//.rules
]


TB3PToS0S1SPhi[p1_Symbol,p2_Symbol,p3_Symbol,q_Symbol,S0_Symbol,S1_Symbol,SPhi_Symbol]:=Module[
{change,rules,conv=InsertOutputNaming,
vec4,Qvec,kvec,qvec,ruleqk,ruleqQ,
t,xi,a,s,z,Q,k},

System`$Assumptions=System`$Assumptions&&S0>0&&1>=S1>0&&-\[Pi]<SPhi<=\[Pi];


vec4[\[CapitalTheta]1_,\[CapitalTheta]2_,\[Phi]_]:={Cos[\[CapitalTheta]1],Sin[\[CapitalTheta]1]Cos[\[CapitalTheta]2],Sin[\[CapitalTheta]1]Sin[\[CapitalTheta]2]Cos[\[Phi]],Sin[\[CapitalTheta]1]Sin[\[CapitalTheta]2]Sin[\[Phi]]};
Qvec=Sqrt[sp[Q,Q]]{1,0,0,0};
kvec=Sqrt[sp[k,k]]{sp[k,Q]/(\[Sqrt](sp[Q,Q]sp[k,k])),\[Sqrt](1-(sp[k,Q]/(\[Sqrt](sp[Q,Q]sp[k,k])))^2),0,0};
qvec=q vec4[ArcCos[Symbol["cos1"]],ArcCos[Symbol["cos2"]],Symbol["phi"]];

ruleqk=FullSimplify[(kvec . qvec),Assumptions->$Assumptions&&-1<Symbol["cos1"]<=1&&-1<Symbol["cos2"]<=1&&0<=Symbol["phi"]<2\[Pi]];
ruleqQ=FullSimplify[(Qvec . qvec),Assumptions->$Assumptions&&-1<Symbol["cos1"]<=1&&-1<Symbol["cos2"]<=1&&0<=Symbol["phi"]<2\[Pi]];

change[expr_]:=Global`UseLorentzLinearity[conv[Evaluate[expr//.{
p1->Q,
p2->-k-Q/2,
p3->k-Q/2
}]]];

rules=Dispatch[
FullSimplify[
Global`UseLorentzLinearity[
conv[Evaluate[
{
TBsp[Q,Q]->4t,
TBsp[k,k]->3xi t,
TBsp[Q,k]->2Sqrt[3] Sqrt[t^2 xi]z,
TBsp[k,Q]->2Sqrt[3] Sqrt[t^2 xi]z,

TBsp[k,q]->ruleqk,
TBsp[q,k]->ruleqk,
TBsp[Q,q]->ruleqQ,
TBsp[q,Q]->ruleqQ
}//.{
t->(1-s)/4 S0^2,
xi->(1+s)/(1-s),
z->a/Sqrt[1-s^2]
}//.{
a->S1 Cos[SPhi],
s->S1 Sin[SPhi]
}
]]
],
Assumptions->System`$Assumptions&&sp[p1,p1]>=0&&sp[p2,p2]>=0&&sp[p3,p3]>=0&&0<=a<=1&&0<=s<=1&&S0>=0&&1>=S1>=0&&-\[Pi]<SPhi<=\[Pi]&&xi>=0
]
];
Return[
(change[#]//.rules)&
];
];


TB3PToS0S1SPhi[p1_Symbol,p2_Symbol,p3_Symbol,S0_Symbol,S1_Symbol,SPhi_Symbol]:=Module[
{change,rules,conv=InsertOutputNaming,
t,xi,a,s,z,Q,k},
System`$Assumptions=System`$Assumptions&&S0>0&&1>=S1>0&&-\[Pi]<SPhi<=\[Pi];
change[expr_]:=Global`UseLorentzLinearity[conv[Evaluate[expr//.{
p1->Q,
p2->-k-Q/2,
p3->k-Q/2
}]]];
rules=Dispatch[
FullSimplify[
Global`UseLorentzLinearity[
conv[Evaluate[
{
TBsp[Q,Q]->4t,
TBsp[k,k]->3xi t,
TBsp[Q,k]->2Sqrt[3] Sqrt[t^2 xi]z,
TBsp[k,Q]->2Sqrt[3] Sqrt[t^2 xi]z
}//.{
t->(1-s)/4 S0^2,
xi->(1+s)/(1-s),
z->a/Sqrt[1-s^2]
}//.{
a->S1 Cos[SPhi],
s->S1 Sin[SPhi]
}
]]
],
Assumptions->System`$Assumptions&&sp[p1,p1]>=0&&sp[p2,p2]>=0&&sp[p3,p3]>=0&&0<=a<=1&&0<=s<=1&&S0>=0&&1>=S1>=0&&-\[Pi]<SPhi<=\[Pi]&&xi>=0
]
];
Return[
(change[#]//.rules)&
];
];
TB3PFromS0S1SPhi[p1_Symbol,p2_Symbol,p3_Symbol,S0_Symbol,S1_Symbol,SPhi_Symbol]:=Module[
{rules,conv=InsertOutputNaming,
t,xi,a,s,z,Q,k},
rules=Dispatch[
FullSimplify[
Global`UseLorentzLinearity[
conv[Evaluate[
{
S0->Sqrt[2t(1+xi)],
S1->Sqrt[a^2+s^2],
SPhi->ArcTan[a,s]
}//.{
a->(2Sqrt[xi]z)/(xi+1),
s->(xi-1)/(xi+1)
}//.{
t->TBsp[Q,Q]/4,
xi->(4TBsp[k,k])/(3TBsp[Q,Q]),
z->TBsp[Q,k]/(\[Sqrt](TBsp[k,k]TBsp[Q,Q]))
}//.{
Q->p1,
k->(p3-p2)/2
}]]
],
Assumptions->System`$Assumptions&&sp[p1,p1]>=0&&sp[p2,p2]>=0&&sp[p3,p3]>=0&&0<=a<=1&&0<=s<=1&&S0>=0&&1>=S1>=0&&-\[Pi]<SPhi<=\[Pi]&&xi>=0
]
];
Return[
(#//.rules)&
];
];


TB3PToS0S1SPhiQk[Q_Symbol,k_Symbol,q_Symbol,S0_Symbol,S1_Symbol,SPhi_Symbol]:=Module[
{rules,conv=InsertOutputNaming,
vec4,Qvec,kvec,qvec,ruleqk,ruleqQ,
t,xi,a,s,z},

System`$Assumptions=System`$Assumptions&&S0>0&&1>=S1>0&&-\[Pi]<SPhi<=\[Pi];


vec4[\[CapitalTheta]1_,\[CapitalTheta]2_,\[Phi]_]:={Cos[\[CapitalTheta]1],Sin[\[CapitalTheta]1]Cos[\[CapitalTheta]2],Sin[\[CapitalTheta]1]Sin[\[CapitalTheta]2]Cos[\[Phi]],Sin[\[CapitalTheta]1]Sin[\[CapitalTheta]2]Sin[\[Phi]]};
Qvec=Sqrt[sp[Q,Q]]{1,0,0,0};
kvec=Sqrt[sp[k,k]]{sp[k,Q]/(\[Sqrt](sp[Q,Q]sp[k,k])),\[Sqrt](1-(sp[k,Q]/(\[Sqrt](sp[Q,Q]sp[k,k])))^2),0,0};
qvec=q vec4[ArcCos[Symbol["cos1"]],ArcCos[Symbol["cos2"]],Symbol["phi"]];

ruleqk=FullSimplify[(kvec . qvec),Assumptions->$Assumptions&&-1<Symbol["cos1"]<=1&&-1<Symbol["cos2"]<=1&&0<=Symbol["phi"]<2\[Pi]];
ruleqQ=FullSimplify[(Qvec . qvec),Assumptions->$Assumptions&&-1<Symbol["cos1"]<=1&&-1<Symbol["cos2"]<=1&&0<=Symbol["phi"]<2\[Pi]];

rules=Dispatch[
FullSimplify[
Global`UseLorentzLinearity[
conv[Evaluate[
{
TBsp[Q,Q]->4t,
TBsp[k,k]->3xi t,
TBsp[Q,k]->2Sqrt[3] Sqrt[t^2 xi]z,
TBsp[k,Q]->2Sqrt[3] Sqrt[t^2 xi]z,

TBsp[k,q]->ruleqk,
TBsp[q,k]->ruleqk,
TBsp[Q,q]->ruleqQ,
TBsp[q,Q]->ruleqQ
}//.{
t->(1-s)/4 S0^2,
xi->(1+s)/(1-s),
z->a/Sqrt[1-s^2]
}//.{
a->S1 Cos[SPhi],
s->S1 Sin[SPhi]
}
]]
],
Assumptions->System`$Assumptions&&sp[p1,p1]>=0&&sp[p2,p2]>=0&&sp[p3,p3]>=0&&0<=a<=1&&0<=s<=1&&S0>=0&&1>=S1>=0&&-\[Pi]<SPhi<=\[Pi]&&xi>=0
]
];
Return[
(#//.rules)&
];
];


TB3PToS0S1SPhiQk[Q_Symbol,k_Symbol,S0_Symbol,S1_Symbol,SPhi_Symbol]:=Module[
{rules,conv=InsertOutputNaming,
t,xi,a,s,z},
System`$Assumptions=System`$Assumptions&&S0>0&&1>=S1>0&&-\[Pi]<SPhi<=\[Pi];

rules=Dispatch[
FullSimplify[
Global`UseLorentzLinearity[
conv[Evaluate[
{
TBsp[Q,Q]->4t,
TBsp[k,k]->3xi t,
TBsp[Q,k]->2Sqrt[3] Sqrt[t^2 xi]z,
TBsp[k,Q]->2Sqrt[3] Sqrt[t^2 xi]z
}//.{
t->(1-s)/4 S0^2,
xi->(1+s)/(1-s),
z->a/Sqrt[1-s^2]
}//.{
a->S1 Cos[SPhi],
s->S1 Sin[SPhi]
}
]]
],
Assumptions->System`$Assumptions&&sp[p1,p1]>=0&&sp[p2,p2]>=0&&sp[p3,p3]>=0&&0<=a<=1&&0<=s<=1&&S0>=0&&1>=S1>=0&&-\[Pi]<SPhi<=\[Pi]&&xi>=0
]
];
Return[
(#//.rules)&
];
];
TB3PFromS0S1SPhiQk[Q_Symbol,k_Symbol,S0_Symbol,S1_Symbol,SPhi_Symbol]:=Module[
{rules,conv=InsertOutputNaming,
t,xi,a,s,z},
rules=Dispatch[
FullSimplify[
Global`UseLorentzLinearity[
conv[Evaluate[
{
S0->Sqrt[2t(1+xi)],
S1->Sqrt[a^2+s^2],
SPhi->ArcTan[a,s]
}//.{
a->(2Sqrt[xi]z)/(xi+1),
s->(xi-1)/(xi+1)
}//.{
t->TBsp[Q,Q]/4,
xi->(4TBsp[k,k])/(3TBsp[Q,Q]),
z->TBsp[Q,k]/(\[Sqrt](TBsp[k,k]TBsp[Q,Q]))
}]]
],
Assumptions->System`$Assumptions&&sp[p1,p1]>=0&&sp[p2,p2]>=0&&sp[p3,p3]>=0&&0<=a<=1&&0<=s<=1&&S0>=0&&1>=S1>=0&&-\[Pi]<SPhi<=\[Pi]&&xi>=0
]
];
Return[
(#//.rules)&
];
];


TB3PToS0as[p1_Symbol,p2_Symbol,p3_Symbol,q_Symbol,S0_Symbol,a_Symbol,s_Symbol]:=Module[
{change,rules,conv=InsertOutputNaming,
vec4,Qvec,kvec,qvec,ruleqk,ruleqQ,
t,xi,z,Q,k},
System`$Assumptions=System`$Assumptions&&S0>0&&1>=a>=0&&0<=s<=1;

vec4[\[CapitalTheta]1_,\[CapitalTheta]2_,\[Phi]_]:={Cos[\[CapitalTheta]1],Sin[\[CapitalTheta]1]Cos[\[CapitalTheta]2],Sin[\[CapitalTheta]1]Sin[\[CapitalTheta]2]Cos[\[Phi]],Sin[\[CapitalTheta]1]Sin[\[CapitalTheta]2]Sin[\[Phi]]};
Qvec=Sqrt[sp[Q,Q]]{1,0,0,0};
kvec=Sqrt[sp[k,k]]{sp[k,Q]/Sqrt[sp[Q,Q]sp[k,k]],Sqrt[1-(sp[k,Q]/Sqrt[sp[Q,Q]sp[k,k]])^2],0,0};
qvec=q vec4[ArcCos[Symbol["cos1"]],ArcCos[Symbol["cos2"]],Symbol["phi"]];

ruleqk=FullSimplify[(kvec . qvec),Assumptions->$Assumptions&&-1<Symbol["cos1"]<=1&&-1<Symbol["cos2"]<=1&&0<=Symbol["phi"]<2\[Pi]];
ruleqQ=FullSimplify[(Qvec . qvec),Assumptions->$Assumptions&&-1<Symbol["cos1"]<=1&&-1<Symbol["cos2"]<=1&&0<=Symbol["phi"]<2\[Pi]];

change[expr_]:=Global`UseLorentzLinearity[conv[Evaluate[expr//.{
p1->Q,
p2->-k-Q/2,
p3->k-Q/2
}]]];

rules=Dispatch[
FullSimplify[
Global`UseLorentzLinearity[
conv[Evaluate[
{
TBsp[Q,Q]->4t,
TBsp[k,k]->3xi t,
TBsp[Q,k]->2Sqrt[3] Sqrt[t^2 xi]z,
TBsp[k,Q]->2Sqrt[3] Sqrt[t^2 xi]z,

TBsp[k,q]->ruleqk,
TBsp[q,k]->ruleqk,
TBsp[Q,q]->ruleqQ,
TBsp[q,Q]->ruleqQ
}//.{
t->(1-s)/4 S0^2,
xi->(1+s)/(1-s),
z->a/Sqrt[1-s^2]
}
]]
],
Assumptions->System`$Assumptions&&sp[p1,p1]>=0&&sp[p2,p2]>=0&&sp[p3,p3]>=0&&0<=a<=1&&0<=s<=1&&S0>=0&&xi>=0
]
];
Return[
(change[#]//.rules)&
];
];


TB3PToS0as[p1_Symbol,p2_Symbol,p3_Symbol,S0_Symbol,a_Symbol,s_Symbol]:=Module[
{change,rules,conv=InsertOutputNaming,
t,xi,z,Q,k},
System`$Assumptions=System`$Assumptions&&S0>0&&1>=a>=0&&0<=s<=1;

change[expr_]:=Global`UseLorentzLinearity[conv[Evaluate[expr//.{
p1->Q,
p2->-k-Q/2,
p3->k-Q/2
}]]];
rules=Dispatch[
FullSimplify[
Global`UseLorentzLinearity[
conv[Evaluate[
{
TBsp[Q,Q]->4t,
TBsp[k,k]->3xi t,
TBsp[Q,k]->2Sqrt[3] Sqrt[t^2 xi]z,
TBsp[k,Q]->2Sqrt[3] Sqrt[t^2 xi]z
}//.{
t->(1-s)/4 S0^2,
xi->(1+s)/(1-s),
z->a/Sqrt[1-s^2]
}
]]
],
Assumptions->System`$Assumptions&&sp[p1,p1]>=0&&sp[p2,p2]>=0&&sp[p3,p3]>=0&&0<=a<=1&&0<=s<=1&&S0>=0&&xi>=0
]
];
Return[
(change[#]//.rules)&
];
];

TB3PFromS0as[p1_Symbol,p2_Symbol,p3_Symbol,S0_Symbol,a_Symbol,s_Symbol]:=Module[
{rules,conv=InsertOutputNaming,
t,xi,z,Q,k},
rules=Dispatch[
FullSimplify[
Global`UseLorentzLinearity[
conv[Evaluate[{
S0->Sqrt[2t(1+xi)],
a->(2Sqrt[xi]z)/(xi+1),
s->(xi-1)/(xi+1)
}//.{
t->TBsp[Q,Q]/4,
xi->(4TBsp[k,k])/(3TBsp[Q,Q]),
z->TBsp[Q,k]/Sqrt[TBsp[k,k]TBsp[Q,Q]]
}//.{
Q->p1,
k->(p3-p2)/2
}]]
],
Assumptions->System`$Assumptions&&sp[p1,p1]>=0&&sp[p2,p2]>=0&&sp[p3,p3]>=0&&0<=a<=1&&0<=s<=1&&S0>=0&&xi>=0
]
];
Return[
(#//.rules)&
];
];


Protect["TensorBases`*"];


End[];


EndPackage[];