(*================TTC.M: TOOLS OF TENSOR CALCULUS================= *) Print[" ----------------------------------------"] Print[" |TTC: Tools of Tensor Calculus 4.3.2|"] Print[" | A.Balfagon,P.Castellvi and X.Jaen |"] Print[" | http://baldufa.upc.edu/ttc |"] Print[" | e-mail:Xavier.Jaen@upc.edu |"] Print[" | version: september, 6, 2007 |"] Print[" ----------------------------------------"] (*================================================================ *) Print[" | TTC works correctly with |"] Print[" | Cell menu options: |"] Print[" | Mathematica version < 6 |"] Print[" |Default Input FormatType=InputForm |"] Print[" |Default Output FormatType=OutputForm |"] Print[" | Mathematica version = 6 |"] Print[" |Default Input FormatType=RawInputForm |"] Print[" |Default Output FormatType=OutputForm |"] Print[" ----------------------------------------"] TTCVNotes:=Print["\n Notes a la versio 1/6/2005:\n \n Ara NO es possible carregar el programa dues vegades\n \n Eliminat el Message::com que apareix quan es posa ,,\n per tal de poder utilitzar ApplyTensor\n \n S'ha fet compatible Solve i Reduce per a equacions tensorials\n \n S'ha canviat TensorQ per TTCTensorQ per fer-ho compatible amb el Mathematica 5.0\n \n Unprotect[D];D[a_,x__]:=D[a//.TTC->TTCR,x]/;(Compact[]==On&&(!FreeQ[a,TTC]));Protect[D]; \n \n S'ha ampliat i millorat MakeD\n \n S'ha afegit Derivative[n_][Sequence][f_]:=If[n==1,1,0]\n per tal de fer compatible TTCBracket amb la manera que Mathematica\n tracta les substitucions en les derivades.\n \n Notes a la versio no feta publica 28/2/2002:\n \n SetSAIVector->SetSAIVector[v] permet que v sigui un vector a efectes de\n SimplifyaAllIndex, de forma que v[a]v[b]v[c] etc no alenteixent els calculs\n FabricaRulesTo0[g,x,numindexlliures,maxlevel] fabrica rules del tipus a->0 extretes\n de les LlistaRules... en un format del tipus a_:>0/;m+mm=0&&... de manera que es poden\n utilitzar a BasicRules[0]. Hom pot fer BasicRules[0]=Join[%,BasicRules[0]]\n si la cosa interesa, s'apliquen de forma habitual.\n Notes a la versio 19/6/2001:\n \n acabada d'arreglar la famosa rule\n controltensoresanalizados->s'ha millorat per tal que detecti v^2->1 etc\n \n AntiBianchi->actua amb AntiRicci per tal de recuperarla\n la segona identitat de Bianchi inhomogeneitzada al passar de Riemann a Ricci\n \n InternalFormQ-> substitueix FormQ a nivell intern,aixi\n s'elimina el conflicte de les 1.form \n RicciIndexSimplifyQ-> activa i desactiva l'us de les propietats\n de commutacio de der.cov. a nivell 2. Les llistes de monomis i rules\n no queden etiquetats!! Aixi doncs compte\n InputSymmetries: arreglat un error pel qual es colaven\n propietats que involucraven derivades cov. a BasicRules[0]\n ( aixo per a les antisimetries T[i,-i,j]:>0 )\n \n AntiRicci-> versio forta\n Les propietats de simetria d'index\n involucrant derivades covariants\n passen a SimplifyAllIndex[2]\n Eliminats molts dels prints de control\n excepte els ...Creada la LlistaMonomis\n \n SVolumeForm-> i funcions associades\n es pasen a dir SAForm\n tambe VolumeForm=AForm\n \n TTCPartialD[1]->Habilitades les utilitats\n SimplifyAllIndex[SymmApply] per a derivades parcials\n \n TensorComponent-> Arreglat\n \n codificadorglobal i decodificador-> ara\n admet 1/scalar i T[1] com a tensor\n \n FormQ-> ara FormQ[dx]=True tant per extpr\n o outpr\n \n PBuscaAppendX-> Inclosa \n (x/.a[c__]:>aa[c])\n per tractament de rules escalars\n \n IndexD->inclos als usages\n \n ExtPr-> Arreglat alguna cosa que fallava\n \n IndexScalarQ-> Es pot declarar False \n al fer InputTensor[M,cx4,{False}]\n El TensorType[M]={} igualment\n \n InputCoordinates-> habilitat\n InputCoordinates[name,n] amb n \n Integer/simbol.\n Tambe fa automaticament\n InputTensor[n,name,{False},{Constant}]\n Util per a calculs\n simbolic explicitament \n independents/depenents de la dimensio\n Si hom vol explicitar caldra\n entrar\n InputCoordinates[name,{x1,x2,...}]\n Obviament les rules\n LlistaRules[...] poden ser diferents\n en aquest cas!!vigilar...\n \n SymmApply-> per activar-ho es fa\n T//Index[g,SimplifyAllIndex[SymmApply]]\n i no SymmApplyQ=True/False\n \n InputSymmetries ara cal especificar a \n quina BasicRules[n] esposa la propietat.\n InputSymmetries[T[i,j,k,l],{{i,j}}[1],{k,l}[2]]\n per exemple. D'acord amb aixo ara SRiemann[i,j,k,l] es\n {{i,j}}[1],{{k,l}}[1], {{i,j},{k,l}}[2],\n Cyclic[j,k,l][2],Cyclic[k,l,m][2].\n La antisimetria {{i,j}}[1] es possible mantenirla a\n nivell [1] gracies a la pairsimetria!! \n \n AntiPList-> AntiPList={AntiRicci}. Hom pot afegir nous\n operadors tipus AntiRicci que actuaran a nivell 2 com\n l'AntiRicci i RicciIdentity\n GhostSMetric->GhostSMetric[a] absorveix les metriques de a\n \n TTCSave->TTCSave[On/Off[file],symbols] Salva a file\n en format Compact[On/Off]\n TTCSave[On[file],LlistaRules[g,x,nfree,{nlevel}]] salva\n a file les corresponents llistes nfree nlevel 1,2,3,4...\n \n TTCSave[On[file],LlistaRules[g,x,nfree,nlevel]] salva\n a file les corresponents llistes nfree 1,2,..nlevel; 1,2,3,4...\n \n LlistaMonomis[g,x,{i,j,k},level,n]-> es la Llista en format no\n codificat, utilitzant com a index lliures {i,j,k}\n \n LlistaRules[g,x,{i,j,k},level,n]-> es la Llista en format no\n codificat utilitzant com a index lliures {i,j,k}.\n \n TTCSave[Off[file],LlistaRules[g,x,{i,j,k},{nlevel}]]-> salva\n a file les corresponents llistes nfree nlevel 1,2,3,4...\n en format no codificat. \n ExteriorD-> Arreglat, doncs sobre escalars fallava\n al donar una expressio que contenia ZZX[a,{1}] en lloc de\n ZZX[a,1] i aixi fallava un altre cop TensorComponent\n \n FabricaRules-> arreglat el nivell 1 per poblemes de codificacio\n que afectaven. Un dels problemes mes greus\n ( dificil trobar l'error) que recordem!!.\n \n OtherRules->Introduccio de la possibilitatt de definir rules complexes per \n par de l'usuari\n \n TTCIndexEvaluateQ->Introduit per a poder calcular el transit\n symbolic-> explicit quan hi han index amagats.IndexUpdate fa la cosa..\n A mes es mante la opcio Index[g,Evaluate] per a extreure index amagats\n \n Index-> ara es poden utilitzar index numeric per a prendre component\n commper exemple T[-1,i,2,j]//Index[] o Q[i,-3,.;2]//Index[].\n Sempre primer deriva i despres substitueix els index\n Si fem Q[i,-3][.;2]//Index[] llavors es substitueix i despres es deriva.\n NO es permes la utilitzacio del nom del les coordenades con a nom de index\n numeric!! \n --------------------------------------"]; TTCTryingToReloadQ=False; If[MemberQ[$Packages,"ttc`"],TTCTryingToReloadQ=True;Abort[]];(* xavier juny 2005: per si es torna a recarregar el ttc sense sortir de la sessio*) (*========================================================= *) BeginPackage["ttc`","Global`"] (*=====================NOUS USAGES============================== *) FabricaRulesTo0::usage = "NOU " (*=====================USAGES============================== *) AbsoluteD::usage = "(E) AbsoluteD[g][t] computes the covariant derivative of the tensor t using the metric g. If t is a (p, q) tensor, the covariant derivative of t is a (p, q+1) tensor. It can be computed using index notation. " AbsSymbol::usage="AbsSymbol[x]=x , AbsSymbol[-x]=x " ActualIfPBAMonomial::usage="(S) See examples in TTC tutorial " AllIndex::usage="(S) AllIndex[T] gives all index used in T " AntiPList::usage="(S)See examples in TTC tutorial " Antisymmetric::usage ="(E) Antisymmetric[t] gives the antisymmetric part of the tensor t. If t is not antisymmetrizable then Antisymmetric[t] returns Fail. It can be computed using index notation. " AntisymmetricQ::usage="(S) AntisymmetricQ[T[i,j,k,l,],{j,l}] gives True if T is antisymmetric with respect to the indexes j,l " AppendNewIndexList::usage="(S) Internal TTC system symbol " ApplyTensor::usage = "(E) ApplyTensor[t][t1, t2, t3,...] applies t to t1, t2, t3,... Empty slots are allowed as in ApplyTensor[t][t1, , t2,...]. " Arrange::usage="(S) See SimplifyAllIndex " BasicRules::usage="(S) BasicRules[n] is the list of essential rules of indexed tensors introduced by InputTensor and InputSymmetries. See examples in TTC tutorial" Basis::usage = "(E,S)Basis[t] gives the name of the basis of the tensor t. If t is a scalar and ScalarBasisQ = True then Basis[t] asks you for the name of the basis. " BasisChangeNames::usage = "(E) BasisChangeNames prints a list with the names of the basis changes defined in the present session. " BasisChangeQ::usage = "(E) BasisChangeQ[b1, b2] gives True if there exists BasisVectorChange[b1, b2] and False otherwise. " BasisInUse::usage = "Internal TTC Symbol" BasisFormChange::usage = "(E) BasisFormChange[b1, b2] gives the relation between the forms of the basis b1 and b2 provided that an input for the change b1 <-> b2 has been made. Otherwise, TTC asks you for this input." BasisNames::usage = "(E,S) BasisNames gives a list of all the noncoordinate basis defined in the present session. " BasisQ::usage = "(E,S) BasisQ[b] yields True if b is actually the name of a basis of vectors or a coordinate system, and yields False otherwise. " BasisSymbol::usage = "(E)BasisSymbol[b][i] gives the symbol used for the i-th vector of the basis named b. " BasisSymbols::usage = "(E)BasisSymbols[b] gives a list of the symbols of the basis b. " BasisVectorChange::usage = "(E) BasisVectorChange[b1, b2] gives the relation between the vectors of the basis b1 and b2 provided that an input for the change b1 <-> b2 has been made. Otherwise, TTC asks you for this input. " Change::usage = "(E) Change[b1, b2][t] changes t from basis b1 to basis b2. Change[b2][t] makes the same using Basis[t] as b1. " CheckLlistaRules::usage = " " Christoffel::usage = "(E) Christoffel[g, b][i, -j, -k] gives the connection coefficient (or Christoffel symbol of second kind) for the tensor metric g expanded in the basis b. The Christoffel symbol of first kind can be computed by Christoffel[g, b][-i, -j, -k]. It is computed only the first time it is called. " ChristoffelTensor::usage = "(E) ChristoffelTensor[g, b] gives the pseudotensor build from the connection coefficients of the metric g in the basis b. " ClearBasis::usage = "(E)ClearBasis[b] tries to remove the basis b and all objects related to it." ClearChange::usage = "(E) ClearChange[b1, b2] tries to remove all things related to the change b1 <-> b2. " ClearCoordinates::usage = "(E,S) ClearCoordinates[x] tries to remove the coordinate system named x and all objects related to it. " ClearMetric::usage = "(E) ClearMetric[g, b] tries to remove the metric named g in basis b and all objects related to it. " ClearTTC::usage = " ClearTTC tries to remove all objects generated by TTC as Coordinates, Metrics, ... etc . " Compact::usage="Compact[] is On or Off depending you have set Compact[On] or Compact[Off]. If Compact[] is On TTC works with compacted objects. The default value is Off " CompactTensor::usage="TTC internal symbol " Coordinate::usage = "(E,S) Coordinate[x][i] gives the i-th coordinate of the coordinate system named x. " CoordinateChange::usage = "(E) CoordinateChange[x1, x2] gives the relation between the coordinate systems x1 and x2 provided that an input InputCoordinateChange[x1, x2, change] has been made. Otherwise, TTC asks you for this input. " CoordinateChangeNames::usage = "(E) CoordinateChangeNames prints a list with the coordinate changes defined in the present session. " CoordinateChangeQ::usage = "(E) CoordinateChangeQ[x1, x2] yields True if the coordinate change x1 <-> x2 has been defined and yields False otherwise." CoordinateNames::usage = "(E,S) CoordinateNames shows the coordinate systems declared in the present session. " Coordinates::usage = "(E,S) Coordinates[x] gives a list with the symbols of the coordinate system named x provided that you have defined it. " CoordinatesQ::usage = "(E,S) CoordinatesQ[x] yields True if x is actually a name of a coordinate system, and yields False otherwise. " CoordinateTensor::usage = "(E) CoordinateTensor[x] gives the pseudotensor build from the coordinates of the system named x. " CovariantD::usage = "(E) CovariantD[g][v][t] or CovariantD[g][t, v] computes the covariant derivative of the tensor t with respect to the vector v using the metric g. If t is a (p, q) tensor, the covariant derivative of t in the direction of v is also a (p, q) tensor. " CovariantToPartial::usage="(S) indexexpr//Index[g,CovariantToPartial] convert all covariant derivatives to partial introducing, when needed, Christoffel symbols. " Curvature::usage = "(E) Curvature[g, b] gives the curvature scalar of the metric g in the basis b. It is computed only the first time it is called. " Cyclic::usage="(S) InputSymmetries[R[i,j,k,l],Cyclic[j,k,l][n]] is the way to define the cyclic property of the tensor R for the indexes (j,k,l) and assigning the property to BasicRules[n] " CyclicQ::usage="(S) CyclicQ[R[i,j,k,l],{j,k,l}] gives True if actually (j,k,l) are cyclic indexes of the tensor R. " Dimension::usage = "(E,S) Dimension[b] gives the dimension of the basis b. It can be used also to obtain the dimension of a coordinate system. " DownQ::usage="(S) DownQ[i] is True/False if the symbolic index i is down/up " DS::usage="(E) It's de ordinary derivative acting on TTC objects. " Euclidean::usage = "(E) Euclidean is the name of the default metric defined for the default coordinates XX. " ExpandD::usage="(S) indexexpr//Index[g,ExpandD] expand derivatives over sums. " ExpandSAFormRule::usage="(S) indexexpr//Index[g,TensorRules[ExpandSAFormRule[g,x]]] expand products of SAForm[g,x] " ExteriorD::usage = "(E,S) ExteriorD[f] computes the exterior derivative of the form f. " ExteriorProduct::usage = "(E,S) ExteriorProduct[w1, w2, ...] computes the exterior product of the forms w1, w2, ... Alternatively, w1*^w2*^ ... can be used. " ExteriorToOuter::usage = "(E) ExteriorToOuter[w] transforms the exterior products appearing in w in outer products. " FabricaRules::usage="Internal TTC system symbol " FirstFundamentalForm::usage = "(E) FirstFundamentalForm[g, x1, x2] computes the first fundamental form of the hypersurface parametrized with coordinates x2. g is the name of the metric in the background space with coordinates x1. It is computed only the first time it is called. " FirstFundamentalFormComponent::usage="Internal TTC system symbol " FormQ::usage = "(E,S) FormQ[w] yields True if w is an exterior form, and yields False otherwise. " FormatFunction::usage="FormatFunction[{symbols to be formated}] perfoms an easy-to-read format for the list of functions required" GhostSMetric::usage = "(S) indexexpr//Index[g,GhostSMetric] absorb metrics contracted with tensors" Hodge::usage = "(E) Hodge[g][w] gives the dual of the exterior form w relative to the metric g. " IdentityTensor::usage = "(E) IdentityTensor[b, p, q] gives the Kronecker delta of type {p, q} in the basis b. " Index::usage = "(E,S) Index is the function used for doing computations in index notation. See examples in TTC tutorial." IndexF::usage="Internal TTC system symbol " IndexD::usage="Internal TTC system symbol " IndexFactor::usage="(S) polindextensorexpr//Index[g,IndexFactor[factorindex]] try to factor polindextensorexpr with factorindex. factorindex must be some subpart of a term of polindextensorexpr using the same indexes" IndexList::usage=" (S) IndexList gives the current list of index " IndexSave::usage="(S) IndexSave[Tsymbol,indexexpr] may be used as a valid argument in the TTC function TTCSave in In option. The efect is to save on the choosed file Tsymbol[index]:=indexexpr updating the indexes." IndexTensorBasis::usage="(S) expr//Index[gn,IndexTensorBasis[n,a,r]] sets r to be the polynomial tensor basis of expr with coefficients a[1] a[2]...simplified up to n (using SimplifyAllIndex[n]). See examples in TTC tutorial " IndexUpdate::usage="(S) IndexUpdate[Tsymbol,\":=\"( or \":>\"),indexexpr] makes the corresponding assignmement ( := or :> ) updating the indexes. Example the input IndexUpdate[S,\":=\",T[-i,j] Q[-j,k]//Index[]] will allow you to input S[a,-b]//Index[] to produce the corresponding indexed expression 0[a,-b]+T[a,c] Q[c,-b] " IniSimplifyAllIndexSave::usage ="(S) IniSimplifyAllIndexSave[file] will save all new rules created by SimplifyAllIndex in the file file and in compacted form to be reused using TTCGet. You will need to resume using EndSimplifyAllIndexSave. See examples in TTC tutorial" EndSimplifyAllIndexSave::usage ="(S) IniSimplifyAllIndexSave[file] will save all new rules created by SimplifyAllIndex in the file file and in compacted form to be reused using TTCGet. You will need to resume using EndSimplifyAllIndexSave. See examples in TTC tutorial" InputBasis::usage = "(E) InputBasis[{cc,bb}] declares the noncoordinate basis bb which would be related to the coordinate system cc. InputBasis[{cc,bb,} {e1, e2,...}] makes the same but the symbols e1, e2, etc. can be used instead of the indices 1, 2, etc. to label tensors. In both cases, and assuming that cc is the unic coordinate system related to the basis bb, you can use bb as a valid symbol to input tensor basis elements as in bb[1,2,-3]" InputBasisChange::usage ="(E) InputBasisChange[b1, b2, change] sets the relation between the basis b1 and b2 through change. change is a list of rules relating vectors or forms of b1 and b2. You can give elements of b1 in terms of elements of b2 or viceversa. b1 and b2 must be basis related to the same coordinate system! " InputCoordinateChange::usage = "(E) InputCoordinateChange[x1, x2, change] sets the relation between the coordinate systems x1 and x2 through change. change is a list of rules relating the coordinates of x1 and x2." InputCoordinates::usage = "(E,S) InputCoordinates[x, {x1, x2,...}] declares the coordinate system named x with symbols x1, x2,... Once the coordinates system named x has been declared x[x1,x3,...] can be used to input tensor basis. InputCoordinates[XX, n], being n a positive number sets the dimension of the default system XX to n. It's possible to input InputCoordinates[x,dim] with dim a symbol. See examples in TTC tutorial " InputMetric::usage ="(E) InputMetric[g, b, t] declares the tensor t to be the metric named g in basis b. " InputIndex::usage="(S) InputIndex[indexlist] is the way to introduce or to change the index you want to use in the present session. The list must to have minimum one element, say {i}, then i1,i2,i3,...etc will be used us a index if needed. " InputMetricSign::usage = "(E,S)InputMetricSign[g, b, s] sets to positive (if s=+1) or negative (if s=-1) the sign of the determinant of Metric[g, b]." InputNormalFormSign::usage = "(E)InputNormalFormSign[g, x1, x2, s] sets to positive (s=+1) or negative (s=-1) the sign of the modulus of the normal to the hypersurface parametrized with coordinates x2. g and x1 are the metric and the coordinates, respectively, of the background space. " InputSChristoffelTensor::usage="(S) InputSChristoffelTensor[metricname,coordinatename ,outputstring,inputsymbol] ,Is the way to define the symbolic Christoffel tensor. metricname is the name of the metric we want to use, coordinatename is the name of the actual coordinates, outputstring is the symbol used to display the Christoffel tensor , inputsymbol is the symbol for the Christoffel tensor used in tensorial expressions. " InputSimplifyLevel::usage = "(E) InputSimplifyLevel[n], with n an integer between 0 an 4 sets the value of SimplifyLevel. " InputSMetric::usage="(S) InputSMetric[metricname,coordinatename ,outputstring,inputsymbol] ,Is the way to define a symbolic metric. metricname is the name of the metric we want to use, coordinatename is the name of the actual coordinates, outputstring is the symbol used to display the metric, inputsymbol is the symbol for the metric used in tensorial expressions. " InputSAForm::usage="(S) InputSAForm[metricname,coordinatename, outputstring,inputsymbol] Is the way to define a symbolic volume form. metricname is the name of the metric we want to use, coordinatename is the name of the actual coordinates, outputstring is the symbol used to display the volume form, inputsymbol is the symbol for the volume form used in tensorial expressions." InputSRiemann::usage="(S) InputSRiemann[metricname,coordinatename, outputstring,symbolinputriemann, symbolinputricci,symbolinputcurvature] Is the way to define the symbolic Riemann and Ricci tensors and the curvature. metricname is the name of the metric we want to use, coordinatename is the name of the actual coordinates, outputstring is the symbol used to display the Riemann and Ricci tensors and the curvature symbolinputriemann and symbolinputricci are the symbols for the Riemann and Ricci tensors and symbolinputcurvature the symbol for the curvature used in tensorial expressions. " InputSymmetries::usage="(S) InputSymmetries[T[i,j,a,b,m],{{i,m}}[1],{i,a,b}[2],{{i,j},{a,b}}[1]] will define the following symmetries for the indexes of the predefined tensor T: {{i,m}} (i,m) antisymmetrics {i,a,b} (i,a,b) symmetrics {{i,j},{a,b}} ((i,j)(a,b)) pairsymmetric Cyclic[i,a,b] (i,a,b) cyclic. The list of symetries specifications can be as long as you want. The numbers [1] [2]...[n]..indicates that the property will be used with BasicRules[n]. See examples in TTC tutorial. Example the Levi Civita like symmetries: InputSymmetries[s[i,j,k,l],{{i,j,k,l}}[1]] Example: the riemann like symmetries : InputSymmetries[R[i,j,k,l], {{i,j}}[1],{{k,l}}[1],{{i,j},{k,l}}[2],Cyclic[j,k,l][2]] InputSymmetries[R[i,j,k,l,.;m],Cyclic[k,l,m][2]] See examples in TTC tutorial. " InputTensor::usage="(S) InputTensor[T,basis,tensortype] is the way to input a symbolic tensor. InputTensor[T] is a valid argument in the function TTCSave in order to save T and its index symmetries " InputTTCSimplify::usage = "(E) InputTTCSimplify[list] sets TTCSimplify=list cheking that list are (possible) simplificators " InteriorContraction::usage = "(E) InteriorContraction[t1, t2] computes the interior product of t1 and t2. It can be computed using index notation." InteriorV::usage="(E) InteriorV[g][w][a]=InteriorContraction[v,a] where v is the contravariant vector related to w and a is a form" InverseHodge::usage = "(E) InverseHodge[g][w] is the inverse Hodge star operator applied to the form w." InverseMetric::usage = "(E) InverseMetric[g, b] gives the contravariant version of the metric tensor Metric[g, b]. It is computed only the first time it is called. " InverseMetricComponent::usage="Internal TTC system symbol " JacobianMatrix::usage = "(E) JacobianMatrix[b1, b2] gives the jacobian matrix of the change b1->b2, being b1 and b2 natural basis. " Leibniz::usage="(S) indexexpr//Index[g,Leibniz] it's just the Leibniz rule for derivatives. " LieD::usage = "(E) LieD[v][T] or LieD[v, T] computes the Lie derivative of the tensor T with respect to the vector v. " LlistaMonomis::usage="(S) LlistaMonomis[g,x,nfreeindex,nsym,ncounter] is the ncounter-th list of tensor index monomials generated by indexpr//Index[g,SimplifyAllIndex[nsym]] and in codified version. LlistaMonomis[g,x,{i,j,k...},nsym,ncounter] will show LlistaMonomis[g,x,nfreeindex,nsym,ncounter] using (i,j,k..) as free indices. See examples in TTC tutorial" LlistaRules::usage="(S) LlistaRules[g,x,nfreeindex,nsym,ncounter] is the ncounter-th list of rules of tensor index monomials generated by indexpr//Index[g,SimplifyAllIndex[nsym]] and in codified version. LlistaRules[g,x,{i,j,k...},nsym,ncounter] will show LlistaRules[g,x,nfreeindex,nsym,ncounter] using (i,j,k..) as free indices. See examples in TTC tutorial" MakeD::usage="(E) MakeD[expr] makes again all derivatives" MatrixToTensor::usage = "(E) MatrixToTensor[m, tp, b] gives a tensor of type tp, expanded in the basis b and built with the components of the matrix m. " Metric::usage = "(E) Metric[g, b] gives the expression of the metric named g in the basis b provided you have entered it using InputMetric. If not, TTC asks you to make the input. " MetricDet::usage = "(E) MetricDet[g, b] computes the determinant of the metric Metric[g, b]. It is computed only the first time it is called. " MetricInUse::usage = "Internal TTC Symbol" MetricNames::usage = "(E) MetricNames shows the names of the metric tensors defined in the present session. " MetricQ::usage = "(E) MetricQ[g, x] gives True if g is the name of a metric in the coordinate system named x and gives False otherwise. " MetricSign::usage = "(E) MetricSign[g, b] gives the sign of MetricDet[g, x] if you have established it with InputMetricSign[g, b, s]. Otherwise, TTC asks you for the input. " New::usage="(S) New[i] is a new unique index build from the symbol i. New[-i]=-New[i]. The new index created is appended to the NewIndexList that is removed when the operation Index[g] has finished.See examples in TTC tutorial " NormalForm::usage = "(E) NormalForm[g, x1, x2] computes the normal form to the hypersurface parametrized with the coordinates x2. g is the name of the metric in the background space with coordinates x1. It is computed only the first time it is called. " NormalFormSign::usage = "(E) NormalFormSign[g, x1 ,x2] gives the sign of the modulus of the normal to the hypersurface parametrized with the coordinates x2 provided that it has been stated with InputNormalFormSign. Otherwise, TTC asks you for the input. " OtherRules::usage = "(S) OtherRules[++TTCCounterOtherRules,lm,level] is a function to be defined by the user that is applied at level level by SimplifyAllIndex. lm is a list of monomials. The result of OtherRules must be a list of properties of the form lm[[i]]-x[i] meaning lm[[i]]=x[i] and in codified version" TTCCounterOtherRules::usage = "(S) OtherRules[++TTCCounterOtherRules[level],lm,level] is a function to be defined by the user that is applied at level level by SimplifyAllIndex. lm is a list of monomials. The result of OtherRules must be a list of properties of the form lm[[i]]-x[i] meaning lm[[i]]=x[i] and in codified version" OuterProduct::usage = "(E) OuterProduct[t1, t2, ...] computes the outer or tensor product of t1, t2, ... Alternatively, t1*.t2*. ... can be used. " OuterToExterior::usage = "(E) OuterToExterior[t] antisymmetrizes t and then gives the result in exterior notation. " PairSymmetricQ::usage="(S) PairSymmetricQ[\"T\"[i,j,k,l,],{{i,j},{k,l}}] gives True if T is pairsymmetric with respect to the indexes (i,j),(k,l)" PartialToCovariant::usage="(S) indexexpr//Index[g,PartialToCovariant] convert all partial derivatives to covariant introducing, when needed, Christoffel symbols. " PrintUsedLlistaRulesQ::usage="(S) If True (default) the function SimplifyAllIndex prints the used LlistaRules after each intented substitution. " RecoverIndexRulesList::usage="(S) RecoverIndexRulesList, is a list of rules used before simplifying monomials expresions on level 3 (dimensional properties). Its default value is RecoverIndexRulesList={}" RepeatedIndex::usage="(S) RepeatedIndex[T] gives the repeated (dummy) index used in T " ReplaceAllIndex::usage="Internal TTC system symbol " Ricci::usage = "(E) Ricci[g, b] computes the Ricci tensor of the metric named g in the basis b. It is computed only the first time it is called." RicciIndexSimplifyQ::usage="(S) If True SimplifyAllIndex[2] use Ricci commuting relations when simplify index expressions, even if covariant derivatives donīt appear explicitely. Default value True" Riemann::usage = "(E) Riemann[g, b] computes the full covariant version of the Riemann tensor of the metric named g in the basis b. It is computed only the first time it is called. " RiemannComponent::usage="Internal TTC system symbol " ScalarBasis::usage = "(E) ScalarBasis = b sets b as the basis that will be assigned to the scalars if ScalarBasisQ = False. The default is ScalarBasis = XX. " ScalarBasisQ::usage = "(E) ScalarBasisQ can be set to True or False. If ScalarBasisQ = True then Basis[s], with s an scalar, asks you for the name of the basis of s. If ScalarBasisQ = False then Basis[s] has the value stored in ScalarBasis. " ScalarProduct::usage = "(E) ScalarProduct[g][v1, v2] gives the contraction or scalar product of the vectors (or 1-forms) v1 and v2. It can be computed using index notation. " ScalarQ::usage = "(E,S) ScalarQ[s] yields True if s is a scalar, and yields False otherwise. " SChristoffelTensor::usage="Internal TTC system symbol " $SChristoffelTensor::usage="Internal TTC system symbol " SCurvature::usage="Internal TTC system symbol " SecondFundamentalForm::usage = "(E) SecondFundamentalForm[g, x1, x2] computes the second fundamental form of the hypersurface parametrized with coordinates x2. g is the name of the metric in the background space with coordinates x1. It is computed only the first time it is called. " SecondFundamentalFormComponent::usage="Internal TTC system symbol " SequenceHold::usage="Internal TTC system symbol " SetCompactTensor::usage="(E) T=>expr is the way to define a compacted tensor T as expr " SetSAIVector::usage="(S) SetSAIVector[v] handles v as a vector when using SimplifyAllIndex" ShowChristoffel::usage = "(E) ShowChristoffel[g, b] shows all nonnull connection coefficients of the Metric[g, b]. " ShowStructureCoefficient::usage = "(E) ShowStructureCoefficient[b] shows all nonnull structure coefficients of the basis b. " SignSymbol::usage="SignSymbol[x]=1 , SignSymbol[-x]=-1 " SimplifyAllIndex::usage="(S) expr//Index[gn,SimplifyAllIndex[num]] is the way to simplify the symbolic tensor expr using: num=0 uses BasicRules[0] and dummy indices num=1 uses BasicRules[0] and index symmetry properties stored in BasicRules[1] num=2 uses BasicRules[0] and index symmetry properties stored in BasicRules[1] and 2 num=3 uses BasicRules[0] and index symmetry properties stored in BasicRules[1] and 2 and dimensional index properties. See examples in TTC tutorial" SimplifyLevel::usage = "(E) SimplifyLevel is a variable that determines the frequency of internally simplifications. It can take values from 0 to 4. It is established with InputSimplifyLevel. " SingleTensorQ::usage="(S) SingleTensorQ[T] gives True if actually T is a symbolic tensor or scalar defined using InputTensor and False otherwise." sinToSin::usage="(E) See SinTosin " SinTosin::usage="(E) Useful in order to simplify some exepressions. Example TTCSimplify={SinTosin,Together,sinToSin} " SMetric::usage="Internal TTC system symbol " SMetricQ::usage="Internal TTC system symbol " SRicci::usage="Internal TTC system symbol " SRiemann::usage="Internal TTC system symbol " StructureCoefficient::usage = "(E) StructureCoefficient[b][-i, -j, k] is the structure coefficient of the basis b labeled by the indices i, j, k. It is computed only the first time it is called. " StructureCoefficientTensor::usage = "(E) StructureCoefficientTensor[b] gives the pseudotensor build from the structure coefficients of the basis b. " SuperIndexExpand::usage="(S) indexexpr//Index[g,SuperIndexExpand] expand an index tensor expression. " SAForm::usage="(S) See InputSAForm" SymbolicIndexExpressionQ::usage="(S) SymbolicIndexExpressionQ[T] give True if there are tensor index in T " SymbolicTensorQ::usage="(S) SymbolicTensorQ[T] give True if T is actually defined as a symbolic tensor using InpuTensor " SymbolicTensorNames::usage="(S) SymbolicTensorNames give the list of the current symbolic tensors " Symmetric::usage = "(E) Symmetric[t] gives the symmetric part of the tensor t. If t is not symmetrizable then Symmetric[t] returns Fail. It can be computed using index notation. " SymmetricQ::usage="(S) SymmetricQ[\"T\"[i,j,k,l,],{j,l}] gives True if T is symmetric with respect to the indexes j,l " SymmApply::usage="(S) expr//Index[g,SimplifyAllIndex[SymmApply]] applies symmetric,antisymmetric and pairsymmetric index properties in order to simplify the symbolic index tensor expression expr " TangentVector::usage = "(E) TangentVector[x1, x2][-i] gives the i-th vector of the basis of the tangent space to the hypersurface parametrized by the coordinates x2 in the manifold with coordinates x1. " TensorComponent::usage = "(E) TensorComponent[t][i, j, k,...] gives the component of the tensor t labeled by the (positive or negative) integers i, j, k, ... TensorComponent[f][{i, j, k,...}] gives the component of the exterior form f labeled by the (negative) integers i, j, k, ... " TTCTensorQ::usage = "(E,S) TTCTensorQ[t] yields True if t is a tensor, and yields False otherwise. " TensorRules::usage="(E,S) indexexpr//Index[g,TensorRules[rules]] apply rules on indexexpr indexexpr//Index[g,TensorRules[rules,Repeated]] apply rules on indexexpr repeated" TensorSimplify::usage = "(E) TensorSimplify[simp][t] simplifies every component of t using the simplification commands given in the list simp." TensorSymmetries::usage="(S) TensorSymmetries[T] gives the symmetries of the symbolic tensor T. See examples in TTC tutorial " TensorToMatrix::usage = "(E) TensorToMatrix[t] gives a matrix whose components are those of t. " TensorType::usage = "(E,S)TensorType[t] gives the type of the tensor t. TensorType[t] = {} if TTCTensorQ[t] = False. " ToTTCExpression::usage = "ToTTCExpression[string] converts any string containing special symbols used in TTC into a valid Mathematica expression. " TTC::usage = "TTC[n], being n a number, is a compacted object when you have set Compact[On]. When Compact[] is Off TTC[n] it's just TTCR[n] " TTCActualSettings::usage="TTCActualSettings prints de actual setting in TTC " TTCBracket::usage="Internal TTC symbol " TTCCPUTime::usage="Internal TTC system symbol " TTCFunctions::usage="TTCFunctions[] prints all TTC functions. TTCFunctions[abc..] prints all TTC functions begining with abc.." TTCGet::usage = "TTCGet[file] loads a file where the TTC index notation has been employed or saved in Compact[On] switch or saved using IniSimplifiAllIndexSave-EndSimplifiAllIndexSave." TTCIndexD::usage="Internal TTC system symbol " TTCIndexEvaluateQ::usage="Internal TTC system symbol " TTCIndexS::usage="Internal TTC system symbol " TTCInFormat::usage = "TTCInFormat restores the standards outputs after TTCOutFormat has been activated. " TTCList::usage="TTCList[T] Give the list of all necesary TTC[n] objects to define T " TTCOutFormat::usage = "TTCOutFormat starts the textbook-like format for the outputs. It is the default format. " TTCPartialD::usage="Internal TTC system symbol " TTCPrintDate::usage=" TTCPrintDate[] prints the current date" TTCPrintTime::usage=" TTCPrintTime[On/Off] prints CPU Time and Memory in use after each output " TTCR::usage = "TTCR[n], being n a number, is the expression compacted by TTC[n] " TTCSave::usage = "(E,S)TTCSave[file.ext, In, e1, e2,...] appends expressions e1, e2,... to file.ext in such a format that can be read in from Mathematica. TTCSave[file.ext, Out, e1, e2,...] appends expressions e1, e2,... to file.ext in a format readable by humans. TTCSave[file, e1, e2,...] appends expressions e1, e2,... to files file.in and file.out in In and Out formats, respectively. If Compact[Off] TTCSave saves objects uncompacted. If Compact[On] TTCSave uses the compact utilities to save objects. See examples in TTC tutorial " TTCSimplify::usage = "(E)TTCSimplify is a variable that stores the chain of conversion operators used in internal simplifications. Its default value is TTCSimplify = {Sintosin,Together,sinToSin}. " UncompactTensor::usage="UncompactTensor[T] is the tensor T uncompacted Useful to see the compacted tensor T " UnformatFunction::usage="UnformatFunction[{symbols to be unformated}] returns FormatFunction to standard outptut form for the list of functions required" Unitary::usage = "(E) Unitary[g][s, v] gives the s-normalized version of the vector (or 1-form) v respect to the metric g. s must be the sign (1 or -1) of ScalarProduct[g][v, v]. When s=+1 it can be omitted. " UpAndDown::usage=" See SimplifyAllIndex" UpdateTTC::usage="UpdateTTC resets all TTC[n] symbols in order to incorporate news setting (such as a=0, b=0, ..etc) " UpDownQ::usage="UpDownQ[i,j] is True if the symbolic index i,j are up-down or down-up " UpQ::usage="UpQ[i] is True/False if the symbolic index i is up/down " AForm::usage = "(E) AForm[g, b] gives the volume form associated to Metric[g, b] in exterior notation. It is computed only the first time it is called. " VolumeForm::usage = "see AForm" XX::usage = "(E,S) XX is the name of the default coordinate and also the name of the coordinate basis associated to it. XX[X1,X2,...] can be used to input tensor basis elements " ZZ::usage = "(E)ZZ is the symbol used to express the basis elements of tensors, vectors and forms. " ZZX::usage="Internal TTC system symbol " (*******************END OF USAGES*****************************) Begin["`Private`"] (*************** $PreRead ************************************) Derivative[n_][Sequence][f_]:=If[n==1,1,0]; (*xjaen 30 febrer 2005*) Unprotect[$Pre,$PreRead];(* xavier juny 2005*) $PreRead= StringReplace[StringReplace[ StringReplace[#, { "(*"->"TTCBeginComment", "*)"->"TTCEndComment", "_.;"->"_. ;", "..;"->".. ;", "=.;"->"=. ;", "_.|"->"_. |", "..|"->".. |", "=.|"->"=. |", "_.,"->"_. ,", "..,"->".. ,", "=.,"->"=. ,", "0.;"->"0. ;", "1.;"->"1. ;", "2.;"->"2. ;", "3.;"->"3. ;", "4.;"->"4. ;", "5.;"->"5. ;", "6.;"->"6. ;", "7.;"->"7. ;", "8.;"->"8. ;", "9.;"->"9. ;", "0.|"->"0. |", "1.|"->"1. |", "2.|"->"2. |", "3.|"->"3. |", "4.|"->"4. |", "5.|"->"5. |", "6.|"->"6. |", "7.|"->"7. |", "8.|"->"8. |", "9.|"->"9. |", "0.,"->"0. ,", "1.,"->"1. ,", "2.,"->"2. ,", "3.,"->"3. ,", "4.,"->"4. ,", "5.,"->"5. ,", "6.,"->"6. ,", "7.,"->"7. ,", "8.,"->"8. ,", "9.,"->"9. ,", "0.<"->"0. <", "1.<"->"1. <", "2.<"->"2. <", "3.<"->"3. <", "4.<"->"4. <", "5.<"->"5. <", "6.<"->"6. <", "7.<"->"7. <", "8.<"->"8. <", "9.<"->"9. <", ">.0"->"> .0", ">.1"->"> .1", ">.2"->"> .2", ">.3"->"> .3", ">.4"->"> .4", ">.5"->"> .5", ">.6"->"> .6", ">.7"->"> .7", ">.8"->"> .8", ">.9"->"> .9" }], {"("->"(TTCBracket[", ")"->"])", "=>."->"//SetCompactTensor", ".<<"->"TTCIndexS[1[1]],", ">>."->",TTCIndexS[1[0]]", ".<"->"TTCIndexS[2[1]],", ">."->",TTCIndexS[2[0]]", "*^"->" ExteriorProduct@", "*."->" OuterProduct@", "=>"->"~SetCompactTensor~", ".;"->"TTCIndexD[AbsoluteD],", ".|"->"TTCIndexD[TTCPartialD[2]],", ".,"->"TTCIndexD[TTCPartialD[1]],"} ], {"TTCBeginComment"->"(*", "TTCEndComment"->"*)"}]& (**************** $Pre ****************************************) SetAttributes[GroupingTensorTimes,HoldAll]; TTCCPUTime=TimeUsed[]; TTCCPUTimeQ=True; GroupingTensorTimes[T__]:= Module[{holdresult}, If[TTCCPUTimeQ,TTCCPUTime=TimeUsed[]];(*xavier 8 setembre 98*) Unprotect[Times];ClearAttributes[Times,{Orderless}]; Unprotect[Plus];ClearAttributes[Plus,{Orderless}]; holdresult=(Hold[T]//. {Literal[SetCompactTensor[a_,b_]] c_ :>SetCompactTensor[a,b c], Literal[SetCompactTensor[a_,b_]]+ c_ :>SetCompactTensor[a,b+ c], Literal[Power[SetCompactTensor[a_,b_],n_]]:> SetCompactTensor[a,Power[b,n]], Literal[OuterProduct[SetCompactTensor[t_,a_],b__]]:> SetCompactTensor[t,OuterProduct[a,b]], Literal[ExteriorProduct[SetCompactTensor[t_,a_],b__]]:> SetCompactTensor[t,ExteriorProduct[a,b]], Literal[Index[g___][SetCompactTensor[a_,b_]]]:> SetCompactTensor[a,Index[g][b]], Literal[a_ Power[ExteriorProduct[b_],n_]]:> ExteriorProduct[a,Power[b,n]], Literal[a_ Power[OuterProduct[b_],n_]]:> OuterProduct[a,Power[b,n]], Literal[Power[OuterProduct[a_,b_],n_]]:>OuterProduct[a,Power[b,n]], Literal[Power[ExteriorProduct[a_,b_],n_]]:>ExteriorProduct[a,Power[b,n]], a_ b_ExteriorProduct :> ExteriorProduct[a,b] , a_ b_OuterProduct :> OuterProduct[a,b] , a_ExteriorProduct b_ :> ExteriorProduct[a,b], a_OuterProduct b_ :> OuterProduct[a,b] })/. {TTCBracket->Sequence}; SetAttributes[Times,Orderless];Protect[Times]; SetAttributes[Plus,Orderless];Protect[Plus]; ReleaseHold[holdresult]]; $Pre=GroupingTensorTimes (*********** Protect $PreRead, $Pre ****************************) Protect["$PreRead","$Pre"] (**************** TTCFunctions **********************************) SetAttributes[TTCFunctions,HoldAll]; TTCFunctions[a_String]:=ToExpression[StringJoin["?ttc`",a]]; TTCFunctions[a_]:=ToExpression[ StringJoin["?ttc`",StringDrop[StringDrop[ToString[Hold[a]],5],-1],"*"] ]; TTCFunctions[]:=ToExpression["?ttc`*"]; (****************************** D[TTC[n],x] ********************************) (*xjaen 2005*) Unprotect[D];D[a_,x__]:=D[a//.TTC->TTCR,x]/;(Compact[]==On&&(!FreeQ[a,TTC]));Protect[D]; (******************************MakeD********************************) (*xjaen 30 febrer 2005*) MakeD[expr_,rules_:{}]:=(expr/.{Derivative[n__][f_][x__]:>D[f[x]/.rules,Sequence@@Table[{{x}[[i]],{n}[[i]]},{i,1,Length[{n}]}] ]})/.rules (************FormatFunction UnformatFunction ******************) Format[Derivative[n__][f_][x__]]:= Module[{result,listder,protecvar,applylist,dervar}, dervar=({n}.protecvar/@{x}); applylist[a_]:=If[Head[a]===protecvar||Head[a]===Times,List[a],List@@a]; listder[number_. var_]:=Table[var,{ii,1,number}]/;NumberQ[number]; result=Subscripted[ f@@(Join@@Join[{{""}},listder/@applylist[dervar]])]/.protecvar-> Identity; Remove[applylist,protecvar];result]/; format[f]===True; SetAttributes[FormatFunction,Listable] SetAttributes[UnformatFunction,Listable] FormatFunction[f_]:=(format[f]=True; Format[f[x___]] :=f/;format[f]===True;f) UnformatFunction[f_]:=(format[f]=False;f) (****** CompactTensor,UncompactTensor ****************************) SetAttributes[SetCompactTensor,HoldFirst] SetAttributes[SetCompactScalar,HoldFirst] SetAttributes[CompactTensor,Listable] SetAttributes[CompactScalar,Listable] ListTTCNumbers={}; Compact[Off]:=If[CompactOffOn=!=Off,(TTC[a_]:=TTC[a]=TTCR[a];CompactOffOn=Off)]; Compact[On]:=If[CompactOffOn=!=On,(Clear[TTC];ListTTCNumbers/.Hold->Set;CompactOffOn=On)]; Compact[]:=CompactOffOn; SetCompactScalar[T_,q_]:= If[CompactOffOn===On, T=CompactScalar[q];T, Compact[On]; T=CompactScalar[q]; Compact[Off]; T] SetAttributes[holdlist,{Listable,HoldAll}] UpdateTTC[sets__]:=(Off[Unset::norep]; Clear[TTC];ListTTCNumbers={};CTSimplify[{Identity}]/@TTCList[]; Compact[CompactOffOn];On[Unset::norep];);(*xavier 23/07/97*) SetCompactTensor[{a__}]:= (Off[Unset::norep];holdlist[{a}]/. holdlist->Unset; Clear[TTC];ListTTCNumbers={};CTSimplify[{Identity}]/@TTCList[]; Compact[CompactOffOn];On[Unset::norep];);(*xavier 30/07/97*) SetCompactTensor[a_]:= (Off[Unset::norep];Unset[a]; Clear[TTC];ListTTCNumbers={};CTSimplify[{Identity}]/@TTCList[]; Compact[CompactOffOn];On[Unset::norep];);(*xavier 30/07/97*) SetCompactTensor[T_,q_]:= If[CompactOffOn===On, T=CompactTensor[q];T, Compact[On]; T=CompactTensor[q]; Compact[Off]; T]; TTCCounter=0; CompactScalar[0]=0; CompactScalar[list_List]:=CompactScalar/@list; CompactScalar[a_->b_]:=a->CompactScalar[b]; CompactScalar[a_]:=TTCComponent[a]; CompactTensor[0]=0; CompactTensor[list_List]:=CompactTensor/@list; CompactTensor[a_->b_]:=a->CompactTensor[b]; CompactTensor[T_?ScalarQ]:=CompactScalar[T]; CompactTensor[T_]:= Module[{coef,n,Texpanded,uniczz,f,ff,result}, coef[x__]:=0; n[x__]:=0; Texpanded=T//.(a_ Plus[b_. ZZX[x__],c__]:>Plus@@(a{ b ZZX[x],c})); uniczz[a_Plus]:=uniczz/@a; uniczz[a_. ZZX[x__]]:=(n[x]++;coef[x]=coef[x]+a;f[x] ZZX[x]); uniczz[0]:=0; ff[x__]:=TTCComponent[coef[x]/n[x] ]; result=uniczz[Texpanded]/.f->ff; Remove[coef,n,uniczz,ff]; result]; TTCComponent[a_ Plus[b_. ttc_TTC,c__]]:= TTCComponent[Plus@@(a { b ttc,c}) ]; TTCComponent[a_?NumericQ]:=a; TTCComponent[a_TTC]:=a; TTCComponent[a_?NumericQ b_]:=a TTCComponent[b]; TTCComponent[b_]:= If[CompactOffOn===On, TTCComponent[-b]=-TTC[++TTCCounter]; TTCR[TTCCounter]=b;TTCComponent[b]=TTC[TTCCounter], Compact[On]; TTCComponent[-b]=-TTC[++TTCCounter]; TTCR[TTCCounter]=b;TTCComponent[b]=TTC[TTCCounter]; Compact[Off];TTCComponent[b]]; UncompactTensor[T_]:=T//.TTC->TTCR; UncompactTensor1[T_]:=T/.TTC->TTCR; (********* Some simplified input notations ******************) Unprotect[Power]; Power[a_?TensorQNot0,n_]:= Module[{i}, Fold[OuterProduct,a,Table[a,{i,1,n-1}]] ]/; Head[n]===Integer&&n>1; Protect[Power]; (*xavier 24juliol1996 per questions d'index simbolics. Relacionat amb el TTCBracket *) Unprotect[Sequence]; Sequence[a_][b__]:=a[b]; Protect[Sequence]; (***** Some tools used in TTC program ***************************) HoldSequence[a_,b__]:=Flatten[{Hold[a],HoldSequence[b]}]; HoldSequence[a_]:={Hold[a]}; TensorQYes0[a_]:=If[a===0,True,TTCTensorQ[a]]; TensorQNot0[a_]:=If[a===0,False,TTCTensorQ[a]]; ReplaceAllZZ[rules_][0]:=0; ReplaceAllZZ[rules_][T_]:=replaceallZZ[rules][T//CompactTensor]; replaceallZZ[rules_][0]:=0; replaceallZZ[rules_][Plus[a__]]:=replaceallZZ[rules]/@Plus[a]; replaceallZZ[rules_][a_. ZZX[b_,x__]]:=a Replace[ZZX[b,x],rules]; SetAttributes[AbsSymbol,Listable]; AbsSymbol[x_?NumericQ]:=Abs[x]; AbsSymbol[x_]:=x; AbsSymbol[-x_]:=x; numbertostring[a_]:=If[a>0,ToString[a],-ToString[-a]]; stringtoexpression[a_]:=ToExpression[a]; stringtoexpression[-a_]:=-ToExpression[a] stringreplacespace[x_]:=StringReplace[x,{"\\\n "->"\\\n"}]; Off[RuleDelayed::rhs]; ToPattern[x_]:=If[Head[x]===Times,-Pattern[Evaluate[-x],Blank[]], Pattern[x,Blank[]]]; On[RuleDelayed::rhs]; SetAttributes[SignSymbol,Listable] SignSymbol[-x_]:=-1; SignSymbol[x_]:=1; PlusToList[a_]:=If[Head[a]===Plus,List@@a,List[a] ]; PlusToList0[0]:={}; PlusToList0[a_]:=PlusToList[a]; JoinTensorIndex[a_. 0[l__]]:=0; JoinTensorIndex[a_ T_?TensorQYes0[l__]]:=CompactTensor[a T][l]; JoinTensorIndex[a_. T1_?TensorQYes0[l__]+ b_. T2_?TensorQYes0[l__]+c_.]:= JoinTensorIndex[ CompactTensor[a T1+ b T2][l]+c]; JoinTensorIndex[a_]:=a; TTCPartialD[1][T_]:= Module[{bas,dim,i}, bas=Basis[T]; dim=Dimension[bas]; Sum[OutPr[ LieD[ZZX[bas,-i],T],ZZX[bas,i]], {i,1,dim}]//tensorsimplify[3] ]; absD[g_][T_[l___,TTCIndexD[x_],i_,s___]]:= If[x===AbsoluteD, AbsoluteD[g][T][l,i,s],(*xavier 290797*) TTCPartialD[1][Head[SwitchIndex[g][T[l]]]][l,i,s] ]/;FreeQ[{l},TTCIndexD]; absD[g_][a_]:=a; absDlist[g_][{T__}]:=absD[g]/@{T}; (************** ToTTCExpression ********************************) ToTTCExpression[string_]:=ToExpression[TTCRead[string]]; (************** TTCGet *****************************************) TTCRead= StringReplace[StringReplace[ StringReplace[ StringReplace[FixedPoint[stringreplacespace,#],{"\\\n "->""}], { "(*"->"TTCBeginComment", "*)"->"TTCEndComment", "_.;"->"_. ;", "..;"->".. ;", "=.;"->"=. ;", "_.|"->"_. |", "..|"->".. |", "=.|"->"=. |", "_.,"->"_. ,", "..,"->".. ,", "=.,"->"=. ,", "0.;"->"0. ;", "1.;"->"1. ;", "2.;"->"2. ;", "3.;"->"3. ;", "4.;"->"4. ;", "5.;"->"5. ;", "6.;"->"6. ;", "7.;"->"7. ;", "8.;"->"8. ;", "9.;"->"9. ;", "0.|"->"0. |", "1.|"->"1. |", "2.|"->"2. |", "3.|"->"3. |", "4.|"->"4. |", "5.|"->"5. |", "6.|"->"6. |", "7.|"->"7. |", "8.|"->"8. |", "9.|"->"9. |", "0.,"->"0. ,", "1.,"->"1. ,", "2.,"->"2. ,", "3.,"->"3. ,", "4.,"->"4. ,", "5.,"->"5. ,", "6.,"->"6. ,", "7.,"->"7. ,", "8.,"->"8. ,", "9.,"->"9. ,", "0.<"->"0. <", "1.<"->"1. <", "2.<"->"2. <", "3.<"->"3. <", "4.<"->"4. <", "5.<"->"5. <", "6.<"->"6. <", "7.<"->"7. <", "8.<"->"8. <", "9.<"->"9. <", ">.0"->"> .0", ">.1"->"> .1", ">.2"->"> .2", ">.3"->"> .3", ">.4"->"> .4", ">.5"->"> .5", ">.6"->"> .6", ">.7"->"> .7", ">.8"->"> .8", ">.9"->"> .9" }], {"("->"(TTCBracket[", ")"->"])", "=>."->"//SetCompactTensor", ".<<"->"TTCIndexS[1[1]],", ">>."->",TTCIndexS[1[0]]", ".<"->"TTCIndexS[2[1]],", ">."->",TTCIndexS[2[0]]", "*^"->" ExteriorProduct@", "*."->" OuterProduct@", "=>"->"~SetCompactTensor~", ".;"->"TTCIndexD[AbsoluteD],", ".|"->"TTCIndexD[TTCPartialD[2]],", ".,"->"TTCIndexD[TTCPartialD[1]],"}], {"TTCBeginComment"->"(*", "TTCEndComment"->"*)"}]& ; TTCGet::syntax=" TTC has encountered some syntax error in your input file: `1`" TTCGet::notfound=" TTC has not found the file: `1`" SetAttributes[TTCGet,HoldAll]; GetTTCNumber[a_Times]:=(a[[2]])[[1]]; GetTTCNumber[b_]:=b[[1]]; TTCGet[file_]:= Module[{offon,string1,TTCX,ttc,ttccount}, TTCCPUTimeQ=False; offon=CompactOffOn; Compact[On]; ttccount[l__,npos_]:=ttccount[l,npos]= (ContadorPropietats[l]=ContadorPropietats[l]+1); string1=If[Head[file]===String,file, StringReplace[ StringDrop[StringDrop[ToString[Hold[file]],5],-1], {" . "->"."}]]; If[$VersionNumber>=3.0, GroupingTensorTimes@@((( ToExpression[TTCRead@@ReadList[string1,Record,RecordSeparators->{}],InputForm,Hold]/. TTC[m_]:>TTCX[m])/. {LlistaMonomis[g_,x_,long123_,n_,npos_]:> LlistaMonomis[g,x,long123,n,ttccount[g,x,long123,n,npos]], LlistaRules[g_,x_,long123_,n_,npos_]:> LlistaRules[g,x,long123,n,ttccount[g,x,long123,n,npos]], Literal[SetDelayed[TTCR[n_],expr_]]:> (ttc[n]=TTC[GetTTCNumber[TTCComponent[expr/.{TTCX[m_]:>ttc[m]}]]];1), Literal[Set[TTCR[n_],expr_]]:> (ttc[n]=TTC[GetTTCNumber[TTCComponent[expr/.{TTCX[m_]:>ttc[m]}]]];1)} )/.{TTCX[m_]:>ttc[m]}), GroupingTensorTimes@@((( ToHeldExpression[TTCRead@@ReadList[string1,Record,RecordSeparators->{}]]/. TTC[m_]:>TTCX[m])/. {LlistaMonomis[g_,x_,long123_,n_,npos_]:> LlistaMonomis[g,x,long123,n,ttccount[g,x,long123,n,npos]], LlistaRules[g_,x_,long123_,n_,npos_]:> LlistaRules[g,x,long123,n,ttccount[g,x,long123,n,npos]], Literal[Set[TTCR[n_],expr_]]:> (ttc[n]=TTC[GetTTCNumber[TTCComponent[expr/.{TTCX[m_]:>ttc[m]}]]];1)} )/.{TTCX[m_]:>ttc[m]}) ]; If[$MessageList==={}, Print[string1]; Print["succesfully loaded on TTC"], Print[string1]; Print["could not been succesfully loaded on TTC"]]; TTCCPUTimeQ=True;Remove[ttccount];Compact[offon];]; (******** TTCSave:TTCInFile**********************************) SetAttributes[TTCInFile,HoldAll]; SetAttributes[HoldSequence,HoldAll]; TTCInFile[file_]:=(1;); TTCInFileTTC[file_,list_]:= Module[{part,rest,tot,ii}, Format[Continuation[n_]]:=""; Format[LineBreak[n_]]:="\\"; part=Partition[list,100]; rest=If[part=!={}, Take[ list,{100*Length[part]+1,Length[list]}],list]; tot=Which[ part==={},{rest}, rest==={},part, True,Append[part,rest]]; Do[ TTCInFileN[file,tot[[ii]] ],{ii,1,Length[tot]}]; Print[Length[list], " TTC compacted objects"]; Print["succesfully saved on file"]; Print[file]; Clear[Continuation];Clear[LineBreak]]; TTCInFileN[file_,exprs_List]:= Module[{ii}, PutAppend[ OutputForm[ StringJoin@@Flatten[ Table[{"TTCR[",ToString[exprs[[ii]]],"]=",ToString[InputForm[TTCR[exprs[[ii]]]]],";"}, {ii,1,Length[exprs]}]]],file]]; TTCInFile[file_,exprs1___,Coordinates[x_],exprs2___]:= (TTCInFile[file,exprs1]; TTCInFile[file, StringJoin[ "InputCoordinates[",ToString[x],",",ToString[Coordinates[x]],"]" ] ]; TTCInFile[file,exprs2]); TTCInFile[file_,exprs1___,BasisSymbols[x_],exprs2___]:= (TTCInFile[file,exprs1]; TTCInFile[file, StringJoin[ "InputBasis[",ToString[x],",",ToString[BasisSymbols[x]],"]" ] ]; TTCInFile[file,exprs2]); TTCInFile[file_,exprs1___,Basis[x_],exprs2___]:= (TTCInFile[file,exprs1]; TTCInFile[file, StringJoin[ "InputBasis[",ToString[x],",",ToString[BasisSymbols[x]],"]" ] ]; TTCInFile[file,exprs2]); TTCInFile[file_,exprs1___,Change[a_,b_],exprs2___]:= (TTCInFile[file,exprs1]; TTCInFile[file,StringJoin[ "InputBasisChange[",ToString[a],",",ToString[b],"]"], BasisVectorChange[a,b],BasisFormChange[a,b], BasisVectorChange[b,a],BasisFormChange[b,a] ]; TTCInFile[file,exprs2])/;(Head[a]===List||Head[b]===List); TTCInFile[file_,exprs1___,Change[oldx_,newx_],exprs2___]:= (TTCInFile[file,exprs1]; TTCInFile[file, StringJoin[ "InputCoordinateChange[",ToString[oldx],",",ToString[newx], ToString[InputForm[CoordinateChange[oldx,newx]]],"]"], BasisFormChange[oldx,newx] ]; If[Dimension[oldx]===Dimension[newx], TTCInFile[file,BasisVectorChange[oldx,newx]],1]; TTCInFile[file,exprs2]); TTCInFile[file_,HoldStructureCoefficient[b_][i_,j_,k_]]:= TTCInFile[file,StructureCoefficient[b][i,j,k]]; TTCInFile[file_,exprs1___,StructureCoefficientTensor[b_],exprs2___]:= Module[{dim,i,j,k},dim=Dimension[b]; TTCInFile[file,exprs1];Do[ TTCInFile[file, Evaluate[ HoldStructureCoefficient[b][-j,-k,i] ] ], {i,1,dim},{k,2,dim},{j,1,k-1}]; TTCInFile[file,exprs2] ]; TTCInFile[file_,HoldMetricComponent[g_,x_][j_,k_]]:= TTCInFile[file,MetricComponent[g,x][j,k]]; TTCInFile[file_,exprs1___,Metric[g_,x_],exprs2___]:= Module[{dim,j,k},dim=Dimension[x]; TTCInFile[file,exprs1]; TTCInFile[file, StringJoin[ "InputMetric[",ToString[g],",",ToString[x],",", ToString[InputForm[Metric[g,x]]],"]" ] ]; TTCInFile[file,exprs2]]; TTCInFile[file_,HoldInverseMetricComponent[g_,x_][j_,k_]]:= TTCInFile[file,InverseMetricComponent[g,x][j,k]]; TTCInFile[file_,exprs1___,InverseMetric[g_,x_],exprs2___]:= Module[{dim,j,k},dim=Dimension[x]; TTCInFile[file,exprs1]; Do[TTCInFile[file, Evaluate[ HoldInverseMetricComponent[g,x][j,k] ] ], {k,1,dim},{j,1,k}]; TTCInFile[file,exprs2]]; TTCInFile[file_,HoldChristoffel[g_,x_][i_,j_,k_]]:= TTCInFile[file,Christoffel[g,x][i,j,k]]; TTCInFile[file_,exprs1___,ChristoffelTensor[g_,x_],exprs2___]:= Module[{dim,i,j,k,s},dim=Dimension[x]; s=If[Head[x]=!=List,j,1]; TTCInFile[file,exprs1]; Do[ TTCInFile[file, Evaluate[ HoldChristoffel[g,x][-i,-j,-k] ] ], {i,1,dim},{j,1,dim},{k,s,dim}]; Do[ TTCInFile[file, Evaluate[ HoldChristoffel[g,x][i,-j,-k] ] ], {i,1,dim},{j,1,dim},{k,s,dim}]; TTCInFile[file,exprs2] ]; TTCInFile[file_,HoldRiemannComponent[g_,x_][i_,j_,k_,l_]]:= TTCInFile[file,RiemannComponent[g,x][i,j,k,l]]; TTCInFile[file_,exprs1___,Riemann[g_,x_],exprs2___]:= Module[{dim,i,j,k,l},dim=Dimension[x]; TTCInFile[file,exprs1]; Do[If[(!(i===j))&& (!(k===l))&& (!(i j && k >l))&& (!(i<0 && (i > k > l > j))), TTCInFile[file, Evaluate[ HoldRiemannComponent[g,x][i,j,k,l] ] ]], {i,-dim,-1},{j,-dim,-1},{k,-dim,-1},{l,-dim,-1}]; TTCInFile[file,exprs2]]; TTCInFile[file_,HoldSecondFundamentalFormComponent[g_,x_,xs_][j_,k_]]:= TTCInFile[file,SecondFundamentalFormComponent[g,x,xs][j,k]]; TTCInFile[file_,exprs1___,SecondFundamentalForm[g_,x_,xs_],exprs2___]:= Module[{dim,j,k},dim=Dimension[xs]; TTCInFile[file,exprs1]; Do[TTCInFile[file, Evaluate[ HoldSecondFundamentalFormComponent[g,x,xs][-j,-k] ] ], {k,1,dim},{j,1,k}]; TTCInFile[file,exprs2]]; TTCInFile[file_,exprs1___,{SecondFundamentalForm,g_,x_,xs_},exprs2___]:= Module[{dim,j,k},dim=Dimension[xs]; TTCInFile[file,exprs1]; Do[TTCInFile[file, Evaluate[ HoldSecondFundamentalFormComponent[g,x,xs][-j,-k] ] ], {k,1,dim},{j,1,k}]; TTCInFile[file,exprs2]]; (*********************TTCSave Symbolic tensors*********) TTCInFile[file_,HoldInputSymmetries[a__]]:= TTCInFile[file,StringJoin[ "Module[",ToString[List@@(((a[[1]])/.TTCIndexD[x_]:>sequence[])/.sequence->Sequence)], ",InputSymmetries@@",ToString[InputForm[a]],"]"]]; TTCInFile[file_,expr1___,InputTensor[T_],expr2___]:= (TTCInFile[file,expr1]; TTCInFile[file, StringJoin["InputTensor[", ToString[T],",",ToString[Basis[T]],",",ToString[TensorType[T]],"]"] ]; If[Head[ TensorSymmetries[T] ]===List, Do[TTCInFile[file,Evaluate[ HoldInputSymmetries[TensorSymmetries[T][[iii]]]]], {iii,1,Length[TensorSymmetries[T]]}]]; TTCInFile[file,expr2]); TTCInFile[file_,HoldLlistaMonomis[g_,x_,long123_,n_,npos_]]:=( TTCSaveList=Union[TTCSaveList,TTCList1[LlistaMonomis[g,x,long123,n,npos]]]; TTCInFile[file,LlistaMonomis[g,x,long123,n,npos]];); TTCInFile[file_,HoldLlistaRules[g_,x_,long123_,n_,npos_]]:= (TTCSaveList=Union[TTCSaveList,TTCList1[LlistaRules[g,x,long123,n,npos]]]; TTCInFile[file,LlistaRules[g,x,long123,n,npos]];); TTCInFile[file_,HoldLlistaMonomis2[g_,x_,long123_,n_,npos_]]:= TTCInFile[file,LlistaMonomis[g,x,long123,n,npos]]; TTCInFile[file_,HoldLlistaRules2[g_,x_,long123_,n_,npos_]]:= TTCInFile[file,LlistaRules[g,x,long123,n,npos]]; TTCInFile[file_,LlistaRules[g_,x_,long123_,nn_]]:= Module[{npos,ll},ll={}; Do[ll=Union[ll,TTCList1[LlistaMonomis[g,x,long123,n,npos]]]; ll=Union[ll,TTCList1[LlistaRules[g,x,long123,n,npos]]]; TTCInFile[file,Evaluate[HoldLlistaMonomis2[g,x,long123,n,npos]]]; TTCInFile[file,Evaluate[HoldLlistaRules2[g,x,long123,n,npos]]], {n,1,nn},{npos,1,ContadorPropietats[g,x,long123,n]}]; TTCInFileTTC[file,ll/.TTC->Identity]]; TTCInFile[file_,LlistaRules[g_,x_,long123_,{n_,nn__}]]:= Do[TTCInFile[file,LlistaRules[g,x,long123,{n,nn}[[iii]]]], {iii,1,Length[{n,nn}]}]; TTCInFile[file_,LlistaRules[g_,x_,long123_,{n_}]]:= Module[{npos,ll},ll={}; Do[ll=Union[ll,TTCList1[LlistaMonomis[g,x,long123,n,npos]]]; ll=Union[ll,TTCList1[LlistaRules[g,x,long123,n,npos]]]; TTCInFile[file,Evaluate[HoldLlistaMonomis2[g,x,long123,n,npos]]]; TTCInFile[file,Evaluate[HoldLlistaRules2[g,x,long123,n,npos]]], {npos,1,ContadorPropietats[g,x,long123,n]}]; TTCInFileTTC[file,ll/.TTC->Identity]]; InputSRiemannQ=True; TTCInFile[f__,HoldInputSRiemann[a__],b___]:=( InputSRiemannQ=False; TTCInFile[f,InputSRiemann[a],b]; InputSRiemannQ=True;); InputSMetricQ=True; TTCInFile[f__,HoldInputSMetric[a__],b___]:=( InputSMetricQ=False; TTCInFile[f,InputSMetric[a],b]; InputSMetricQ=True;); InputSChristoffelTensorQ=True; TTCInFile[f__,HoldInputSChristoffelTensor[a__],b___]:=( InputSChristoffelTensorQ=False; TTCInFile[f,InputSChristoffelTensor[a],b]; InputSChristoffelTensorQ=True;); InputSAFormQ=True; TTCInFile[f__,HoldInputSInputSAForm[a__],b___]:=( InputSAFormQ=False; TTCInFile[f,InputSAForm[a],b]; InputSAFormQ=True;); (******************************************************************) TTCInFile[file_,exprs__]:=(Format[Continuation[n_]]:=""; Format[LineBreak[n_]]:="\\"; Module[{hseq,lexprs,expr,toexpr,i,j,sfile,hlexprs}, lexprs:=lexprs={exprs}; sfile=If[Head[file]===String,file, StringReplace[ StringDrop[StringDrop[ToString[Hold[file]],5],-1], {" . "->"."}]]; hseq=HoldSequence[exprs]; expr[i_]:=expr[i]=If[Head[lexprs[[i]]]===String, StringJoin[StringReplace[lexprs[[i]],{"TTCIndexD[AbsoluteD],"->".;", "TTCIndexD[TTCPartialD[1]],"->".,", "TTCIndexD[TTCPartialD[2]],"->".|", "TTCIndexS[1[1]],"->".<<", ",TTCIndexS[1[0]]"->">>.", "TTCIndexS[2[1]],"->".<", ",TTCIndexS[2[0]]"->">." }]], StringJoin[StringReplace[ StringDrop[StringDrop[ToString[InputForm[hseq[[i]]] ],5],-1], {"TTCIndexD[AbsoluteD],"->".;", "TTCIndexD[TTCPartialD],"->".,", "TTCIndexD[TTCPartialD[1]],"->".,", "TTCIndexD[TTCPartialD[2]],"->".|", "TTCIndexS[1[1]],"->".<<", ", TTCIndexS[1[0]]"->">>.", "TTCIndexS[2[1]],"->".<", ", TTCIndexS[2[0]]"->">." }]]]; toexpr[i_]:=toexpr[i]= If[Head[lexprs[[i]]]===String,ToExpression[lexprs[[i]]], lexprs[[i]] ]; Do[ If[Head[lexprs[[j]]]===String||lexprs[[j]]===Null, PutAppend[OutputForm[expr[j]],sfile]; PutAppend[OutputForm[" (***************************************************************)"],sfile], PutAppend[ OutputForm[ StringJoin[expr[j],":=",ToString[InputForm[toexpr[j]]],";"]],sfile]; PutAppend[OutputForm[" (***************************************************************)"],sfile]] ,{j,1,Length[lexprs]}];Remove[hseq,expr,toexpr,lexprs]]; Clear[Continuation];Clear[LineBreak];); (********* TTCSave:TTCOutFile ************************************) SetAttributes[TTCOutFile,HoldAll]; TTCOutFile[file_]:=(1;) TTCOutFileTTC[file_,list_]:= Module[{part,rest,tot,ii}, Format[Continuation[n_]]:=""; part=Partition[list,100]; rest=If[part=!={}, Take[ list,{100*Length[part]+1,Length[list]}],list]; tot=Which[ part==={},{rest}, rest==={},part, True,Append[part,rest]]; Do[ TTCOutFileN[file,tot[[ii]] ],{ii,1,Length[tot]}]; Print[Length[list], " TTC compacted objects"]; Print["succesfully saved on file"]; Print[file]; Clear[Continuation];]; TTCOutFileN[file_,exprs_List]:= Module[{ii}, PutAppend[Sequence@@Flatten[( Table[{OutputForm[StringJoin["TTCR[",ToString[exprs[[ii]]],"]=\n"]], OutputForm[TTCR[exprs[[ii]]]], OutputForm["\n ****************************************************************\n"] },{ii,1,Length[exprs]}])],file]]; TTCOutFile[file_,exprs1___,Basis[b_],exprs2___]:= (TTCOutFile[file,exprs1]; TTCOutFile[file,BasisSymbols[b]]; TTCOutFile[file,exprs2]); TTCOutFile[file_,exprs1___,Change[x_,xs_],exprs2___]:= (TTCOutFile[file,exprs1]; TTCOutFile[file,BasisVectorChange[x,xs],BasisFormChange[x,xs], BasisVectorChange[xs,x],BasisFormChange[xs,x]]; TTCOutFile[file,exprs2])/;Head[x]===List||Head[xs]===List; TTCOutFile[file_,exprs1___,Change[x_,xs_],exprs2___]:= (TTCOutFile[file,exprs1]; TTCOutFile[file,CoordinateChange[x,xs],BasisFormChange[x,xs]]; If[Dimension[x]===Dimension[xs], TTCOutFile[file,BasisVectorChange[x,xs]],1]; TTCOutFile[file,exprs2]); TTCOutFile[file_,HoldStructureCoefficient[b_][i_,j_,k_]]:= TTCOutFile[file,StructureCoefficient[b][i,j,k]]; TTCOutFile[file_,exprs1___,StructureCoefficientTensor[b_],exprs2___]:= Module[{i,j,k,dim},dim=Dimension[b]; TTCOutFile[file,exprs1];Do[ TTCOutFile[file, Evaluate[ HoldStructureCoefficient[b][-j,-k,i] ] ], {i,1,dim},{k,2,dim},{j,1,k-1}]; TTCOutFile[file,exprs2] ]; TTCOutFile[file_,HoldChristoffel[g_,x_][i_,j_,k_]]:= TTCOutFile[file,Christoffel[g,x][i,j,k]]; TTCOutFile[file_,exprs1___,ChristoffelTensor[g_,x_],exprs2___]:= Module[{dim,i,j,k,s},dim=Dimension[x]; s=If[Head[x]=!=List,j,1]; TTCOutFile[file,exprs1]; Do[ TTCOutFile[file, Evaluate[ HoldChristoffel[g,x][-i,-j,-k] ] ], {i,1,dim},{j,1,dim},{k,s,dim}]; Do[ TTCOutFile[file, Evaluate[ HoldChristoffel[g,x][i,-j,-k] ] ], {i,1,dim},{j,1,dim},{k,s,dim}]; TTCOutFile[file,exprs2]; ]; TTCOutFile[file_,HoldStructureCoefficient[g_,b_][i_,j_,k_]]:= TTCOutFile[file,StructureCoefficient[b][i,j,k]]; TTCOutFile[file_,exprs1___,StructureCoefficientTensor[g_,b_],exprs2___]:= Module[{i,j,k,dim},dim=Dimension[b]; TTCOutFile[file,exprs1];Do[ TTCOutFile[file, Evaluate[ HoldStructureCoefficient[g,b][-j,-k,-i] ] ], {i,1,dim},{k,2,dim},{j,1,k-1}]; TTCOutFile[file,exprs2] ]; TTCOutFile[file_,HoldRiemannComponent[g_,x_][i_,j_,k_,l_]]:= TTCOutFile[file,RiemannComponent[g,x][i,j,k,l]]; TTCOutFile[file_,exprs1___,Riemann[g_,x_],exprs2___]:= Module[{dim,i,j,k,l},dim=Dimension[x]; TTCOutFile[file,exprs1]; Do[If[(!(i===j))&& (!(k===l))&& (!(i j && k >l))&& (!(i<0 && (i > k > l > j))), TTCOutFile[file, Evaluate[ HoldRiemannComponent[g,x][i,j,k,l] ] ]], {i,-dim,-1},{j,-dim,-1},{k,-dim,-1},{l,-dim,-1}]; TTCOutFile[file,exprs2]]; TTCOutFile[file_,expr1___,Index[g___,SimplifyAllIndex[n__]][M_],expr2___]:= TTCOutFile[file,expr1,expr2]; TTCOutFile[file_,expr1___,InputTensor[T_],expr2___]:= TTCOutFile[file,expr1,TensorSymmetries[T],expr2]; InputSRiemannQ=True; TTCOutFile[f__,HoldInputSRiemann[a__],b___]:=( InputSRiemannQ=False; TTCOutFile[f,InputSRiemann[a],b]; InputSRiemannQ=True;); InputSMetricQ=True; TTCOutFile[f__,HoldInputSMetric[a__],b___]:=( InputSMetricQ=False; TTCOutFile[f,InputSMetric[a],b]; InputSMetricQ=True;); InputSChristoffelTensorQ=True; TTCOutFile[f__,HoldInputSChristoffelTensor[a__],b___]:=( InputSChristoffelTensorQ=False; TTCOutFile[f,InputSChristoffelTensor[a],b]; InputSChristoffelTensorQ=True;); TTCOutFile[f__,HoldInputSInputSAForm[a__],b___]:=( InputSAFormQ=False; TTCOuFile[f,InputSAForm[a],b]; InputSAFormQ=True;); TTCOutFile[file_,HoldLlistaMonomis[g_,x_,long123_,n_,npos_]]:=( TTCSaveList=Union[TTCSaveList,TTCList1[LlistaMonomis[g,x,long123,n,npos]]]; TTCOutFile[file,LlistaMonomis[g,x,long123,n,npos]];); TTCOutFile[file_,HoldLlistaRules[g_,x_,long123_,n_,npos_]]:= (TTCSaveList=Union[TTCSaveList,TTCList1[LlistaRules[g,x,long123,n,npos]]]; TTCOutFile[file,LlistaRules[g,x,long123,n,npos]];); TTCOutFile[file_,HoldLlistaMonomis2[g_,x_,long123_,n_,npos_]]:= TTCOutFile[file,LlistaMonomis[g,x,long123,n,npos]]; TTCOutFile[file_,HoldLlistaRules2[g_,x_,long123_,n_,npos_]]:= TTCOutFile[file,LlistaRules[g,x,long123,n,npos]]; TTCOutFile[file_,LlistaRules[g_,x_,long123_,nn_]]:= Module[{npos,long},ll={}; long=If[Head[long123]===List,Length[long123],long123]; Do[TTCOutFile[file,Evaluate[HoldLlistaMonomis2[g,x,long123,n,npos]]]; TTCOutFile[file,Evaluate[HoldLlistaRules2[g,x,long123,n,npos]]], {n,1,nn},{npos,1,ContadorPropietats[g,x,long,n]}]; ]; TTCOutFile[file_,LlistaRules[g_,x_,long123_,{n_,nn__}]]:= Do[TTCOutFile[file,LlistaRules[g,x,long123,{n,nn}[[iii]]]], {iii,1,Length[{n,nn}]}]; TTCOutFile[file_,LlistaRules[g_,x_,long123_,{n_}]]:= Module[{npos,long},ll={}; long=If[Head[long123]===List,Length[long123],long123]; Do[TTCOutFile[file,Evaluate[HoldLlistaMonomis2[g,x,long123,n,npos]]]; TTCOutFile[file,Evaluate[HoldLlistaRules2[g,x,long123,n,npos]]], {npos,1,ContadorPropietats[g,x,long,n]}]; ]; TTCOutFile[file_,exprs__]:=( Format[Continuation[n_]]:=""; Module[{hseq,lexprs,expr,toexpr,i,j,sfile,tostring}, lexprs={exprs}; hseq=HoldSequence[exprs]; sfile=If[Head[file]===String,file, StringReplace[ StringDrop[StringDrop[ToString[Hold[file]],5],-1], {" . "->"."}]]; expr[i_]:=expr[i]=If[Head[lexprs[[i]]]===String, StringReplace[lexprs[[i]],{"TTCIndexD[AbsoluteD],"->".;", "TTCIndexD[TTCPartialD[1]],"->".,", "TTCIndexD[TTCPartialD[2]],"->".|", "TTCIndexS[1[1]],"->".<<", ",TTCIndexS[1[0]]"->">>.", "TTCIndexS[2[1]],"->".<", ",TTCIndexS[2[0]]"->">." }], StringReplace[ StringDrop[StringDrop[ToString[InputForm[hseq[[i]]] ],5],-1], {"TTCIndexD[AbsoluteD],"->".;", "TTCIndexD[TTCPartialD[1]],"->".,", "TTCIndexD[TTCPartialD[2]],"->".|", "TTCIndexS[1[1]],"->".<<", ", TTCIndexS[1[0]]"->">>.", "TTCIndexS[2[1]],"->".<", ", TTCIndexS[2[0]]"->">." }]]; toexpr[i_]:=toexpr[i]= If[Head[lexprs[[i]]]===String,ToExpression[lexprs[[i]]],lexprs[[i]] ]; Do[ If[Head[lexprs[[j]]]===String||lexprs[[j]]===Null, PutAppend[OutputForm[expr[j]],sfile]; PutAppend[OutputForm[" ****************************************************************"],sfile], PutAppend[ OutputForm[ StringJoin[expr[j],":="]],sfile]; PutAppend[ OutputForm[toexpr[j]],sfile]; PutAppend[OutputForm[" *****************************************************************"],sfile]], {j,1,Length[lexprs]}];Remove[hseq,expr,toexpr,lexprs]]; Clear[Continuation]); (*************** TTCSave ****************************************) SetAttributes[TTCSave,HoldAll] IniSimplifyAllIndexSaveQ=False; TTCSave[a_[file_],b__]:= Module[{offon},offon=CompactOffOn;Compact[a]; TTCSave[file,b];Compact[offon];]; TTCSave[file_,options_,exprs___]:= If[IniSimplifyAllIndexSaveQ, Print["You must resume IniSimplifyAllIndexSave\n using EndSimplifyAllIndexSave"], Module[{string1,ttclist,rules,filein,fileout}, rules={ Change[x_,xs_]:> Which[CoordinateChangeQ[x,xs], If[Dimension[x]===Dimension[xs], {CoordinateChange[x,xs],BasisFormChange[x,xs], BasisVectorChange[x,xs]}, {CoordinateChange[x,xs],BasisFormChange[x,xs]}], True, {BasisFormChange[x,xs],BasisVectorChange[x,xs], BasisFormChange[xs,x],BasisVectorChange[xs,x]}]}; TTCSaveList={}; string1=If[Head[file]===String,file, StringReplace[ StringDrop[StringDrop[ToString[Hold[file]],5],-1], {" . "->"."}]]; Which[Hold[options]===Hold[In], TTCInFile[string1,exprs]; If[CompactOffOn===On, TTCSaveList=Join[TTCSaveList,{exprs}]; ttclist=(TTCList[TTCSaveList/.rules]/.TTC->Identity);TTCSaveList={}; If[ttclist=!={},TTCInFileTTC[string1,ttclist]]; ], Hold[options]===Hold[Out], TTCOutFile[file,exprs]; If[CompactOffOn===On, TTCSaveList={exprs}; ttclist=TTCList[TTCSaveList/.rules]/.TTC->Identity;TTCSaveList={}; If[ttclist=!={},TTCOutFileTTC[string1,ttclist]]; ], True, filein=StringJoin[string1,".in"];fileout=StringJoin[string1,".out"]; TTCInFile[filein,options,exprs]; TTCOutFile[fileout,options,exprs]; If[CompactOffOn===On, TTCSaveList=Join[TTCSaveList,{options,exprs}]; ttclist=TTCList[TTCSaveList/.rules]/.TTC->Identity;TTCSaveList={}; If[ttclist=!={},TTCInFileTTC[filein,ttclist]]; ttclist=TTCList[{options,exprs}/.rules]/.TTC->Identity;TTCSaveList={}; If[ttclist=!={},TTCOutFileTTC[fileout,ttclist]]; ] ];]]; (*********** CoordinateNames ************************************) CoordinateNames:=coordinatenames//ColumnForm; coordinatenames={}; (****************** BasisNames ***********************************) BasisNames:=basisnames//ColumnForm; basisnames={}; (************** InputCoordinates *********************************) Coordinates::exist=" The coordinates `1` already exist" Coordinates::XX=" The coordinates XX can only change dimension." XX[x__]:=ZZ[XX,x]; Dimension[XX]=3; InputCoordinates[XX,n_Integer]:= Module[{symbols}, Off[Metric::notclear,Metric::notexist,Coordinates::notclear]; If[NumberQ[Dimension[XX]],ClearCoordinates[XX]]; On[Metric::notclear,Metric::notexist,Coordinates::notclear]; Dimension[XX]=n; If[coordinatenames==={},1, coordinatenames=Delete[coordinatenames, 1 ] ]; symbols=Table[ToExpression[StringJoin["X", ToString[i]]], {i, n}]; coordinatenames=Append[coordinatenames,{XX,symbols}]; coordinatenames=RotateRight[coordinatenames]; If[metricnames==={},1, metricnames=Delete[metricnames, 1 ] ]; metricnames=Append[metricnames,{Euclidean,XX,symbols}]; metricnames=RotateRight[metricnames]; CoordinateNames ]; InputCoordinates[name_, symbols_List]:= If[name===XX,Message[Coordinates::XX]; InputCoordinates[XX,Input[ "Enter Dimension[XX], Interrupt[] or Dialog[] \n "]], If[ CoordinatesQ[name], Message[Coordinates::exist,name];, CoordinatesQ[names]=True; name[x__]:=ZZ[name,x];(*xavier 3set97*) coordinatenames= Append[coordinatenames,{name,symbols}]; Off[Unset::norep];Dimension[name]=. ;On[Unset::norep];]; CoordinateNames ]; InputCoordinates[name_,n_]:=( Print["Dimension[",name,"]=",n]; Off[Metric::notclear,Metric::notexist,Coordinates::notclear]; If[name===XX&&NumberQ[Dimension[XX]],ClearCoordinates[XX], If[name=!=XX&&CoordinatesQ[name],ClearCoordinates[name]]; Print["If you want to make explicit calculus"]; Print["remember enter"]; Print[StringJoin["InputCoordinates[",ToString[name],",{symbol1,...,symbol",ToString[n],"}]"]]]; On[Metric::notclear,Metric::notexist,Coordinates::notclear]; If[!NumberQ[n],InputTensor[n,name,{False},{Constant}]]; Dimension[name]=n;); (**************** InputBasis ***********************************) BasisSymbols::exist=" The basis `1` already exist" BasisSymbols::name="The name `1` already\n exist as a name of a basis so it cannot\n be used used a symbol to enter basis elements" InputBasis[{x_,name_}]:= InputBasis[{x,name},Module[{i},Table[i,{i,1,Dimension[x]}] ] ]; InputBasis[name_, symbols_List]:=( If[ BasisQ[name], Message[BasisSymbols::exist, name], If[Cases[basisnames,{{x_,name[[2]]},{l__}}]==={}, name[[2]][x__]:=ZZ[name,x], Message[BasisSymbols::name, name[[2]]]]; basisnames= Append[basisnames,{name,symbols}]; ]; BasisNames); (**************** ClearCoordinates ****************************) Coordinates::notclear="Coordinates XX can't be removed." Coordinates::notexist="Coordinates `1` do not exist"; clearchangelist[g_:1][{x_,xs_}]:=ClearChange[x,xs,g]; clearmetriclist[g_][{x_,xs_}]:=ClearMetric[g,x,xs]; ClearCoordinates[name_]:= Module[{mg,bv1,bv2,j,pos},If[name===XX, Message[Coordinates::notclear]; Off[Metric::notclear,Metric::notexist,Coordinates::notclear], 1]; If[CoordinatesQ[name], If[name=!=XX,name[x__]=.]; bv1=Cases[basisnames,{{name,a_},b_}]; bv2=bv1/.{{name,a_},b_}:>{name,a}; ClearBasis/@bv2; mg=Cases[metricnames,{g_,name,l_}]; If[mg==={},1, Do[clearmetriclist[(mg[[j]][[1]])]/@(Cases[ coordinatechangenames,{name,a_}]); clearchangelist[(mg[[j]][[1]])]/@(Cases[ coordinatechangenames,{a_,name}]); ClearMetric[(mg[[j]][[1]]),name], {j,1,Length[mg]} ] ]; clearchangelist[]/@(Cases[coordinatechangenames,{name,a_}]); clearchangelist[]/@(Cases[coordinatechangenames,{a_,name}]); If[name===XX,1, pos=Position[coordinatenames, {name, a__}][[1]]; coordinatenames= Delete[coordinatenames, pos[[1]]] ], Message[Coordinates::notexist,name] ]; On[Metric::notclear,Metric::notexist,Coordinates::notclear]; CoordinateNames ]; (**************** ClearTTC ************************************) ClearTTC:= (While[Length[coordinatenames]>1, ClearCoordinates[coordinatenames[[2]][[1]]]];InputCoordinates[XX,3]); (********************** ClearBasis ****************************) BasisSymbols::notexist="Basis vectors `1` do not exist"; ClearStructureCoefficients[name_]:= Module[{dim,i,j,k},dim=Dimension[name]; StructureCoefficientTensor[name]=1;StructureCoefficientTensor[name]=.; Do[ StructureCoefficient[name][-j,-k,i]=1;StructureCoefficient[name][-j,-k,i]=., {i,-dim,dim},{j,1,dim},{k,1,dim} ] ]; ClearBasis[name_]:= Module[{mg,j,pos}, Off[Metric::notclear,Metric::notexist,Coordinates::notclear]; If[BasisQ[name], If[!FreeQ[name[[2]][1],name[[1]]],name[[2]][x__]=.]; ClearStructureCoefficients[name]; mg=Cases[metricnames,{g_,name,l_}]; If[mg==={},1, Do[clearmetriclist[(mg[[j]][[1]])]/@(Cases[ basischangenames,{name,a_}]); clearchangelist[(mg[[j]][[1]])]/@(Cases[ basischangenames,{a_,name}]); ClearMetric[(mg[[j]][[1]]),name], {j,1,Length[mg]} ] ]; clearchangelist[]/@(Cases[basischangenames,{name,a_}]); clearchangelist[]/@(Cases[basischangenames,{a_,name}]); pos=Position[basisnames, {name, a__}][[1]]; basisnames=Delete[basisnames, pos[[1]]], Message[BasisSymbols::notexist,name] ]; On[Metric::notclear,Metric::notexist,Coordinates::notclear]; BasisNames ]; (*********************** Coordinates ****************************) Coordinates[{x_,b_}]:=Coordinates[x] Coordinates[name_]:= Module[{pos}, If[ CoordinatesQ[name], pos=Position[coordinatenames, {name, a__}][[1]]; Identity@@Delete[coordinatenames[[ pos[[1]] ]],1], Message[Coordinates::notexist, name]; InputCoordinates[name,Input[StringJoin[ "Enter the list of symbols for the coordinates ",ToString[name], ", Interrupt[] or Dialog[] \n "]]]; pos=Position[coordinatenames, {name, a__}][[1]]; Identity@@Delete[coordinatenames[[ pos[[1]] ]],1], Null ] ]; (*********** BasisSymbols ****************************************) BasisSymbols[name_List]:= Module[{pos}, If[ BasisQ[name], pos=Position[basisnames, {name, a__}][[1]]; Identity@@Delete[basisnames[[ pos[[1]] ]],1], Message[BasisSymbols::notexist, name]; InputBasis[name,Input[StringJoin[ "Enter the list of symbols for the basis ",ToString[name], ", Interrupt[] or Dialog[] \n "]]]; pos=Position[basisnames, {name, a__}][[1]]; Identity@@Delete[basisnames[[ pos[[1]] ]],1], Null ] ]; BasisSymbols[x_]:=Coordinates[x]; (******************* Coordinate ********************************) Coordinate[name_][i_Integer]:=Coordinates[name][[i]]; (**************** BasisSymbol **********************************) BasisSymbol[name_][i_]:=BasisSymbols[name][[i]]; (****************** Dimension **********************************) Dimension[{x_,b_}]:=Dimension[x]; Dimension[name_]:=Length[Coordinates[name]]; (********************* CoordinatesQ *****************************) CoordinatesQ[XX]=True; CoordinatesQ[{x_,b_}]:=CoordinatesQ[x]; CoordinatesQ[coord_]:= MemberQ[coordinatenames, {coord, a__}]; (******************** BasisQ *************************************) BasisQ[v_List]:=MemberQ[basisnames, {v,a__}]; BasisQ[x_]:=CoordinatesQ[x]; (********************** ToIndex ***********************************) ToIndex[x_][{a___}]:={toindex[x]/@{a}}; ToIndex[x_][a___]:=toindex[x]/@{a}; toindex[x_][-a_]:=-toindex[x][a] toindex[{x_,b_}][a_]:= If[NumberQ[a]===True,a, Identity@@Identity@@Position[BasisSymbols[{x,b}],a] ]; toindex[x_][a_]:= If[NumberQ[a]===True,a, Identity@@Identity@@Position[Coordinates[x],a]]; (************************ ToSymbolA *******************************) NewIndexList0={}; NewIndexList:=Union[NewIndexList0]; ToSymbolA[s_][n_]:= Module[{tosim}, tosim=ToSymbolN[s][n]; NewIndexList0=Append[NewIndexList0,AbsSymbol[tosim]]; tosim]; ToSymbolN[s_][n_]:=ToExpression[StringJoin[ToString[s],ToString[n] ] ]; ToSymbolN[s_][-n_]:=ToExpression[StringJoin["$",ToString[s],ToString[n] ] ]; (*************************** ZZ ****************************************) Format[ZZX]=ZZ; ZZ[x_][]:=1; ZZ[x_,{}]:=1; ZZ[x_][{a_}]:=ZZX[x,Sequence@@ToIndex[x][a]]; ZZ[x_][{a_,b__}]:= Module[{ti},ti=ToIndex[x][a,b]; Signature[ti] ZZX[x,Union[ti]]/; ti=!=Union[ti] ]; ZZ[x_][b__]:=ZZX[x,Sequence@@ToIndex[x][b]]; ZZ[{a_}]:=ZZX[XX,Sequence@@ToIndex[XX][a]]; ZZ[{a_,b__}]:= Module[{ti},ti=ToIndex[XX][a,b]; Signature[ti] ZZX[XX,Union[ti]]/; ti=!=Union[ti] ]/;!CoordinatesQ[a]; ZZ[x_,{a_}]:=ZZX[x,Sequence@@ToIndex[x][a]]; ZZ[x_,{a_,b__}]:= Module[{ti},ti=ToIndex[x][a,b]; Signature[ti] ZZX[x,Union[ti]]/; ti=!=Union[ti] ]; ZZ[a_,b___]:=ZZX[XX,Sequence@@ToIndex[XX][a,b]]/;!CoordinatesQ[a]; ZZ[b_,x__]:=ZZX[b,Sequence@@ToIndex[b][x]]; ZZXX[x_]:=1; ZZXX[x_,y__]:=ZZX[x,y]; (************* Output format order for tensors *******************) (Unprotect[Times]; Format[Times[a_ , ZZX[x_,b__]]]:=If[Head[a]===Plus, SequenceForm["(",a,")"," ",ZZX[x,b]], SequenceForm[a," ",ZZX[x,b]] ]/;a=!=-1; Protect[Times]); (**************** TTCTensorQ and ScalarQ *****************************) TTCTensorQ[0]=False; (*xavier 1 desembre 98 al tanto *) (* (Input[ "Enter True or False TTCTensorQ[0], Interrupt[] or Dialog[] \n"]) *) TTCTensorQ[c_. ZZX[b_,a__]]:=True; TTCTensorQ[Plus[a_,b__]]:=TTCTensorQ[a]; TTCTensorQ[a_ b_]:=TTCTensorQ[a]||TTCTensorQ[b]; TTCTensorQ[a_OuterProduct]:=True; TTCTensorQ[_]:=False; ScalarQ[0]=True; (*xavier 1 desembre 98 al tanto *) (* (Input[ "Enter True or False ScalarQ[0], Interrupt[] or Dialog[] \n"]) *) ScalarQ[a_?NumericQ]:=True; ScalarQ[a_]:=!TTCTensorQ[a] (***************** FormQ ***************************************) FormQ[0]=False;(*xavier 1 desembre 98 al tanto *) FormQ[b_. ZZX[x_,{a__}]]:=True; FormQ[b_. ZZX[x_,a_]]:=If[Positive[a]===True,True,False]; FormQ[a_ b_]:=FormQ[a]||FormQ[b]; FormQ[Plus[a_,b__]]:=FormQ[a]; FormQ[_]:=False; (***************** InternalFormQ ***************************************) InternalFormQ[0]=False;(*xavier 1 desembre 98 al tanto *) InternalFormQ[b_. ZZX[x_,{a__}]]:=True; InternalFormQ[b_. ZZX[x_,a_]]:=False; InternalFormQ[a_ b_]:=InternalFormQ[a]||InternalFormQ[b]; InternalFormQ[Plus[a_,b__]]:=InternalFormQ[a]; InternalFormQ[_]:=False; (****** SymbolicIndexTensorQ*****************) ExplicitTensorQ[T_]:=!SymbolicTensorQ[T]; SymbolicIndexTensorQ[0[l__]]:=True; SymbolicIndexTensorQ[T_]:=SymbolicTensorQ[T]||SymbolicTensorQ[Head[T]]; SymbolicIndexTensorQ[T_[b___,TTCIndexD[y_],c__]]:= SymbolicTensorQ[T]||SymbolicIndexTensorQ[T]; SymbolicIndexTensorQ[T_ Q_]:=SymbolicIndexTensorQ[T]&& SymbolicIndexTensorQ[Q]; SymbolicIndexTensorQ[T_+ Q_]:=SymbolicIndexTensorQ[T]&& SymbolicIndexTensorQ[Q]; SymbolicIndexTensorQ[Power[Q_,n_]]:=SymbolicIndexTensorQ[Q]; SymbolicIndexTensorQ[Sqrt[Q_]]:=SymbolicIndexTensorQ[Q]; (***************** ExteriorToOuter *********************************) exteriortoouter[0]:=0; ExteriorToOuter[0]:=0; exteriortoouter[T_]:=If[InternalFormQ[T],ExteriorToOuter[T],T]; ExteriorToOuter[T_]:= (T/.(ZZX[x_,{b__}]:>If[Length[{b}]===1, ZZX[x,b],Antisymmetric[-1,ZZX[x,b]] ]))//CompactTensor; (****************** OuterToExterior ********************************) outertoexterior[0]:=0; OuterToExterior[0]:=0; outertoexterior[T_]:=If[InternalFormQ[T],T,OuterToExterior[T]]; OuterToExterior[T_]:= (T/.(ZZX[x_,a_,b___]:>If[MatchQ[a,{l__}],ZZX[x,a], 1/Factorial[Length[{a,b}]] Signature[{a,b}] ZZX[x,Sort[{a,b}]]]))//CompactTensor; (****************** TensorToMatrix **********************************) (*xavier 2005*) SetAttributes[Rank,Listable]; Rank[T_]:=Length[ Flatten[ TensorType[T] ] ]; TensorToMatrix[Equal[a_,b_]]:=Equal[TensorToMatrix[a],TensorToMatrix[b]]; TensorToMatrix[List[a_]]:=TensorToMatrix[a]; TensorToMatrix[T_?TTCTensorQ]:= Module[{oT,b, r, tt, ss, zz}, oT=T//exteriortoouter//CompactTensor; b=Basis[oT]; r=Rank[oT]; tt=Table[Dimension[b], {r}]; ss=Array[-TensorType[oT]*List[##]&, tt]; zz=Apply[ZZ[b], ss, {r}]; Map[Coefficient[oT, #]&, zz, {r}] ]; TensorToMatrix[T_]:=T (********************* MatrixToTensor *********************************) MatrixToTensor[m_, type_, basis_]:= Module[{rank, f, elem,result}, rank=Dimensions[m]; f[i__]:=ZZ[basis]@@((-type)*{i}); elem=Array[f, rank]; result=Plus@@Flatten[m*elem]; Remove[f]; result ]; (************************** TensorType **********************************) ZZType[0]:=(-Input[ "Enter TensorType[0], Interrupt[] or Dialog[] \n "]); ZZType[c_. ZZX[b_,{a_}]]:={Sign/@{a}}; ZZType[c_. ZZX[b_,a__]]:=Sign/@{a}; ZZType[a_ b_?TTCTensorQ]:=ZZType[b] ; ZZType[Plus[a_,b__]]:=ZZType[a]; ZZType[a_]:={} ; TensorType[T_]:=-ZZType[T]; (****************** TTCOutFormat TTCInFormat *****************************) bform[{x_,b_}][aa_]:=If[aa>0, SequenceForm[b,"[",BasisSymbol[{x,b}][aa],"]" ], SequenceForm[b,"[",-BasisSymbol[{x,b}][-aa],"]" ]]; bform[xx_][aa_]:=If[aa>0,SequenceForm["d",Coordinate[xx][aa]], SequenceForm["D",Coordinate[xx][-aa]]]; TTCOutFormat:=( Format[ZZX[{x_,b_},{c_}]]:=bform[{x,b}][c]; Format[ZZX[{xx_,b_},{bb__}]]:= SequenceForm@@Join[Join@@ Table[{bform[{xx,b}][ Part[{bb},pp] ],"*^"},{pp,1,Length[{bb}]-1}], {bform[{xx,b}][ Part[{bb},Length[{bb}] ] ] } ]; Format[ZZX[{xx_,b_},bb_]]:=bform[{xx,b}][bb]; Format[ ZZX[{xx_,b_},bb__] ]:= SequenceForm@@Join[Join@@ Table[{bform[{xx,b}][ Part[{bb},pp] ],"*."},{pp,1,Length[{bb}]-1}], {bform[{xx,b}][ Part[ {bb},Length[{bb}] ] ] } ]; Format[ZZX[xx_,{bb_}]]:=bform[xx][bb]; Format[ZZX[xx_,{bb__}]]:= SequenceForm@@Join[Join@@ Table[{bform[xx][ Part[{bb},pp] ],"*^"},{pp,1,Length[{bb}]-1}], {bform[xx][ Part[{bb},Length[{bb}] ] ] } ]; Format[ZZX[xx_,bb_]]:=bform[xx][bb]; Format[ ZZX[xx_,bb__] ]:= SequenceForm@@Join[Join@@ Table[{bform[xx][ Part[{bb},pp] ],"*."},{pp,1,Length[{bb}]-1}], {bform[xx][ Part[ {bb},Length[{bb}] ] ] } ] ); TTCInFormat:=( Format[ZZX[{x_,b_},{c_}]]=. ; Format[ZZX[{xx_,b_},{bb__}]]=. ; Format[ZZX[{xx_,b_},bb_]]=. ; Format[ ZZX[{xx_,b_},bb__] ]=. ; Format[ZZX[xx_,{bb_}]]=. ; Format[ZZX[xx_,{bb__}]]=. ; Format[ZZX[xx_,bb_]]=. ; Format[ ZZX[xx_,bb__] ]=. ; ); (*************************** Basis ************************************) Basis[a_]:= If[ScalarQ[a]===True, If[ScalarBasisQ===True,( Module[{offon,result},offon=CompactOffOn;Compact[Off]; result=Input[StringJoin["Enter the name of the basis or coordinates of: ", ToString[InputForm[a]]," or Interrupt[] or Dialog[] \n "]]; Compact[offon];result]),ScalarBasis], basis[a]]; basis[Plus[a_,b__]]:=basis[a]; basis[a_. ZZX[x_,y__]]:=x ; basis[a_ b_?TTCTensorQ]:=basis[b]; (************************* TensorComponent ******************************) TensorComponent[0][b__]:=0; (* xavier 25 agost 1999:arreglat n[x] de uniczz !! de fet eliminat per innecessari i eqivoc *) TensorComponent[T_][{a_}]:=TensorComponent[T][a]; TensorComponent[T_?InternalFormQ][a_,bb__]:= TensorComponent[T//ExteriorToOuter][a,bb] TensorComponent[T_][bb__]:= If[CompactOffOn===On, Module[{bt,btbb,Texpanded,uniczz,result}, Texpanded=T//.(a_ Plus[b_. ZZX[x__],c__]:>Plus@@(a{ b ZZX[x],c})); bt=Basis[Texpanded]; btbb=Join[{bt},-ToIndex[bt][bb]]; uniczz[a_Plus]:=uniczz/@a; uniczz[a_. ZZX@@btbb]:=a; uniczz[a_]:=0; result=TTCComponent[uniczz[Texpanded]]; Remove[uniczz]; result], Compact[On]; Module[{bt,btbb,Texpanded,uniczz,result}, Texpanded=T//.(a_ Plus[b_. ZZX[x__],c__]:>Plus@@(a{ b ZZX[x],c})); bt=Basis[Texpanded]; btbb=Join[{bt},-ToIndex[bt][bb]]; uniczz[a_Plus]:=uniczz/@a; uniczz[a_. ZZX@@btbb]:=a; uniczz[a_]:=0; result=TTCComponent[uniczz[Texpanded]]; Remove[uniczz];Compact[Off]; result] ]; (***TTCSimplify**************************************) InputTTCSimplify[s_List]:= If[simplification[s][1]=!=1, Print[StringJoin["Some off the objects in ", ToString[s]," are not simplificators:"]]; Interrupt[];TTCSimplify=s,TTCSimplify=s]; InputTTCSimplify[s__]:= If[simplification[{s}][1]=!=1, Print[StringJoin["Some off the objects in ", ToString[{s}]," are not simplificators:"]]; Interrupt[];TTCSimplify={s},TTCSimplify={s}]; (*****************DS*********************************) DS[a_?NumericQ,x_]:=0; DS[a_,x_]:=If[CompactOffOn===On,DSAct[CompactScalar[a],x], Module[{result},Compact[On]; result=DSAct[CompactScalar[a],x];Compact[Off];result]]; DSAct[a_?NumericQ,x_]:=0; DSAct[a_?NumericQ b_,x_]:=a DSAct[b,x]; DSAct[a_ b_,x_]:=b DSAct[a,x]+ a DSAct[b,x]; DSAct[a_Plus,x_]:=Plus@@Flatten[Outer[DS,List@@a,{x}]]; DSAct[Power[a_,n_?NumericQ],x_]:=n Power[a,n-1] DSAct[a,x]; DSAct[TTC[n_],x_]:=If[TTCSimplifyQ[1], (CTSimplify[TTCSimplify]/@TTCList[TTC[n]]; TTCSettings[n]=Append[TTCSettings[n],Hold[DS[TTC[n],x]]]; DS[TTC[n],x]=CompactScalar[D[TTC[n]/.TTC->TTCR,x]]), DS[TTC[n],x]=CompactScalar[DSAct[TTCR[n],x]]]; DSAct[T_?SymbolicTensorQ[i__],t_]:= D[T,t][i];(*xavier 27 oct 97*) DSAct[a_,x_]:=CompactScalar[D[a//UncompactTensor,x]]; (************************** TensorSimplify *******************************) simplification[s_]:=simplification[s]= Composition@@Reverse[s]; TensorSimplify[]=TensorSimplify[TTCSimplify] TensorSimplify[s_][0]:=0; TensorSimplify[s_][a_->b_]:=a->TensorSimplify[s][b]; TensorSimplify[s_][{l__}]:=TensorSimplify[s]/@{l}; TestSimplificationQ=True; TensorSimplify[s_List][T_]:= (If[TestSimplificationQ,If[simplification[s][1]=!=1, Print[StringJoin["Possible some off the objects in ", ToString[s]," are not simplificators:"]];Interrupt[]]]; If[CompactOffOn===On, Module[{Tc},Tc=CompactTensor[T];CompactTensorSimplify[s][Tc];Tc], Module[{Tc},Compact[On];Tc=CompactTensor[T];CompactTensorSimplify[s][Tc]; Compact[Off];Tc]]); TensorSimplify[s__][T_]:=TensorSimplify[{s}][T]; tensorsimplify[n_][T_]:= If[TTCSimplifyQ[n]===True, Module[{result},TestSimplificationQ=False; result=TensorSimplify[TTCSimplify][T];TestSimplificationQ=True;result], CompactTensor[T]]; ScalarSimplify[s_][0]:=0; ScalarSimplify[s_][a_->b_]:=a->ScalarSimplify[s][b]; ScalarSimplify[s_][{l__}]:=ScalarSimplify[s]/@{l}; ScalarSimplify[s_][T_]:= (If[TestSimplificationQ,If[simplification[s][1]=!=1, Print[StringJoin["Possible some off the objects in ", ToString[s]," are not simplificators:"]];Interrupt[]]]; If[CompactOffOn===On, Module[{Tc},Tc=CompactScalar[T];CompactTensorSimplify[s][Tc];Tc], Module[{Tc},Compact[On];Tc=CompactScalar[T];CompactTensorSimplify[s][Tc]; Compact[Off];Tc]]); scalarsimplify[n_][T_]:= If[TTCSimplifyQ[n]===True, Module[{result},TestSimplificationQ=False; result=ScalarSimplify[TTCSimplify][T];TestSimplificationQ=True;result], CompactScalar[T]]; InputSimplifyLevel[n_]:= Module[{i},SimplifyLevel=n; Do[ TTCSimplifyQ[i]=True,{i,0,n}]; Do[TTCSimplifyQ[i]=False,{i,n+1,MaxSimplifyLevel}] ]; MaxSimplifyLevel=10; (***************CompactTensorSimplify***************************) TTCList[]:=Union[Cases[Table[TTC[nn],{nn,1,TTCCounter}], a_TTC,Infinity]];(*xavier 220797*) TTCList[{}]={}; TTCList[a_->b_]:=TTCList[b]; TTCList[a_:>b_]:=TTCList[b]; TTCList[T_]:= Module[{l}, l=Union[ Cases[{T},a_TTC,Infinity]]; Union[l,TTCList[l/.TTC->TTCR]] ]; (*aixo nomes es per a guardar compactificacions de LlistaMonomis, LlistaRules*) TTCList1[T_]:=Cases[{T},a_TTC,Infinity]/.TTC->Identity; TTCSettings[n_]:={}; CTSimplify[s_][TTC[n_]]:= Module[{b,ttcb,nnn,number}, If[LastTTCSimp[n]=!=s||s==={Identity},(*xavier 220797*) LastTTCSimp[n]=s; b=simplification[s][TTCR[n]/.TTC->TTCR]; If[NumericQ[b],Off[Unset::norep];(TTCSettings[n]/.Hold->Unset); On[Unset::norep]; TTCSettings[n]={};TTC[n]=b; ListTTCNumbers=Append[ListTTCNumbers,Hold[TTC[n],Evaluate[b]]], If[(ttcb=TTCComponent[b])=!=TTC[n], Off[Unset::norep];(TTCSettings[n]/.Hold->Unset);On[Unset::norep]; TTCSettings[n]={}; number=GetTTCNumber[ttcb]; If[numbernumber]], TTCR[n]=b] ]];]; CompactTensorSimplify[s_][T_]:=(CTSimplify[s]/@TTCList[T];T); (******************* SinTosin/sinToSin ***************************************) cos[x_]:=Sqrt[1-sin[x]^2] SinTosin[a_]:=(a/.{Sin->sin, Cos->cos, Tan[x_]:>sin[x]/cos[x], Cot[x_]:>cos[x]/sin[x], Csc[x_]:>1/sin[x], Sec[x_]:>1/cos[x]}); sinToSin[a_]:=a/.sin->Sin; (************************* IdentityTensor *************************************) IdentityTensor[x_,s1_,s2_]:= Module[{i},Sum[ZZX[x,-s1 i,-s2 i],{i,1,Dimension[x]}]]; (**************************** OuterProduct ***********************************) OuterProduct[a_]:=a; SetAttributes[OuterProduct,{Flat,OneIdentity}]; OutPr[a_]:=a; Attributes[OutPr]={Flat,OneIdentity}; OuterProduct[a___,0,b___]:=0; OuterProduct[a_?ExplicitTensorQ,b_?ExplicitTensorQ]:= (OutPr@@exteriortoouter/@(CompactTensor/@{a,b}))//tensorsimplify[3]; OutPr[a___,0,b___]:=0; OutPr[Plus[a_,b__],c_]:=Plus@@Flatten[Outer[OutPr,{a,b},{c}] ]; OutPr[c_,Plus[a_,b__]]:=Plus@@Flatten[Outer[OutPr,{c},{a,b}] ]; OutPr[a_. ZZX[x_,b__], c_. ZZX[x_,d__]]:=a c ZZX[x,b,d]; OutPr[a_,b_]:=a b/;(ScalarQ[a]||ScalarQ[b]); (*************************** ExteriorProduct *********************************) ExteriorProduct[a_]:=a; SetAttributes[ExteriorProduct,{Flat,OneIdentity}]; Attributes[ExtPr]={Flat,OneIdentity}; ExteriorProduct[a___,0,b___]:=0 ; ExteriorProduct[a_?ExplicitTensorQ,b_?ExplicitTensorQ]:= (ExtPr@@outertoexterior/@(CompactTensor/@{a,b}))//tensorsimplify[3]; ExtPr[a___,0,b___]:=0; ExtPr[Plus[a_,b__],c_]:=Plus@@Flatten[Outer[ExtPr,{a,b},{c}] ]; ExtPr[c_,Plus[a_,b__]]:=Plus@@Flatten[Outer[ExtPr,{c},{a,b}] ]; ExtPr[a_. ZZX[x_,{b__}], c_. ZZX[x_,{d__}]]:=a c ZZ[x,{b,d}] ; ExtPr[a_. ZZX[x_,b_], c_. ZZX[x_,{d__}]]:=a c ZZ[x,{b,d}] ; ExtPr[a_. ZZX[x_,{b__}], c_. ZZX[x_,d_]]:=a c ZZ[x,{b,d}] ; ExtPr[a_. ZZX[x_,b_], c_. ZZX[x_,d_]]:=a c ZZ[x,{b,d}] ; (*xavier 15 setembre 1999*) ExtPr[a_,b_]:=a b/;(ScalarQ[a]||ScalarQ[b]); (******************* Symmetric and Antisymmetric *****************************) Symmetric[0]:=0; Symmetric[a_?ExplicitTensorQ]:=Symmetric[1,a//exteriortoouter]; Symmetric[s_,0]:=0; Symmetric[s_,a_]:= If[Abs[Union[ZZType[a]]]==={1}, Symm[s,a//CompactTensor]//tensorsimplify[3],Fail]; Symm[a_,Plus[b_,c__]]:=Plus@@Flatten[Outer[Symm,{a},{b,c}] ]; Symm[s_,a_. ZZX[x_,b__]]:= Module[{fact,permb},permb=Permutations[{b}]; fact=If[s===1,(Length[permb]),1]; a/fact (Plus@@(ZZT[x] /@ permb))]; Antisymmetric[0]:=0; Antisymmetric[a_?ExplicitTensorQ]:=Antisymmetric[1,a//exteriortoouter]; Antisymmetric[s_,0]:=0; Antisymmetric[s_,a_]:= If[Abs[Union[ZZType[a]]]==={1}, Anti[s,a//CompactTensor]//tensorsimplify[3],Fail]; Anti[a_,Plus[b_,c__]]:=Plus@@Flatten[Outer[Anti,{a},{b,c}] ]; Anti[s_,a_. ZZX[x_,b__]]:= Module[{fact,permb},permb=Permutations[{b}]; fact=If[s===1,(Length[permb]),1]; If[ Signature[{b}]===0,0, a/fact Signature[{b}] Signature/@permb.ZZT[x]/@permb ] ]; ZZT[x_][{b__}]:=ZZX[x,b]; (***************************** TTCIndex Begin ****************************) TTCExpandHead[0[i__]]:=0; TTCExpandHead[0]:=0; TTCExpandHead[T_[i__]]:=CompactTensor[T][i]; (******************** Contractions ****************************************) contractionscalarsimplify=scalarsimplify[2]; Contractions[]:=1; Contractions[a___,0[x__],b___]:=0; Contractions[a___,0,b___]:=0; Contractions[T___,a_,Q___]:= JoinTensorIndex[a Contractions[T,Q] ]/; !TTCTensorQ[ Head[a] ]; Contractions[T__]:= (ContractionsA@@(TTCExpandHead/@{T})); ContractionsA[ T_[l__] ]:= Module[{result,absl,p,ii,lrest,l2,lrest2}, l2=DeleteCases[{l},TTCIndexS[a__]]; absl=AbsSymbol/@{l}; p[x_]:=If[Head[Part[absl,x]]===TTCIndexS,Part[absl,x], If[Count[absl,Part[absl,x]]=!=1,0,Part[{l},x] ] ]; lrest=DeleteCases[Table[p[ii],{ii,1,Length[{l}]}],0]; lrest2=DeleteCases[lrest,TTCIndexS[a__]]; result=If[lrest2==={},(ContractionsC@@l2)[T], ((ContractionsC@@l2)[T])@@lrest]; Remove[p,absl,lrest,lrest2];result ]; (*xavier 290797: introduccio de ContractionsC a traves de ContractionsA*) ContractionsA[T_,Q__]:=Fold[ContractionsB,ContractionsA[T],ContractionsA/@{Q}]; ContractionsB[T___,a_,Q___]:= If[Head[a]===0,0, JoinTensorIndex[a Contractions[T,Q]]]/; Head[a]===0||a===0||!TTCTensorQ[Head[a]]; ContractionsB[ T_[l1___] , Q_[l2___] ]:= Module[{result,ljoin,ljoin2,absljoin,p,l12,l122,ii,x}, ljoin=Join[{l1,l2}]; ljoin2=DeleteCases[ljoin,TTCIndexS[a__]]; absljoin=AbsSymbol/@ljoin; p[x_]:=If[Head[Part[absljoin,x]]===TTCIndexS,Part[absljoin,x], If[Count[absljoin,Part[absljoin,x]]=!=1,0,Part[ljoin,x]]]; l12=DeleteCases[Table[p[ii],{ii,1,Length[ljoin]}],0]; l122=DeleteCases[l12,TTCIndexS[a__]]; result=If[l122==={},(ContractionsC@@ljoin2)[T,Q], ((ContractionsC@@ljoin2)[T,Q])@@l12]; Remove[absljoin,ljoin,p];result ]; ContractionsC[l__][T_,0]:=0; ContractionsC[l__][0,T_]:=0; ContractionsC[l__][T__]:=OutPr[T]/; Length[Union[AbsSymbol/@{l}]]===Length[{l}] ; ContractionsC[l__][T_]:= Module[{coef,n,f,ff,result,length,length1,bT,absl,ii,rule1, contractionsd,lzzplus,lindexzz,torsym,new,newl,condition,or,nor}, coef[x_]:=0; n[x_]:=0; nor=0; ff[x_]:=scalarsimplify[2][coef[x]/n[x]]; torsym[a_]:=torsym[a]=or[nor++]; length1=Length[PlusToList0[Plus[l]]]; length=Length[{l}]; bT=Basis[T]; absl=torsym/@(AbsSymbol/@{l}); rule1=Inner[Rule,absl,Table[1,{ii,1,length}],List]; contractionsd[a_. ZZX[ba1_,s__]]:= (lzzplus=PlusToList0[absl.{s}];If[Length[lzzplus]>length1,0, lindexzz=lzzplus/.rule1; n[lindexzz]++;coef[lindexzz]=coef[lindexzz]+a; f[lindexzz] ZZXX[bT,Sequence@@lindexzz]]); result=((Plus@@(contractionsd/@PlusToList[T]))/.f->ff)// tensorsimplify[1]; (*xavier fast 280797*) condition=""; new[i_]:=If[MemberQ[{l},-i], If[SignSymbol[i]===1, new[i]=New[i];new[-i]=New[i]; condition= StringJoin[condition,"&&(",ToString[FullForm[new[i]+new[-i]]],"===0)"];new[i], new[i]=New[-i];new[-i]=New[-i]; condition= StringJoin[condition,"&&(",ToString[FullForm[new[i]+new[-i]]],"===0)"];new[i]], If[SignSymbol[i]===1,New[i],-New[-i]]]; newl=new/@{l};(*Print["Storing Contracted Tensor"];*) ToExpression[StringReplace[StringJoin[ ToString[ContractionsC],"[",ToString[SequenceHold@@ToPattern/@newl],"][", ToString[FullForm[T]],"]:=",ToString[FullForm[result]], "/;(SignSymbolHold[",ToString[PlusToList],"[",ToString[Plus@@newl],"]]===", ToString[SignSymbol[PlusToList[Plus@@{l}]]],")",condition], {"SignSymbolHold"->"SignSymbol","SequenceHold"->"Sequence"}]]; Remove[coef,n,f,ff,length1,bT,absl,rule1, contractionsd,lzzplus,lindexzz,torsym,new,condition,or,nor]; result]; ContractionsC[l__][T_,Q_]:= Module[{coef,n,f,ff,result,length,length1,bT,absl,ii,rule1, contractionsd,lzzplus,lindexzz,torsym,or,nor}, coef[x_]:=0; n[x_]:=0; nor=0; ff[x_]:=scalarsimplify[2][coef[x]/n[x]]; torsym[a_]:=torsym[a]=or[nor++]; length1=Length[PlusToList0[Plus[l]]]; length=Length[{l}]; bT=Basis[T]; absl=torsym/@(AbsSymbol/@{l}); rule1=Inner[Rule,absl,Table[1,{ii,1,length}],List]; contractionsd[a_. ZZX[ba1_,s1__],b_. ZZX[ba2_,s2__]]:= (lzzplus=PlusToList0[absl.{s1,s2}];If[Length[lzzplus]>length1,0, lindexzz=lzzplus/.rule1; n[lindexzz]++;coef[lindexzz]=coef[lindexzz]+a b; f[lindexzz] ZZXX[bT,Sequence@@lindexzz]]); result= (Plus@@Flatten[Outer[contractionsd,PlusToList[T],PlusToList[Q]]])/. f->ff; Remove[n,coef,f,ff,length1,bT,absl,rule1, contractionsd,lzzplus,lindexzz,torsym]; result//tensorsimplify[1]]; (********************* SwitchIndex **********************************) SwitchIndex[g_][a_]:=a/;Head[a]===0||a===0||!TTCTensorQ[Head[a]]; SwitchIndex[g_][R_[l__]]:=(CompactTensor[R])[l]/; (SignSymbol/@DeleteCases[{l},TTCIndexS[a__]])===TensorType[R]; SwitchIndex[g_][RR_[l__]]:= Module[{R,result,bR,tR,ltR,l1,l2,metriclist,metric,contractions, pp,lrest,cm,cn,jj,kk,sa,sb,new,newl2}, R=CompactTensor[RR]//exteriortoouter; bR=Basis[RR]; tR=TensorType[R]; ltR=Length[tR]; l1=PlusToList[ tR.Table[ ToSymbolA[sa][ii] ,{ii,1,ltR}]]; cn=0; l2=DeleteCases[{l},TTCIndexS[a__]]; metriclist= DeleteCases[ Table[If[SignSymbol[Part[l2,jj]]===Sign[Part[tR,jj]], pp[jj]=jj-cn;0,pp[jj]=lrest+cn+1;++cn; If[Part[tR,jj]===1,metric=Metric[g,bR], metric=InverseMetric[g,bR] ]; metric[-Part[l1,jj], -SignSymbol[ Part[l1,jj] ] ToSymbolA[sb][jj] ] ], {jj,1,ltR} ], 0 ]; lrest=ltR-cn; contractions[x_][{y__}]:=ContractionsA[x,y]; result=ReplaceAllZZ[ ZZX[bR,Sequence@@ToPattern/@Table[ToSymbolA[sa][kk],{kk,1,ltR}]]:> Evaluate[ZZX[bR,Sequence@@Table[ToSymbolA[sa][pp[kk]],{kk,1,ltR}]]]][ Head[(contractions[(R//CompactTensor)@@l1][metriclist])]][l]; (*xavier fast 280797*) new[-i_]:=-new[i]; new[i_]:=New[i]; newl2=new/@l2; If[FreeQ[{l},TTCIndexS],(*Print["Storing Switch Tensor"];*) ToExpression[StringReplace[StringJoin[ ToString[SwitchIndex],"[",ToString[g],"][", ToString[FullForm[R]@@(ToPattern/@newl2)],"]:=", ToString[FullForm[Head[result]@@newl2]], "/; SignSymbolHold[",ToString[newl2],"]===", ToString[SignSymbol[l2]]],"SignSymbolHold"->"SignSymbol"]]]; Remove[contractions,pp,lrest,cn,jj,new]; result ]; (********************** TTCSymmetries *******************************) TTCSymmetries[0]:=0; TTCSymmetries[0[i___]]:=0; TTCSymmetries[T_[l1___, TTCIndexS[a_[1]], l2__, TTCIndexS[a_[0]],l3___]]:= Module[{result,bT,pl2,lpl2,ii,del1,del2,del3,ssl1,ssl2,ssl3,x,ss, del21sign,onlytopattern,tresult}, bT=Basis[T]; del1=DeleteCases[{l1},TTCIndexS[x__]]; del2=DeleteCases[{l2},TTCIndexS[x__]]; del3=DeleteCases[{l3},TTCIndexS[x__]]; ssl1=If[del1==={},{}, ToSymbolA[ss]/@del1]; ssl2=If[del2==={}, {},ToSymbolA[ss]/@del2]; ssl3=If[del3==={}, {},ToSymbolA[ss]/@del3]; del21sign=SignSymbol[del2[[1]]]; onlytopattern[y_]:=If[SignSymbol[y]===del21sign, ToPattern[AbsSymbol[y]],y]; pl2=Cases[Permutations[del2],onlytopattern/@del2]; lpl2=Length[pl2]; tresult= If[a===1, ReplaceAllZZ[ ZZX[bT,Sequence@@(ToPattern/@(Join[ssl1,ssl2,ssl3]))]:> Evaluate[Signature[ssl2] (Signature/@pl2). (Table[ZZX[bT,Sequence@@(Join[ssl1,ToSymbolA[ss]/@(pl2[[ii]]),ssl3])], {ii,1,lpl2}]) /lpl2]][T], ReplaceAllZZ[ ZZX[bT,Sequence@@(ToPattern/@(Join[ssl1,ssl2,ssl3]))]:> Evaluate[Plus@@(Table[ ZZX[bT,Sequence@@(Join[ssl1,ToSymbolA[ss]/@(pl2[[ii]]),ssl3])], {ii,1,lpl2}])/lpl2]][T] ];result=tresult[l1,l2,l3]//TTCSymmetries; Remove[del21sign,onlytopattern]; TTCExpandHead[result] ]/; SignSymbol[{l2}[[1]]]===SignSymbol[{l2}[[-1]]]; TTCSymmetries[a_]:=a; (*********************** TTCIndex ************************************) OutDummyIndex[list_List]:= Module[{result,presult,n,f,g}, n[TTCIndexD[x_]]:=sequence[]; n[-a_]:=(g[a]=sequence[];f[-a]); n[a_]:= (f[-a]=sequence[];g[a]); presult=(n/@Select[list,TTCNoNumberQ]); result=presult/.{f->Identity,g->Identity,sequence->Sequence}; Remove[n];result];(*xavier 15-10-97*) SetAttributes[RightOrder,HoldAll]; SetAttributes[Rolist,{Flat,OneIdentity}]; (*RightOrder[0[l1___,TTCIndexD[y_],j__]]:={};*) TTCNoNumberQ[a_]:=!NumericQ[a]; RightOrder[n_?NumberQ[l___]]:=OutDummyIndex[{l}];(*xavier 15-10-97*) RightOrder[Plus[a_,b__]]:=RightOrder[a]; RightOrder[a_]:=Module[ {result,index,rolistfirst, r0,r1,r2,r3,r4,r5,norepq,l1,l2,l3}, rolistfirst[x_,y___]:=Rolist[x]; Unprotect[Times,Plus]; ClearAttributes[Times,Orderless]; ClearAttributes[Plus,Orderless]; r0=List@@(Rolist[a]/. {T_?TensorQYes0[l__]:>ZZX[XX,1][l], Plus->rolistfirst, Times->Rolist }); SetAttributes[Times,Orderless]; SetAttributes[Plus,Orderless]; Protect[Times,Plus]; r1=r0/.{TTCIndexS[x__]:>TTCIndexD,TTCIndexD[y_]:>TTCIndexD}; r2=r1/.(T_[TTCIndexD,kk__]:> index@@Join[RightOrder[T],{kk}]); r3=r2/.(T_?TensorQYes0[ll__]:>index[ll]); r4=r3/.(TTCIndexD->index[]); r5=Cases[r4,index[l__]]/.{index->Sequence,Rolist[-1,k_]:>-k}; norepq[y_]:=(l1=Cases[r5,y];l2=Cases[r5,-y];l3=Join[l1,l2]; If[Length[l3]===1,True,False]); result=Select[r5,norepq]; Remove[l1,l2,l3,r5,rolistfirst,norepq]; Select[result,TTCNoNumberQ] ]; SetAttributes[TTCIndex,HoldAll]; SetAttributes[TTCIndexG,HoldAll]; TTCIndex[a_. 0[l__]+b_]:=TTCIndex[b]; TTCIndex[a_. 0[l__]]:=0; TTCIndex[0]:=0; TTCIndex[a_]:= Module[{r}, r=TTCIndexG[a]; TTCIndexOEnd[r/.(0[ii__]:>0)](*xavier 12 febrer 1997*) ]; TTCIndexG[a___,0[l__],b___]:=0 TTCIndexG[1]=1; TTCIndexG[]=1; TTCIndexG[a___,b_Out,c___]:= TTCIndexG[a,Evaluate[b],c]; TTCIndexG[a___,b_,c___]:=CompactScalar[b] TTCIndexG[a,c]/;FreeQ[b,ZZX]&&FreeQ[b,TTCIndexD]; TTCIndexG[Q1___,Plus[a_,b__],Q2___]:= TTCIndexG[Q1,Evaluate[TTCIndexO[Plus@@(TTCIndexG/@Hold[a,b])/. (0[ii__]:>0)]],Q2];(*xavier 12 febrer 1997*) TTCIndexG[Times[a_,b__]]:=TTCIndexG[a,b]; TTCIndexG[a___,Power[b_,n_],c___]:=Power[TTCIndexG[b],n] TTCIndexG[a,c]; TTCIndexG[a___,Sqrt[b_],c___]:= Sqrt[TTCIndexG[b]] TTCIndexG[a,c] ; TTCIndexG[a___,T_?TensorQNot0[l__][b___,TTCIndexD[x_],i__],c___]:= If[ Length[PlusToList[Plus[l]]]=!=Length[PlusToList[Plus@@AbsSymbol/@{l}]], TTCIndexG[a,Evaluate[TTCIndexG[T[l]][b,TTCIndexD[x],i]],c], TTCIndexG[a,T[l,b,TTCIndexD[x],i],c] ]; TTCIndexG[a___,T_[b___,TTCIndexD[x_],i__],c___]:= TTCIndexG[a,Evaluate[JoinTensorIndex[TTCIndexG[T]][b,TTCIndexD[x],i]],c]/; MatchQ[T, aa_. Q_?TTCTensorQ[l__]+bb_]|| MatchQ[T, aa_ Q_?TTCTensorQ[l__]]|| (!FreeQ[T,TTCIndexD]); TTCIndexG[T__]:= TTCSymmetries[ (Contractions@@(TTCSymmetries/@(SwitchIndex[MetricInUse]/@ FixedPoint[absDlist[MetricInUse], ExtToOutHead/@{T}])))]; ExtToOutHead[T_[i__]]:=exteriortoouter[CompactTensor[T]][i]; TTCIndexO[0[l__]]:=0 ; TTCIndexO[0]:=0 ; TTCIndexO[T_Plus]:= Module[{result,T1l,T1p,findex2,orderindex, orderindexpattern,ii,i,orderT1l,bT}, T1l=JoinTensorIndex/@List@@T; T1p[i_]:=T1p[i]=Part[T1l,i]; bT=Basis[Head[T1p[1]]]; findex2=List@@(T1p[1]); orderindex[i_]:= AbsSymbol/@DeleteCases[ DeleteCases[List@@(T1p[i]),TTCIndexS[a__]],TTCIndexD[b_]]; orderindexpattern[i_]:=ToPattern/@orderindex[i]; orderT1l=Table[(ReplaceAllZZ[ ZZX[bT,Sequence@@orderindexpattern[ii]]:> Evaluate[ZZX[bT,Sequence@@orderindex[1] ]] ][ Head[T1p[ii]]]),{ii,1,Length[T]}]; result=(Plus@@orderT1l)@@findex2; Remove[T1p,T1l,orderindex,orderindexpattern];result ]/;RightOrder[T]=!={}; TTCIndexO[a_]:=a ; TTCIndexOEnd[0]:= 0; TTCIndexOEnd[T_]:= Module[{result,TT,T1l,T1p,findex2,orderindex, orderindexpattern,ii,i,orderT1l,bT}, TT=PlusToList[T]; T1l=JoinTensorIndex/@TT; T1p[i_]:=T1p[i]=Part[T1l,i]; bT=Basis[Head[T1p[1]]]; findex2=List@@(T1p[1]); orderindex[0]=AbsSymbol/@endrightorder; orderindex[i_]:=AbsSymbol/@DeleteCases[List@@(T1p[i]),TTCIndexS[a__]]; orderindexpattern[i_]:=ToPattern/@orderindex[i]; orderT1l=Table[(ReplaceAllZZ[ ZZX[bT,Sequence@@orderindexpattern[ii]]:> Evaluate[ZZX[bT,Sequence@@orderindex[0]]]][ Head[T1p[ii]]]),{ii,1,Length[TT]}]; result=(Plus@@orderT1l); Remove[T1p,T1l,orderindex,orderindexpattern];result ]/;endrightorder=!={}; TTCIndexOEnd[a_]:=a; (******************** TTCIndex End *************************************) (****************** ApplyTensor ****************************************) ApplyTensor[0][T_]:=0; ApplyTensor[T_][0]:=0; ApplyTensor[T_][]:=T; ApplyTensor[T_][v__]:= Module[{result,TT,ltT,s,i,lvv,b,indexT,lindexv,indexv,vindexv, lvindexv,j,cTv,h}, TT=T//exteriortoouter; tT=TensorType[TT]; ltT=Length[tT]; indexT=Inner[Times,ToSymbolA[s]/@Table[i,{i,1,ltT}],tT,List]; lvv=(exteriortoouter/@{v})/.Null->ZZX[b,1]; lindexv[0]=0; lindexv[n_]:=Length[TensorType[lvv[[n]]]]+lindexv[n-1]; indexv[n_]:=-Take[indexT,{lindexv[n-1]+1,lindexv[n]}]; vindexv[n_]:=lvv[[n]]@@indexv[n]; lvindexv:=Table[vindexv[j],{j,1,Length[lvv]}]/.ZZX[b,1][k_]->1; cTv=Contractions[TT@@indexT,Sequence@@lvindexv]; h=Head[cTv]; result=If[TensorQNot0[h]===True,h,cTv]; RemoveNewIndexList; Remove[lvv,lindexv,indexv,vindexv,lvindexv]; result ]; (******************** InteriorContraction *******************************) InteriorContraction[T_,0]:=0; InteriorContraction[0,W_]:=0; InteriorContraction[T_,Q_?ScalarQ]:=0; InteriorContraction[T_,v_]:= Module[{To,vo,lt,lv,llt,llv,r1,ii,jj,sa,offon,result}, offon=CompactOffOn;Compact[On]; To=exteriortoouter[T];vo=exteriortoouter[v]; lt=TensorType[To];lv=TensorType[vo]; llt=Length[lt];llv=Length[lv]; r1= If[llt>llv, Contractions[ To[Inner[ Times,lt,Table[ ToSymbolA[sa][ii],{ii,1,llt}],Sequence ] ], vo[Inner[Times,lv,Table[ ToSymbolA[sa][jj],{jj,llt,llt-llv+1,-1}],Sequence ] ] ], Contractions[ To[Inner[ Times,lt,Table[ ToSymbolA[sa][ii],{ii,llv-llt+1,llv}],Sequence ] ], vo[Inner[Times,lv,Table[ ToSymbolA[sa][jj],{jj,llv,1,-1}],Sequence ] ] ] ];result=Index[][r1]; result=If[InternalFormQ[T],outertoexterior[result],result]; Compact[offon];result ]; (********************** InteriorV *************************************) Format[Literal[InteriorV[g___][v_][a_]]]:=SequenceForm["i",Subscript[v],"(",a,")"]; InteriorV[g_:Euclidean][0][a_]:=0; InteriorV[g_:Euclidean][V_][a_?ScalarQ]:=0; InteriorV[g_:Euclidean][V_?ExplicitTensorQ][a_?ExplicitTensorQ]:= Module[{v,i,j,basis,offon,result},offon=CompactOffOn;Compact[On]; If[!FormQ[V],v=V,basis=Basis[V]; endrightorder={-i};v=tensorsimplify[1][TTCIndex[V[-j] InverseMetric[g,basis][j,i]]]]; result=InteriorContraction[v,a]//outertoexterior; Compact[offon];result]; InteriorV[g_:Euclidean][V_][a_Plus]:=InteriorV[g][V]/@a; InteriorV[g_:Euclidean][V_][a_ b_?FormQ]:=a InteriorV[g][V][b]; Literal[InteriorV[g_:Euclidean][V_][ExteriorProduct[a_,b_]]]:= ExteriorProduct[InteriorV[g][V][a],b]+ (-1)^(Length[Flatten[TensorType[a]]])* ExteriorProduct[a,InteriorV[g][V][b]]; Literal[InteriorV[g_:Euclidean][V_Plus][a_]]:= Module[{ii},Sum[InteriorV[g][ V[[ii]] ][a],{ii,1,Length[V]}]]; Literal[InteriorV[g_:Euclidean][n_ V_][a_]]:=n InteriorV[g][V][a]; Literal[InteriorV[g_:Euclidean][V_][InteriorV[g_:Euclidean][V_][a_]]]:=0; (*************************** Change Begin *************************************) (************************* ClearChange ****************************************) Change::notexist="Change `1` do not exist"; Change::exist="Change `1` already exist"; ClearChange[x_,xs_,g_:1]:= Which[ CoordinateChangeQ[x,xs], Module[{n},Do[CTChange[oldx,newx,n]=1;CTChange[oldx,newx,n]=.,{n,1,TTCCounter}]]; Module[{pos,i,k,metric}, pos=Position[coordinatechangenames, {x,xs}][[1]]; coordinatechangenames= Delete[coordinatechangenames, pos[[1]]]; CoordinateChange[x,xs]=1;CoordinateChange[x,xs]={}; BasisChange[x,xs]=1;BasisChange[x,xs]=.; BasisVectorChange[x,xs]=1;BasisVectorChange[x,xs]=.; BasisFormChange[x,xs]=1;BasisFormChange[x,xs]=.; Do[JacobianMatrixComponent[x,xs][i,j]=1; JacobianMatrixComponent[x,xs][i,j]=., {i,1,Dimension[x]},{j,-Dimension[xs],-1} ]; JacobianMatrix[x,xs]=1;JacobianMatrix[x,xs] =.; Do[tangentvector[x,xs][i]=1; tangentvector[x,xs][i]=., {i,-Dimension[xs],-1} ]; metric[k_]:=metricnames[[k]][[1]]; Do[ NormalForm[metric[k],x,xs]=1;NormalForm[metric[k],x,xs]=.; NormalModulus[metric[k],x,xs]=1;NormalModulus[metric[k],x,xs]=.; NormalFormSign[metric[k],x,xs]=1;NormalFormSign[metric[k],x,xs]=.; FirstFundamentalForm[metric[k],x,xs]=1; FirstFundamentalForm[metric[k],x,xs]=.; Do[(SecondFundamentalFormComponent[metric[k],x,xs][i,j]=1; SecondFundamentalFormComponent[metric[k],x,xs][i,j]=.), {i,-Dimension[x],-1},{j,-Dimension[x],-1} ]; SecondFundamentalForm[metric[k],x,xs]=1; SecondFundamentalForm[metric[k],x,xs]=.,{k,1,Length[metricnames]} ]; Remove[metric] ], BasisChangeQ[x,xs], Module[{pos,i,k}, If[MemberQ[basischangenames,{x,xs}], pos=Position[basischangenames, {x,xs}][[1]], pos=Position[basischangenames, {xs,x}][[1]]]; basischangenames= Delete[basischangenames, pos[[1]]]; BasisChange[x,xs]=1;BasisChange[x,xs]=.; BasisChange[xs,x]=1;BasisChange[xs,x]=.; BasisVectorChange[x,xs]=1;BasisVectorChange[x,xs]=.; BasisFormChange[x,xs]=1;BasisFormChange[x,xs]=.; BasisVectorChange[xs,x]=1;BasisVectorChange[xs,x]=.; BasisFormChange[xs,x]=1;BasisFormChange[xs,x]=. ], True, Message[Change::notexist,{x,xs}] ]; (*********** CoordinateChangeNames **********************************) coordinatechangenames={}; CoordinateChangeNames:= If[coordinatechangenames==={}, Print[ "No coordinate changes found" ], (coordinatechangenames/.a_?CoordinatesQ:>{a,Coordinates[a]})//ColumnForm ]; (****************** BasisChangeNames *********************************) basischangenames={}; BasisChangeNames:= If[basischangenames==={}, Print[ "No basis vectors changes found" ], (basischangenames/.a_?BasisQ:>{a,BasisSymbols[a]})//ColumnForm ]; (***************** CoordinateChangeQ ***********************************) CoordinateChangeQ[oldx_,newx_]:=MemberQ[coordinatechangenames,{oldx,newx}]; (********************** BasisChangeQ **********************************) BasisChangeQ[oldx_,newx_]:= basischangeQ[oldx,newx]||basischangeQ[newx,oldx]; basischangeQ[oldx_,newx_]:=MemberQ[basischangenames,{oldx,newx}]; (************ CoordinateChange *****************************************) CoordinateChange[x_,y_]:={}; (***** BasisVectorChange BasisFormChange *******************************) BasisVectorChange[oldx_,newx_]:=Module[{inputbasisvectorchange}, BasisSymbols[oldx];BasisSymbols[newx]; Message[Change::notexist,{oldx,newx}]; inputbasisvectorchange=(Input[StringJoin[ "Enter BasisVectorChange[", ToString[oldx],",",ToString[newx], "] \n (or related things...), Interrupt[] or Dialog[] \n "]])// tensorsimplify[1]; InputBasisChange[oldx,newx,inputbasisvectorchange]]/; Head[oldx]===List||Head[newx]===List; BasisFormChange[oldx_,newx_]:= BasisVectorChange[oldx,newx]/;Head[oldx]===List||Head[newx]===List; BasisVectorChange[oldx_,newx_]:=(CoordinateChange[oldx,newx]; VectorRule[i_]:=ZZX[oldx,-i]->Module[{m},Sum[ Inverse[JacobianMatrix[oldx,newx]][[m,i]] ZZX[newx,-m], {m,1,Dimension[newx]}] ]; BasisVectorChange[oldx,newx]=If[ Dimension[newx]===Dimension[oldx], Module[{i}, Table[ VectorRule[i],{i,1,Dimension[oldx]}] ] ] ); BasisFormChange[oldx_,newx_]:= (CoordinateChange[oldx,newx]; FormRule[i_]:=ZZX[oldx,i]->Module[{j}, Sum[JacobianMatrixComponent[oldx,newx][i,-j] ZZX[newx,j], {j,1,Dimension[newx]}]]; BasisFormChange[oldx,newx]=Module[{i}, Table[FormRule[i],{i,1,Dimension[oldx]}] ] ); (************ InputCooordinateChange *********************************) InputCoordinateChange[oldx_,newx_,b_]:= If[CoordinateChangeQ[oldx,newx],Message[Change::exist,{oldx,newx}], Coordinates[oldx];Coordinates[newx]; coordinatechangenames=Append[coordinatechangenames,{oldx,newx}]; SetCompactTensor[CoordinateChange[oldx,newx],b//scalarsimplify[1]]]; CoordinateChange[oldx_,newx_]:=Module[{inputcoordinatechange}, Coordinates[oldx];Coordinates[newx]; Message[Change::notexist,{oldx,newx}]; inputcoordinatechange=(Input[StringJoin[ "Enter CoordinateChange[", ToString[oldx],",",ToString[newx], "], Interrupt[] or Dialog[] \n " ]])// tensorsimplify[1]; InputCoordinateChange[oldx,newx,inputcoordinatechange]]; (***************** InputBasisChange **********************************) InputBasisChange[oldx_,newx_]:= If[BasisChangeQ[oldx,newx],Message[Change::exist,{oldx,newx}], BasisSymbols[oldx];BasisSymbols[newx]; basischangenames=Append[basischangenames,{oldx,newx}]]; InputBasisChange[oldx_,newx_,ch_]:= If[Flatten[{oldx}][[1]]=!=Flatten[{newx}][[1]], Print["It's not possible to set basis change between diferent coordinates! "]; Interrupt[], If[BasisChangeQ[oldx,newx],Message[Change::exist,{oldx,newx}], BasisSymbols[oldx];BasisSymbols[newx]; basischangenames=Append[basischangenames,{oldx,newx}]; ComputeBasisChange[oldx,newx,ch]]]; ComputeBasisChange[oldb_,newb_,ch_]:= Module[{sign,zznew,Amc,Am,IAm,IAmc,dim,chsimp,basischange, dualbasischange,i,j,offon}, offon=CompactOffOn;Compact[On]; sign=Part[ch, 1, 1, 2]/Abs[Part[ch, 1, 1, 2]]; dim=Dimension[oldb]; chsimp=ch//tensorsimplify[1]; zznew[i_]:=zznew[i]=(ZZX[oldb,sign i]/.chsimp); Amc[i_,j_]:=Amc[i,j]= TensorComponent[zznew[i]][-sign j]; Am=Module[{i,j}, Table[Amc[i,j],{i,1,dim},{j,1,dim}]]; IAm=Inverse[Am]//scalarsimplify[1]; IAmc[i_,j_]:=IAmc[i,j]=IAm[[i,j]]; basischange[newb,oldb]=Module[{i,j}, Table[ZZX[newb,sign i]->Sum[IAmc[i,j] ZZX[oldb,sign j], {j,1,dim}],{i,1,dim}]]; dualbasischange[oldb,newb]=Module[{i,j}, Table[ZZX[oldb,-sign i]->Sum[IAmc[j,i] ZZX[newb,-sign j], {j,1,dim}],{i,1,dim}]]; dualbasischange[newb,oldb]=Module[{i,j}, Table[ZZX[newb,-sign i]->Sum[Am[[j,i]] ZZX[oldb,-sign j], {j,1,dim}],{i,1,dim}]]; If[sign===1, BasisFormChange[oldb,newb]=chsimp; BasisVectorChange[oldb,newb]=dualbasischange[oldb,newb]; BasisFormChange[newb,oldb]=basischange[newb,oldb]; BasisVectorChange[newb,oldb]=dualbasischange[newb,oldb], BasisVectorChange[oldb,newb]=chsimp; BasisFormChange[oldb,newb]=dualbasischange[oldb,newb]; BasisVectorChange[newb,oldb]=basischange[newb,oldb]; BasisFormChange[newb,oldb]=dualbasischange[newb,oldb] ];Remove[zznew,Amc,IAmc,chsimp];Compact[offon]; ]; (******************* JacobianMatrixComponent ****************************) JacobianMatrixComponent[oldx_,newx_][i_,j_]:= SetCompactScalar[ JacobianMatrixComponent[oldx,newx][i,j], (DS[ Coordinate[oldx]@@ToIndex[oldx][i]/. CoordinateChange[oldx,newx],Coordinate[newx]@@ToIndex[newx][-j] ])// scalarsimplify[1]]; (****************** JacobianMatrix **************************************) JacobianMatrix[oldx_,newx_]:= JacobianMatrix[oldx,newx]=Module[{j,k}, Table[JacobianMatrixComponent[oldx,newx][j,-k], {j,1,Dimension[oldx]},{k,1,Dimension[newx]}] ]; (*********************** Change ******************************************) BasisChange[oldx_,newx_]:=BasisChange[oldx,newx]= If[ Dimension[oldx]===Dimension[newx], Join[BasisVectorChange[oldx,newx],BasisFormChange[oldx,newx]], BasisFormChange[oldx,newx]]; BasisChangeAct[oldx_,newx_]:={ZZX[oldx,a_,b__]:> OutPr@@CompactTensor/@(( ZZ[oldx]/@{a,b})/.BasisChange[oldx,newx])}; Change[newx_][0]:=0; Change[newx_][n_?NumericQ]:=n; Change[newx_][a_]:=Change[Basis[a],newx][a]; Change[oldx_,newx_][n_?NumericQ]:=n; Change[x_,x_]:=Identity; Change[{x_,b1_},{y_,b2_}][T_]:= Change[y,{y,b2}][ Change[x,y][Change[{x,b1},x][T]]]/;x=!=y; CompactCoordinateChange[{x_,b_},x_]:= CompactCoordinateChange[{x,b},x]=Identity; CompactCoordinateChange[x_,{x_,b_}]:= CompactCoordinateChange[x,{x,b}]=Identity; CompactCoordinateChange[{x_,b1_},{x_,b2_}]:= CompactCoordinateChange[{x,b1},{x,b2}]=Identity; CompactCoordinateChange[oldx_,newx_][a_]:= (CTChange[oldx,newx]/@TTCList[a]; a/.TTC[m_]:>CTChange[oldx,newx,m]); CTChange[oldx_,newx_][TTC[n_]]:=CTChange[oldx,newx,n]; CTChange[oldx_,newx_,n_]:=CTChange[oldx,newx,n]= (TTCSettings[n]=Append[TTCSettings[n],Hold[CTChange[oldx,newx,n]]]; scalarsimplify[3][TTCR[n]/.Join[{TTC[m_]:>CTChange[oldx,newx,m]}, CoordinateChange[oldx,newx]]]); Change[oldx_,newx_][aa_]:= Module[{a,result}, If[CompactOffOn===On, If[ScalarQ[aa]===True,a=CompactScalar[aa]; (CompactCoordinateChange[oldx,newx][a])//scalarsimplify[3], a=CompactTensor[aa]; If[InternalFormQ[a],( CompactCoordinateChange[oldx,newx][exteriortoouter[a]/. Join[BasisChange[oldx,newx],BasisChangeAct[oldx,newx]]]// outertoexterior)//tensorsimplify[3], (CompactCoordinateChange[oldx,newx][a/.Join[BasisChange[oldx,newx], BasisChangeAct[oldx,newx]]])//tensorsimplify[3]]], Compact[On]; result=If[ScalarQ[aa]===True,a=CompactScalar[aa]; (Co