(*********************************************************************** Mathematica-Compatible Notebook This notebook can be used on any computer system with Mathematica 3.0, MathReader 3.0, or any compatible application. The data for the notebook starts with the line of stars above. To get the notebook into a Mathematica-compatible application, do one of the following: * Save the data starting with the line of stars above into a file with a name ending in .nb, then open the file inside the application; * Copy the data starting with the line of stars above to the clipboard, then use the Paste menu command inside the application. Data for notebooks contains only printable 7-bit ASCII and can be sent directly in email or through ftp in text mode. Newlines can be CR, LF or CRLF (Unix, Macintosh or MS-DOS style). NOTE: If you modify the data for this notebook not in a Mathematica- compatible application, you must delete the line below containing the word CacheID, otherwise Mathematica-compatible applications may try to use invalid cache data. For more information on notebooks and Mathematica-compatible applications, contact Wolfram Research: web: http://www.wolfram.com email: info@wolfram.com phone: +1-217-398-0700 (U.S.) Notebook reader applications are available free of charge from Wolfram Research. ***********************************************************************) (*CacheID: 232*) (*NotebookFileLineBreakTest NotebookFileLineBreakTest*) (*NotebookOptionsPosition[ 302928, 9569]*) (*NotebookOutlinePosition[ 303866, 9600]*) (* CellTagsIndexPosition[ 303822, 9596]*) (*WindowFrame->Normal*) Notebook[{ Cell[CellGroupData[{ Cell[TextData[{ StyleBox["\n", FontSize->12], "\t\t\n", StyleBox["Exterior Differential Calculus\nand\nSymbolic Matrix Algebra", FontSize->36, FontWeight->"Bold", FontSlant->"Italic"] }], "Text", ShowGroupOpenCloseIcon->True, TextAlignment->Center, TextJustification->0, FontColor->RGBColor[0, 0, 1]], Cell["version 3.8.9 - May 2013", "Text", TextAlignment->Center, TextJustification->0, FontFamily->"Times", FontSize->14, FontSlant->"Italic"], Cell[TextData[{ "\n", ButtonBox["S. Bonanos", ButtonData:>{ URL[ "http://www.inp.demokritos.gr/~sbonano/SB.html"], None}, ButtonStyle->"Hyperlink"], "\n", "\n", StyleBox[ButtonBox["Institute of Nuclear Physics", ButtonData:>{ URL[ "http://www.inp.demokritos.gr/"], None}, ButtonStyle->"Hyperlink"], FontWeight->"Bold", FontSlant->"Italic"], StyleBox[", ", FontWeight->"Bold", FontSlant->"Italic"], StyleBox[ButtonBox["NCSR \"Demokritos\"", ButtonData:>{ URL[ "http://www.demokritos.gr/index_muk.asp"], None}, ButtonStyle->"Hyperlink"], FontSlant->"Italic"], StyleBox[", \nAghia Paraskevi 15310, Greece.", FontWeight->"Bold", FontSlant->"Italic"], "\n", "\n", "Please send comments, suggestions, bug reports to: ", ButtonBox["sbonano@inp.demokritos.gr", ButtonData:>{ URL[ "mailto:sbonano@inp.demokritos.gr"], None}, ButtonStyle->"Hyperlink"], " \t" }], "Text", TextAlignment->Center, FontFamily->"Times", FontSize->16] }, Closed]], Cell["\<\ \ \>", "Text"], Cell[CellGroupData[{ Cell[TextData[StyleBox[" 1 Overview", FontWeight->"Bold"]], "Section", ShowGroupOpenCloseIcon->True, FontSize->24, FontColor->RGBColor[0, 0, 1]], Cell[TextData[{ "\tThis package enables ", StyleBox["Mathematica", FontSlant->"Italic"], " to carry out calculations with differential forms. It defines the two \ basic operations - ", StyleBox["Exterior Product", FontWeight->"Bold"], " ", StyleBox["(Wedge)", FontWeight->"Bold"], " and ", StyleBox["Exterior Derivative (d)", FontWeight->"Bold"], " - in such a way that:" }], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[TextData[{ "\t(1) they can act on any valid ", StyleBox["Mathematica", FontSlant->"Italic"], " expression\n\t(2) they allow the use of any symbols to denote \ differential forms\n\t(3) input - output notation is as close as possible to \ standard usage" }], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[TextData[{ " \tAnother use of this package is for doing algebraic / differential \ calculations with \"symbolic matrices\", i.e., with symbols satisfying \ special multiplication rules, which can be interpreted as representing \ matrices, quantum operators, Lie algebra generators, Maurer-Cartan forms etc. \ Any symbol can be defined to be a \"symbolic matrix\", i.e., to have special \ multiplication properties. But in this case the user must give the extra \ multiplication (", StyleBox["Wedge", FontWeight->"Bold"], ") rules that define his/her problem (see Examples). " }], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[TextData[{ " \tThe infix operator symbol \[Wedge] (Wedge) has been defined as a \ generalized associative, non-commutative multiplication operator. Its action \ depends on the properties of the symbols it acts on: it becomes exterior \ multiplication on differential forms, matrix multipication on (symbolic or \ explicit) matrices and reduces to ", StyleBox["Times", FontFamily->"Courier"], " for other symbols. The symbol \[Wedge] (Wedge) is included in ", StyleBox["Mathematica", FontSlant->"Italic"], " but does not have a pre\[Hyphen]defined meaning. It can be input by \ typing \[EscapeKey] ^ \[EscapeKey] (where ^ is the symbol for exponent) or \ \\ [Wedge] (without space after \\). Finally, it can be input by clicking the \ appropriate button in the palette ", StyleBox["EDCpalette.nb. ", FontWeight->"Bold"] }], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell["\<\ \tThe letter \"d\" has been defined to act as the exterior \ differential operator. Thus one can use the standard notation d[x], d[y], \ d[z], d[x]\[Wedge]d[y], d[x]\[Wedge]d[y]\[Wedge]d[z], d[f[x,y]] for \ differential forms and for exterior differentiation.\ \>", "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[TextData[{ "\tAll expressions (or list entries) are treated as sums of terms, which \ may have factors that are special symbols (declared by the user as denoting \ differential forms or matrices) or have ", StyleBox["Head", FontFamily->"Courier"], " ", StyleBox["Wedge", FontWeight->"Bold"], " or ", StyleBox["d", FontWeight->"Bold"], "; and rules are given for manipulating such expressions. ", StyleBox["All other (undeclared) symbols are treated as scalar 0-forms", FontSlant->"Italic"], ". The ordering of terms in an expression is determined by the built-in ", StyleBox["Mathematica", FontSlant->"Italic"], " rules for ", StyleBox["Plus", FontFamily->"Courier"], " and ", StyleBox["Times", FontFamily->"Courier"], ", which sometimes results in an unexpected ordering of terms. ", StyleBox["All terms in a sum, and all components of a matrix, must be of \ the same differential-form degree.", FontSlant->"Italic"] }], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[TextData[{ StyleBox["Important Note", FontWeight->"Bold"], ": The new functions (Wedge, d, FormDegree, Bar, MatQ, etc.) and global \ variables (simpRules, varList, etc.) introduced in the package are not \ protected. This is intentional, in order to allow the user to add new \ definitions on the fly, as required in a calculation, without having to go \ through ", StyleBox["Unprotect", FontFamily->"Courier"], ". However, it also carries the danger that an unprotected symbol might be \ used in a way that was not intended.", StyleBox[" If one obtains results that don't make sense, it is most likely \ that some global variable is used inappropriately (e.g., a symbol, declared \ to represent a matrix, is used in a later calculation as a scalar). ", FontSlant->"Italic"], "Reevaluating the initialization code ", StyleBox["matrixEDC.m", FontWeight->"Bold"], " clears all variables and allows a fresh start." }], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[TextData[{ " \tIn previous releases there were two versions of this package: ", StyleBox["scalarEDCcode.nb", FontWeight->"Bold"], " and ", StyleBox["matrixEDCcode.nb", FontWeight->"Bold"], ". As the efficiency of EDC code has improved (and personal computers have \ become much faster!), the only advantage of the scalar package (15% faster \ execution) no longer justifies maintaining this version. Thus, the new \ version is only the matrix version in package form (", StyleBox["matrixEDC.m", FontWeight->"Bold"], "), which, of course, can be used for scalar calculations also." }], "Text", TextAlignment->Left, TextJustification->0] }, Closed]], Cell[BoxData[""], "Input"], Cell[TextData[{ StyleBox["\t", FontSize->14], StyleBox["The executable cells in this Manual must be evaluated ", FontSize->16], StyleBox["in the order they appear", FontSize->16, FontSlant->"Italic"], StyleBox[", after placing the file ", FontSize->16], StyleBox["matrix", FontSize->16, FontWeight->"Bold"], StyleBox["EDC.m", FontFamily->"Courier", FontSize->16, FontWeight->"Bold"], StyleBox[" in one of the directories that ", FontSize->16], StyleBox["Mathematica", FontSize->16, FontSlant->"Italic"], StyleBox[ " looks at when searching for extra packages. Such directories can be found \ by evaluating the command ", FontSize->16], StyleBox["$Path", FontSize->16, FontWeight->"Bold"], StyleBox[":", FontSize->16] }], "Text", FontSize->18, FontVariations->{"CompatibilityType"->0}], Cell[BoxData[ $$Path$], "Input"], Cell["\tLoad initialization code:", "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[BoxData[ $<< matrixEDC.m$], "Input"], Cell[CellGroupData[{ Cell[BoxData[ $$EDCversion$], "Input"], Cell[BoxData[ $389$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[TextData[StyleBox[" 2 EDC Function Definitions", FontWeight->"Bold"]], "Section", ShowGroupOpenCloseIcon->True, FontSize->24, FontColor->RGBColor[0, 0, 1]], Cell[CellGroupData[{ Cell[" 2.1 The three basic operations: Wedge, d, reWrite", "Subsection", ShowGroupOpenCloseIcon->True, FontSize->18], Cell["\<\ \tLet us define two differential forms in terms of the coordinate \ differentials in 3-dimensional Euclidean space:\ \>", "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[BoxData[ $\(f1 = 2 a\ d[x] + 3 b\ d[y] + 5 c\ d[z]; $\)], "Input"], Cell[BoxData[ $\(f2 = a\ Cos[a\ x + b\ y] d[x] - b\ Sin[a\ x + b\ y] d[y]; $\)], "Input"], Cell[TextData[{ "\[FilledSmallCircle]\tThe function ", StyleBox["Wedge", FontFamily->"Courier", FontWeight->"Bold"], StyleBox["[x_,y_,...] ", FontFamily->"Courier"], " or ", StyleBox[" x_\[Wedge]y_\[Wedge]...", FontFamily->"Courier"], " gives the exterior product of the expressions ", StyleBox["x,y,... Wedge", FontFamily->"Courier"], " reduces to", StyleBox[" Times", FontFamily->"Courier"], " when acting on 0-forms." }], "Text", ShowGroupOpenCloseIcon->True, TextAlignment->Left, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $f12 = Wedge[f1, f2]$], "Input"], Cell[BoxData[ $\(-3$\ a\ b\ Cos[a\ x + b\ y]\ d[x]\[Wedge]d[y] - 2\ a\ b\ Sin[a\ x + b\ y]\ d[x]\[Wedge]d[y] - 5\ a\ c\ Cos[a\ x + b\ y]\ d[x]\[Wedge]d[z] + 5\ b\ c\ Sin[a\ x + b\ y]\ d[y]\[Wedge]d[z]\)], "Output"] }, Open ]], Cell[TextData[{ "Note that Wedge products are ordered alphabetically. Instead of ", StyleBox["Wedge[...]", FontFamily->"Courier"], " one can use the infix symbol ", StyleBox["\[Wedge]", FontFamily->"Courier"], ":" }], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"f1", StyleBox["\[Wedge]", FontFamily->"Courier"], "f2"}]], "Input"], Cell[BoxData[ $\(-3$\ a\ b\ Cos[a\ x + b\ y]\ d[x]\[Wedge]d[y] - 2\ a\ b\ Sin[a\ x + b\ y]\ d[x]\[Wedge]d[y] - 5\ a\ c\ Cos[a\ x + b\ y]\ d[x]\[Wedge]d[z] + 5\ b\ c\ Sin[a\ x + b\ y]\ d[y]\[Wedge]d[z]\)], "Output"] }, Open ]], Cell[TextData[{ "\[FilledSmallCircle]\tThe function ", StyleBox["reWrite", FontFamily->"Courier", FontWeight->"Bold"], StyleBox["[x_]", FontFamily->"Courier"], " collects identical Wedge[__] or d[_] terms together and factors the \ coefficients of such terms:" }], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $reWrite[f12]$], "Input"], Cell[BoxData[ $\(-a$\ b\ $(3\ Cos[a\ x + b\ y] + 2\ Sin[a\ x + b\ y])$\ d[x]\[Wedge]d[y] - 5\ a\ c\ Cos[a\ x + b\ y]\ d[x]\[Wedge]d[z] + 5\ b\ c\ Sin[a\ x + b\ y]\ d[y]\[Wedge]d[z]\)], "Output"] }, Open ]], Cell[TextData[{ "\[FilledSmallCircle]", "\tThe function ", StyleBox["d", FontFamily->"Courier", FontWeight->"Bold"], StyleBox["[x_]", FontFamily->"Courier"], " gives the exterior derivative of the expression ", StyleBox["x", FontFamily->"Courier"], ", assuming all symbols are variable. " }], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $d/@{A, A[0], A[x], \(A[2]$[x, y], u[x, y]/v[x], Cos[a\ x]}\)], "Input"], Cell[BoxData[ RowBox[{"{", RowBox[{$d[A]$, ",", $d[A[0]]$, ",", RowBox[{$d[x]$, " ", RowBox[{ SuperscriptBox["A", "\[Prime]", MultilineFunction->None], "[", "x", "]"}]}], ",", RowBox[{ RowBox[{$d[y]$, " ", RowBox[{ SuperscriptBox[$A[2]$, TagBox[$(0, 1)$, Derivative], MultilineFunction->None], "[", $x, y$, "]"}]}], "+", RowBox[{$d[x]$, " ", RowBox[{ SuperscriptBox[$A[2]$, TagBox[$(1, 0)$, Derivative], MultilineFunction->None], "[", $x, y$, "]"}]}]}], ",", RowBox[{ RowBox[{"-", FractionBox[ RowBox[{$d[x]$, " ", $u[x, y]$, " ", RowBox[{ SuperscriptBox["v", "\[Prime]", MultilineFunction->None], "[", "x", "]"}]}], $v[x]\^2$]}], "+", FractionBox[ RowBox[{$d[y]$, " ", RowBox[{ SuperscriptBox["u", TagBox[$(0, 1)$, Derivative], MultilineFunction->None], "[", $x, y$, "]"}]}], $v[x]$], "+", FractionBox[ RowBox[{$d[x]$, " ", RowBox[{ SuperscriptBox["u", TagBox[$(1, 0)$, Derivative], MultilineFunction->None], "[", $x, y$, "]"}]}], $v[x]$]}], ",", $\(-\((x\ d[a] + a\ d[x])$\)\ Sin[a\ x]\)}], "}"}]], "Output"] }, Open ]], Cell["\<\ \tConstants must be explicitly set to have 0 exterior derivative:\ \ \>", "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[BoxData[ $d[a] = 0; d[b] = 0; d[c] = 0; $], "Input"], Cell[CellGroupData[{ Cell[BoxData[ $d[f2]$], "Input"], Cell[BoxData[ $\(-a$\ b\ Cos[a\ x + b\ y]\ d[x]\[Wedge]d[y] + a\ b\ Sin[a\ x + b\ y]\ d[x]\[Wedge]d[y]\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $df2 = reWrite[%]$], "Input"], Cell[BoxData[ $\(-a$\ b\ $(Cos[a\ x + b\ y] - Sin[a\ x + b\ y])$\ d[x]\[Wedge]d[y]\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $reWrite[d[f1]\[Wedge]f2 - f1\[Wedge]d[f2] - d[f12]]$], "Input"], Cell[BoxData[ $0$], "Output"] }, Open ]], Cell[TextData[{ "\[FilledSmallCircle]\t", StyleBox["Wedge", FontWeight->"Bold"], ", ", StyleBox["d", FontWeight->"Bold"], ", and ", StyleBox["reWrite", FontWeight->"Bold"], " can also be used with matrices; ", StyleBox["Wedge", FontWeight->"Bold"], " on matrices gives matrix multiplication:" }], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell["\tLet us define the rotation matrix:", "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $R3 = {{Cos[a\ x + b\ y], \(-Sin[a\ x + b\ y]$, 0}, {Sin[a\ x + b\ y], Cos[a\ x + b\ y], 0}, {0, 0, 1}}\)], "Input"], Cell[BoxData[ ${{Cos[a\ x + b\ y], \(-Sin[a\ x + b\ y]$, 0}, {Sin[a\ x + b\ y], Cos[a\ x + b\ y], 0}, {0, 0, 1}}\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $Wedge[R3, R3]$], "Input"], Cell[BoxData[ ${{Cos[a\ x + b\ y]\^2 - Sin[a\ x + b\ y]\^2, \(-2$\ Cos[a\ x + b\ y]\ Sin[a\ x + b\ y], 0}, { 2\ Cos[a\ x + b\ y]\ Sin[a\ x + b\ y], Cos[a\ x + b\ y]\^2 - Sin[a\ x + b\ y]\^2, 0}, {0, 0, 1}}\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $d[R3]$], "Input"], Cell[BoxData[ ${{\(-\((a\ d[x] + b\ d[y])$\)\ Sin[a\ x + b\ y], Cos[a\ x + b\ y]\ $(\(-a$\ d[x] - b\ d[y])\), 0}, { Cos[a\ x + b\ y]\ $(a\ d[x] + b\ d[y])$, $-\((a\ d[x] + b\ d[y])$\)\ Sin[a\ x + b\ y], 0}, {0, 0, 0}}\)], "Output"] }, Open ]], Cell[TextData[{ "\t", StyleBox["Wedge", FontWeight->"Bold"], " can be used to multiply a scalar form with a matrix:" }], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $reWrite[d[x]\[Wedge]%]$], "Input"], Cell[BoxData[ ${{\(-b$\ Sin[a\ x + b\ y]\ d[x]\[Wedge]d[y], $-b$\ Cos[a\ x + b\ y]\ d[x]\[Wedge]d[y], 0}, { b\ Cos[a\ x + b\ y]\ d[x]\[Wedge]d[y], $-b$\ Sin[a\ x + b\ y]\ d[x]\[Wedge]d[y], 0}, {0, 0, 0}}\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $Wedge[Inverse[R3], d[R3]]$], "Input"], Cell[BoxData[ ${{0, \(Cos[a\ x + b\ y]\^2\ \((\(-a$\ d[x] - b\ d[y])\)\)\/$Cos[a\ x + b\ y]\^2 + Sin[a\ x + b\ y]\^2$ - $\((a\ d[x] + b\ d[y])$\ Sin[a\ x + b\ y]\^2\)\/$Cos[a\ x + b\ y]\^2 + Sin[a\ x + b\ y]\^2$, 0}, { $Cos[a\ x + b\ y]\^2\ \((a\ d[x] + b\ d[y])$\)\/$Cos[a\ x + b\ y]\^2 + Sin[a\ x + b\ y]\^2$ + $\((a\ d[x] + b\ d[y])$\ Sin[a\ x + b\ y]\^2\)\/$Cos[a\ x + b\ y]\^2 + Sin[a\ x + b\ y]\^2$, $-\(\(Cos[a\ x + b\ y]\ \((\(-a$\ d[x] - b\ d[y])\)\ Sin[a\ x + b\ y]\)\/$Cos[a\ x + b\ y]\^2 + Sin[a\ x + b\ y]\^2$\)\) - $Cos[a\ x + b\ y]\ \((a\ d[x] + b\ d[y])$\ Sin[a\ x + b\ y]\)\/$Cos[a\ x + b\ y]\^2 + Sin[a\ x + b\ y]\^2$, 0}, {0, 0, 0}}\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $reWrite[%]$], "Input"], Cell[BoxData[ ${{0, \(-a$\ d[x] - b\ d[y], 0}, {a\ d[x] + b\ d[y], 0, 0}, {0, 0, 0}} \)], "Output"] }, Open ]], Cell[TextData[{ "\[FilledSmallCircle]\t", StyleBox["Wedge", FontWeight->"Bold"], " can take any number of arguments; it reduces to ", StyleBox["Times", FontWeight->"Bold"], " when fewer than 2 of its arguments are differential forms or matrices:" }], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $Wedge[p, q^2, r^3, f1]$], "Input"], Cell[BoxData[ $2\ a\ p\ q\^2\ r\^3\ d[x] + 3\ b\ p\ q\^2\ r\^3\ d[y] + 5\ c\ p\ q\^2\ r\^3\ d[z]$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $Wedge[p, q^2, r^3, R3]$], "Input"], Cell[BoxData[ ${{p\ q\^2\ r\^3\ Cos[a\ x + b\ y], \(-p$\ q\^2\ r\^3\ Sin[a\ x + b\ y], 0}, { p\ q\^2\ r\^3\ Sin[a\ x + b\ y], p\ q\^2\ r\^3\ Cos[a\ x + b\ y], 0}, {0, 0, p\ q\^2\ r\^3}}\)], "Output"] }, Open ]] }, Closed]], Cell["", "Text"], Cell[CellGroupData[{ Cell["\<\ 2.2 Defining symbolic forms and matrices: DeclareForms and \ DeclareMatrixForms\ \>", "Subsection", ShowGroupOpenCloseIcon->True, FontSize->18], Cell[TextData[{ "\tIn addition to explicit forms and matrices (like ", StyleBox["f1", FontFamily->"Courier", FontWeight->"Bold"], StyleBox[",", FontFamily->"Courier"], " ", StyleBox["f2", FontFamily->"Courier", FontWeight->"Bold"], StyleBox[",", FontFamily->"Courier"], " ", StyleBox["R3", FontFamily->"Courier", FontWeight->"Bold"], " above), EDC allows the user to introduce symbolic forms and matrices (of \ arbitrary differential-form degree); ", StyleBox["Wedge", FontFamily->"Courier", FontWeight->"Bold"], " and ", StyleBox["d", FontFamily->"Courier", FontWeight->"Bold"], " will then act correctly on these symbols. Any symbol can be defined to be \ a symbolic form or matrix using the commands ", StyleBox["DeclareForms", FontWeight->"Bold"], " and ", StyleBox["DeclareMatrixForms", FontWeight->"Bold"], "." }], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[TextData[{ Cell[BoxData[ TagBox["", DisplayForm]]], " (i) ", "DeclareForms", " " }], "Subsubsection", ShowGroupOpenCloseIcon->True, FontSize->16], Cell[TextData[{ "The command", StyleBox[" DeclareForms", FontFamily->"Courier", FontWeight->"Bold"], StyleBox["[{p1_,x__},{p2_,y__},...]", FontFamily->"Courier"], " allows the user to introduce his particular notation for fundamental \ (=not expressible in terms of other forms) p-forms. ", StyleBox["DeclareForms", FontFamily->"Courier", FontWeight->"Bold"], " takes any number of arguments of the form ", StyleBox["{p1_,x__}", FontFamily->"Courier"], ", where ", StyleBox["p1", FontFamily->"Courier"], " is a positive integer (denoting the degree of the differential form(s) ", StyleBox["x__", FontFamily->"Courier"], ") and ", StyleBox["x__", FontFamily->"Courier"], " a sequence of one or more symbols separated by commas. For example, \ evaluating the command ", StyleBox["DeclareForms[{1,a1,q[_]},{2,a2,b2,c2}]", FontFamily->"Courier"], " implies that, in all subsequent calculations, the symbols ", StyleBox["a1,", FontFamily->"Courier"], " ", StyleBox["q[1],", FontFamily->"Courier"], " ", StyleBox["q[2]", FontFamily->"Courier"], ", etc., will be treated as 1-forms and the symbols ", StyleBox["a2,", FontFamily->"Courier"], " ", StyleBox["b2,", FontFamily->"Courier"], " ", StyleBox["c2 ", FontFamily->"Courier"], "as 2-forms. If only forms of the same degree are introduced, the curly \ brackets can be omitted: ", StyleBox["DeclareForms[1,a1,q[_]]", FontFamily->"Courier"], " is the same as ", StyleBox["DeclareForms[{1,a1,q[_]}]", FontFamily->"Courier"], "." }], "Text", ShowGroupOpenCloseIcon->True, TextAlignment->Left, TextJustification->0, FontSize->16], Cell[TextData[{ StyleBox["Note", FontWeight->"Bold"], ": Only ", StyleBox["undefined", FontSlant->"Italic"], " symbols should be declared as forms using ", StyleBox["DeclareForms", FontFamily->"Courier"], ". If all forms are expressed in terms of the coordinate differentials (", StyleBox["d[x]", "OutputL"], ", ", StyleBox["d[x]\[Wedge]d[y]", "OutputL"], ", etc.) ", StyleBox["DeclareForms", FontFamily->"Courier"], " should not be used.", StyleBox[" The effects of ", FontSlant->"Italic"], StyleBox["DeclareForms", FontFamily->"Courier", FontSlant->"Italic"], StyleBox[" cannot be undone", FontSlant->"Italic"], "." }], "Text", ShowGroupOpenCloseIcon->True, TextAlignment->Left, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ StyleBox[$DeclareForms[{1, a1, q[_]}, {2, a2, b2, c2}]$, FontFamily->"Courier"]], "Input"], Cell[BoxData[ $"OK"$], "Print"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $q[1]\[Wedge]a1$], "Input"], Cell[BoxData[ $\(-\((a1\[Wedge]q[1])$\)\)], "Output"] }, Open ]], Cell[TextData[{ StyleBox["Wedge", FontWeight->"Bold"], " orders forms in canonical (alphabetical) order ", StyleBox["by degree", FontSlant->"Italic"], " (lower order forms first):" }], "Text", FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $c2\[Wedge]%\[Wedge]a2$], "Input"], Cell[BoxData[ $\(-\((a1\[Wedge]q[1]\[Wedge]a2\[Wedge]c2)$\)\)], "Output"] }, Open ]], Cell[TextData[{ " ", StyleBox["d", FontWeight->"Bold"], " takes into account the degree of the symbolic forms:" }], "Text", FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $d[a1\[Wedge]q[1]]$], "Input"], Cell[BoxData[ $\(-\((a1\[Wedge]d[q[1]])$\) + q[1]\[Wedge]d[a1]\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $d[a2\[Wedge]b2]$], "Input"], Cell[BoxData[ $a2\[Wedge]d[b2] + b2\[Wedge]d[a2]$], "Output"] }, Open ]], Cell["\<\ One can give arbitrary, but consistent, definitions for the \ exterior derivatives of undefined forms:\ \>", "Text", FontSize->16], Cell[BoxData[ $d[q[1]] = q[2]\[Wedge]q[3]; d[q[2]] = q[3]\[Wedge]q[1]; d[q[3]] = q[1]\[Wedge]q[2]; $], "Input"], Cell[CellGroupData[{ Cell[BoxData[ $\(d[{q[2]\[Wedge]q[3], q[3]\[Wedge]q[1], q[1]\[Wedge]q[2]}] (*\ Verify\ consistency\ *) $\)], "Input"], Cell[BoxData[ ${0, 0, 0}$], "Output"] }, Open ]], Cell[TextData[{ StyleBox["Warning", FontWeight->"Bold"], ": One must not use Set (=) for relations between udefined forms. For \ example, if one discovers, in the course of a calculation, that the equations \ satisfied by an undefined form (say q", StyleBox["[3]", FontFamily->"Courier"], ") imply that it can be expressed in terms of scalars as, say, u d[v] + \ d[w], one must avoid making the assignment q", StyleBox["[3]", FontFamily->"Courier"], " ", StyleBox["=", FontFamily->"Courier"], " ", StyleBox["u", FontFamily->"Courier"], " ", StyleBox["d[v]", FontFamily->"Courier"], " ", StyleBox["+", FontFamily->"Courier"], " ", StyleBox["d[w]", FontFamily->"Courier"], " because it may lead to infinite loops (depending on previous calculations \ using q", StyleBox["[3]", FontFamily->"Courier"], "). One must instead use the replacement rule q", StyleBox["[3]", FontFamily->"Courier"], " ", StyleBox["->", FontFamily->"Courier"], " ", StyleBox["u", FontFamily->"Courier"], " ", StyleBox["d[v]", FontFamily->"Courier"], " ", StyleBox["+", FontFamily->"Courier"], " ", StyleBox["d[w]", FontFamily->"Courier"], " where needed, or restart the calculations using a different notation for \ q", StyleBox["[3]", FontFamily->"Courier"], " (say q", StyleBox["3", FontFamily->"Courier"], ", ", StyleBox["which must not be declared as an 1-form", FontSlant->"Italic"], "), and then setting q", StyleBox["3", FontFamily->"Courier"], " ", StyleBox["=", FontFamily->"Courier"], " ", StyleBox["u", FontFamily->"Courier"], " ", StyleBox["d[v]+d[w]", FontFamily->"Courier"], "." }], "Text"] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ Cell[BoxData[ TagBox["", DisplayForm]]], " (ii) DeclareMatrixForms" }], "Subsubsection", ShowGroupOpenCloseIcon->True, FontSize->16], Cell[TextData[{ "The command", StyleBox[" DeclareMatrixForms", FontFamily->"Courier", FontWeight->"Bold"], StyleBox["[{p1_,x_,xt_},{p2_,y_,yt_},...]", FontFamily->"Courier"], " allows the user to introduce his particular notation for fundamental \ (undefined in terms of other matrices) symbolic p-form ", StyleBox["matrices", FontSlant->"Italic"], ". ", StyleBox["DeclareMatrixForms", FontFamily->"Courier", FontWeight->"Bold"], " takes any number of arguments of the form ", StyleBox["{p1_,x_,xt_}", FontFamily->"Courier"], ", where ", StyleBox["p1", FontFamily->"Courier"], " is a positive integer or zero (denoting the differential form degree of \ ", StyleBox["x_,", FontFamily->"Courier"], " ", StyleBox["xt_", FontFamily->"Courier"], ") and ", StyleBox["x_,", FontFamily->"Courier"], " ", StyleBox["xt_", FontFamily->"Courier"], " are symbols denoting a p1-form matrix and its transpose, respectively. \ For example, evaluating the command ", StyleBox["DeclareMatrixForms[{0,S,S},{1,U,-U},{1,W,Wt}]", FontFamily->"Courier"], " has the effect that, in all subsequent calculations, the symbol ", StyleBox["S", FontFamily->"Courier"], " will be treated as a 0-form symmetric matrix, the symbol ", StyleBox["U", FontFamily->"Courier"], " as an 1-form antisymmetric matrix, and the symbols ", StyleBox["W,", FontFamily->"Courier"], " ", StyleBox["Wt", FontFamily->"Courier"], " as 1-form matrices which are transposes of each other. " }], "Text", ShowGroupOpenCloseIcon->True, TextAlignment->Left, TextJustification->0, FontSize->16], Cell[TextData[{ StyleBox["Note", FontWeight->"Bold"], ": Only ", StyleBox["undefined", FontSlant->"Italic"], " symbols should be declared as matrices using ", StyleBox["DeclareMatrixForms", FontFamily->"Courier"], ". If one introduces a new symbol for a matrix that is defined in terms of \ other matrices (say, P=S\[Wedge]U, or explicitly in terms of a list of \ components), that symbol (P) must not be declared a symbolic matrix using ", StyleBox["DeclareMatrixForms", FontFamily->"Courier"], ".", StyleBox[" The effects of ", FontSlant->"Italic"], StyleBox["DeclareMatrixForms", FontFamily->"Courier", FontSlant->"Italic"], StyleBox[" cannot be undone", FontSlant->"Italic"], "." }], "Text", ShowGroupOpenCloseIcon->True, TextAlignment->Left, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"DeclareMatrixForms", "[", RowBox[{${0, S, S}$, ",", RowBox[{"{", RowBox[{"1", ",", StyleBox["U", FontFamily->"Courier"], ",", RowBox[{"-", StyleBox["U", FontFamily->"Courier"]}]}], "}"}], ",", ${1, W, Wt}$}], "]"}]], "Input"], Cell[BoxData[ $"OK"$], "Print"] }, Open ]], Cell[TextData[{ "The built-in function ", StyleBox["Transpose", FontWeight->"Bold"], " (see section 2.4) has been extended to apply elementary identities to \ symbolic matrices, e.g., \ Transpose[A\[Wedge]B]=(-1)^(p*q)Transpose[B]\[Wedge]Transpose[A], where A, B \ are p, q-form matrices, respectively:" }], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Transpose", "[", RowBox[{"S", "\[Wedge]", StyleBox["U", FontFamily->"Courier"]}], "]"}]], "Input"], Cell[BoxData[ $\(-\((U\[Wedge]S)$\)\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $d[%]$], "Input"], Cell[BoxData[ $U\[Wedge]d[S] - d[U]\[Wedge]S$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Transpose", "[", RowBox[{"W", "\[Wedge]", StyleBox["U", FontFamily->"Courier"]}], "]"}]], "Input"], Cell[BoxData[ $U\[Wedge]Wt$], "Output"] }, Open ]], Cell["\<\ One can also use indexed variables to denote sets of matrices with \ common properties. For example, after evaluating the command \ \>", "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ StyleBox[ $DeclareMatrixForms[{0, S0[_], S0[_]}, {1, A1[_], \(-A1[_]$}, {1, N1[_], N1t[_]}]\), FontFamily->"Courier"]], "Input"], Cell[BoxData[ $"OK"$], "Print"] }, Open ]], Cell[TextData[{ "the symbols", StyleBox[" S0[1],", FontFamily->"Courier"], " ", StyleBox["S0[2],...", FontFamily->"Courier"], " are treated as ", StyleBox["symmetric 0-form", FontSlant->"Italic"], " matrices, the symbols ", StyleBox["A1[1],", FontFamily->"Courier"], " ", StyleBox["A1[2],...", FontFamily->"Courier"], " as ", StyleBox["antisymmetric 1-form", FontSlant->"Italic"], " matrices, and the symbols ", StyleBox["N1[1],", FontFamily->"Courier"], " ", StyleBox["N1[2],..., N1t[1],", FontFamily->"Courier"], " ", StyleBox["N1t[2],...", FontFamily->"Courier"], ", as ", StyleBox["1-form", FontSlant->"Italic"], " matrices which are, respectively, transposes of each other." }], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $Transpose[N1[1]\[Wedge]S0[1]\[Wedge]N1[2]]$], "Input"], Cell[BoxData[ $\(-\((N1t[2]\[Wedge]S0[1]\[Wedge]N1t[1])$\)\)], "Output"] }, Open ]], Cell[TextData[{ "The minus sign is correct -- the ", StyleBox["N1[i]", FontFamily->"Courier"], " are ", StyleBox["1-form", FontSlant->"Italic"], " matrices!" }], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[TextData[{ StyleBox["N", FontFamily->"Times", FontWeight->"Bold"], StyleBox["ote ", FontWeight->"Bold"], ": No special symbol is used for the identity matrix, as it is not needed \ in symbolic calculations. The functions ", StyleBox["tr", FontFamily->"Courier", FontWeight->"Bold"], " and ", StyleBox["toComponents", FontFamily->"Courier", FontWeight->"Bold"], " (see section 2.4) have been defined so as to take into account the \ missing identity matrix." }], "Text", TextAlignment->Left, TextJustification->0, FontSize->16] }, Closed]] }, Closed]], Cell["", "Text"], Cell[CellGroupData[{ Cell[" 2.3 Auxiliary functions / global variables", "Subsection", ShowGroupOpenCloseIcon->True, FontSize->18], Cell[CellGroupData[{ Cell[" (i) FormDegree, simpRules, varList, zeroQ", "Subsubsection", ShowGroupOpenCloseIcon->True, FontSize->16], Cell[TextData[{ "\[FilledSmallCircle]\tThe function", StyleBox[" FormDegree", FontFamily->"Courier", FontWeight->"Bold"], StyleBox["[x_]", FontFamily->"Courier"], " returns the (differential-form) degree of the expression ", StyleBox["x", FontFamily->"Courier"], ". ", StyleBox["It assumes that all terms in a sum and all components in an \ explicit matrix have the same degree", FontSlant->"Italic"], ". " }], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"FormDegree", "[", RowBox[{"a1", "\[Wedge]", StyleBox["b2", FontFamily->"Courier"]}], "]"}]], "Input"], Cell[BoxData[ $3$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"FormDegree", "[", RowBox[{"S", "\[Wedge]", StyleBox["U", FontFamily->"Courier"]}], "]"}]], "Input"], Cell[BoxData[ $1$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"FormDegree", "[", RowBox[{$d[S]$, "\[Wedge]", StyleBox["U", FontFamily->"Courier"]}], "]"}]], "Input"], Cell[BoxData[ $2$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $FormDegree[R3]$], "Input"], Cell[BoxData[ $0$], "Output"] }, Open ]], Cell[TextData[{ "\[FilledSmallCircle]\tThe global variable", StyleBox[" simpRules", FontFamily->"Courier", FontWeight->"Bold"], " is a list of \"simplification rules\" that the user can define. This list \ is used (repeatedly) by ", StyleBox["reWrite", FontWeight->"Bold"], " to simplify expressions. The default value of ", StyleBox["simpRules", FontFamily->"Courier", FontWeight->"Bold"], " is: ", Cell[BoxData[ $simpRules = {x_. \ Cos[z_]\^2 + x_. \ Sin[z_]\^2 :> x}$]], ". It's effect can be seen in the following example:" }], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $d[x]\[Wedge]d[y]\[Wedge]d[z] /. {x -> r\ Sin[\[Theta]] Cos[\[Phi]], y -> r\ Sin[\[Theta]] Sin[\[Phi]], z -> r\ Cos[\[Theta]]}$], "Input"], Cell[BoxData[ $r\^2\ Cos[\[Theta]]\^2\ Cos[\[Phi]]\^2\ Sin[\[Theta]]\ d[r]\[Wedge]d[\[Theta]]\[Wedge]d[\[Phi]] + r\^2\ Cos[\[Phi]]\^2\ Sin[\[Theta]]\^3\ d[r]\[Wedge]d[\[Theta]]\[Wedge]d[\[Phi]] + r\^2\ Cos[\[Theta]]\^2\ Sin[\[Theta]]\ Sin[\[Phi]]\^2\ d[r]\[Wedge]d[\[Theta]]\[Wedge]d[\[Phi]] + r\^2\ Sin[\[Theta]]\^3\ Sin[\[Phi]]\^2\ d[r]\[Wedge]d[\[Theta]]\[Wedge]d[\[Phi]]$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $reWrite[%]$], "Input"], Cell[BoxData[ $r\^2\ Sin[\[Theta]]\ d[r]\[Wedge]d[\[Theta]]\[Wedge]d[\[Phi]]$], "Output"] }, Open ]], Cell[TextData[{ "\[FilledSmallCircle]\tAnother global variable, useful in simplifying \ complicated expressions, is", StyleBox[" varList", FontFamily->"Courier", FontWeight->"Bold"], ". It is a list of variables (or Patterns) that the user can define; they \ are used by ", StyleBox["reWrite", FontWeight->"Bold"], " to group terms in the coefficients of identical ", StyleBox["Wedge", FontWeight->"Bold"], "[__] or ", StyleBox["d[_]", FontWeight->"Bold"], " terms, so as to further simplify the result. The default value of ", StyleBox["varList", FontFamily->"Courier", FontWeight->"Bold"], " is the empty list: ", Cell[BoxData[ StyleBox[$varList = {}$, FontFamily->"Courier"]]], ". An illustration of its use is given in the following example:" }], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[TextData[StyleBox[" Example of the use of varList", FontSlant->"Italic"]], "Subsubsection", ShowGroupOpenCloseIcon->True, FontSize->14], Cell[TextData[{ "\tSuppose the function", StyleBox[" g ", FontFamily->"Courier"], "of", StyleBox[" x, y, z ", FontFamily->"Courier"], "is known to depend on", StyleBox[" x, y ", FontFamily->"Courier"], "through the two particular combinations -- ", StyleBox["(x", FontFamily->"Courier"], " ", StyleBox["+", FontFamily->"Courier"], " ", StyleBox["y)/(", FontFamily->"Courier"], Cell[BoxData[ $x\^2 + y\^2$]], StyleBox[")", FontFamily->"Courier"], " and ", StyleBox["(x", FontFamily->"Courier"], " ", StyleBox["y", FontFamily->"Courier"], " ", StyleBox["+", FontFamily->"Courier"], " ", StyleBox["1)/(", FontFamily->"Courier"], Cell[BoxData[ $x\^2 + y\^2$]], StyleBox[")", FontFamily->"Courier"], " -- and", StyleBox[" g ", FontFamily->"Courier"], "is written with these as arguments. Then" }], "Text", FontSize->14], Cell[CellGroupData[{ Cell[BoxData[ $dg = d[g[\((x + y)$/$(x\^2 + y\^2)$, $(x\ y\ + 1)$/$(x\^2 + y\^2)$, z]]\)], "Input"], Cell[BoxData[ RowBox[{ RowBox[{$d[z]$, " ", RowBox[{ SuperscriptBox["g", TagBox[$(0, 0, 1)$, Derivative], MultilineFunction->None], "[", $\(x + y$\/$x\^2 + y\^2$, $1 + x\ y$\/$x\^2 + y\^2$, z\), "]"}]}], "+", RowBox[{ $(\(y\ d[x]$\/$x\^2 + y\^2$ + $x\ d[y]$\/$x\^2 + y\^2$ - $2\ x\ d[x] + 2\ y\ d[y]$\/$(x\^2 + y\^2)$\^2 - $2\ x\^2\ y\ d[x] + 2\ x\ y\^2\ d[y]$\/$(x\^2 + y\^2)$\^2)\), " ", RowBox[{ SuperscriptBox["g", TagBox[$(0, 1, 0)$, Derivative], MultilineFunction->None], "[", $\(x + y$\/$x\^2 + y\^2$, $1 + x\ y$\/$x\^2 + y\^2$, z\), "]"}]}], "+", RowBox[{ $(d[x]\/\(x\^2 + y\^2$ + d[y]\/$x\^2 + y\^2$ - $2\ x\^2\ d[x] + 2\ x\ y\ d[y]$\/$(x\^2 + y\^2)$\^2 - $2\ x\ y\ d[x] + 2\ y\^2\ d[y]$\/$(x\^2 + y\^2)$\^2)\), " ", RowBox[{ SuperscriptBox["g", TagBox[$(1, 0, 0)$, Derivative], MultilineFunction->None], "[", $\(x + y$\/$x\^2 + y\^2$, $1 + x\ y$\/$x\^2 + y\^2$, z\), "]"}]}]}]], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $reWrite[dg]$], "Input"], Cell[BoxData[ RowBox[{ RowBox[{$d[z]$, " ", RowBox[{ SuperscriptBox["g", TagBox[$(0, 0, 1)$, Derivative], MultilineFunction->None], "[", $\(x + y$\/$x\^2 + y\^2$, $1 + x\ y$\/$x\^2 + y\^2$, z\), "]"}]}], "-", RowBox[{$1\/\((x\^2 + y\^2)$\^2\), RowBox[{"(", RowBox[{$d[x]$, " ", RowBox[{"(", RowBox[{ RowBox[{"2", " ", "x", " ", RowBox[{ SuperscriptBox["g", TagBox[$(0, 1, 0)$, Derivative], MultilineFunction->None], "[", $\(x + y$\/$x\^2 + y\^2$, $1 + x\ y$\/$x\^2 + y\^2$, z\), "]"}]}], "+", RowBox[{$x\^2$, " ", "y", " ", RowBox[{ SuperscriptBox["g", TagBox[$(0, 1, 0)$, Derivative], MultilineFunction->None], "[", $\(x + y$\/$x\^2 + y\^2$, $1 + x\ y$\/$x\^2 + y\^2$, z\), "]"}]}], "-", RowBox[{$y\^3$, " ", RowBox[{ SuperscriptBox["g", TagBox[$(0, 1, 0)$, Derivative], MultilineFunction->None], "[", $\(x + y$\/$x\^2 + y\^2$, $1 + x\ y$\/$x\^2 + y\^2$, z\), "]"}]}], "+", RowBox[{$x\^2$, " ", RowBox[{ SuperscriptBox["g", TagBox[$(1, 0, 0)$, Derivative], MultilineFunction->None], "[", $\(x + y$\/$x\^2 + y\^2$, $1 + x\ y$\/$x\^2 + y\^2$, z\), "]"}]}], "+", RowBox[{"2", " ", "x", " ", "y", " ", RowBox[{ SuperscriptBox["g", TagBox[$(1, 0, 0)$, Derivative], MultilineFunction->None], "[", $\(x + y$\/$x\^2 + y\^2$, $1 + x\ y$\/$x\^2 + y\^2$, z\), "]"}]}], "-", RowBox[{$y\^2$, " ", RowBox[{ SuperscriptBox["g", TagBox[$(1, 0, 0)$, Derivative], MultilineFunction->None], "[", $\(x + y$\/$x\^2 + y\^2$, $1 + x\ y$\/$x\^2 + y\^2$, z\), "]"}]}]}], ")"}]}], ")"}]}], "-", RowBox[{$1\/\((x\^2 + y\^2)$\^2\), RowBox[{"(", RowBox[{$d[y]$, " ", RowBox[{"(", RowBox[{ RowBox[{$-x\^3$, " ", RowBox[{ SuperscriptBox["g", TagBox[$(0, 1, 0)$, Derivative], MultilineFunction->None], "[", $\(x + y$\/$x\^2 + y\^2$, $1 + x\ y$\/$x\^2 + y\^2$, z\), "]"}]}], "+", RowBox[{"2", " ", "y", " ", RowBox[{ SuperscriptBox["g", TagBox[$(0, 1, 0)$, Derivative], MultilineFunction->None], "[", $\(x + y$\/$x\^2 + y\^2$, $1 + x\ y$\/$x\^2 + y\^2$, z\), "]"}]}], "+", RowBox[{"x", " ", $y\^2$, " ", RowBox[{ SuperscriptBox["g", TagBox[$(0, 1, 0)$, Derivative], MultilineFunction->None], "[", $\(x + y$\/$x\^2 + y\^2$, $1 + x\ y$\/$x\^2 + y\^2$, z\), "]"}]}], "-", RowBox[{$x\^2$, " ", RowBox[{ SuperscriptBox["g", TagBox[$(1, 0, 0)$, Derivative], MultilineFunction->None], "[", $\(x + y$\/$x\^2 + y\^2$, $1 + x\ y$\/$x\^2 + y\^2$, z\), "]"}]}], "+", RowBox[{"2", " ", "x", " ", "y", " ", RowBox[{ SuperscriptBox["g", TagBox[$(1, 0, 0)$, Derivative], MultilineFunction->None], "[", $\(x + y$\/$x\^2 + y\^2$, $1 + x\ y$\/$x\^2 + y\^2$, z\), "]"}]}], "+", RowBox[{$y\^2$, " ", RowBox[{ SuperscriptBox["g", TagBox[$(1, 0, 0)$, Derivative], MultilineFunction->None], "[", $\(x + y$\/$x\^2 + y\^2$, $1 + x\ y$\/$x\^2 + y\^2$, z\), "]"}]}]}], ")"}]}], ")"}]}]}]], "Output"] }, Open ]], Cell[TextData[{ "Note that ", StyleBox["reWrite", FontFamily->"Courier", FontWeight->"Bold"], " collects together all terms having ", StyleBox["d[x],", FontFamily->"Courier"], " ", StyleBox["d[y]", FontFamily->"Courier"], " as factors, but it does not group together terms with the same \ derivatives of ", StyleBox["g", FontFamily->"Courier"], " in the coefficients of ", StyleBox["d[x],", FontFamily->"Courier"], " ", StyleBox["d[y]", FontFamily->"Courier"], ". Therefore, choose" }], "Text", FontSize->14], Cell[BoxData[ $\(varList = {\(\(Derivative[__]$[g]\)[__]}; \)\)], "Input"], Cell[TextData[{ "Now ", StyleBox["reWrite", FontFamily->"Courier", FontWeight->"Bold"], " gives:" }], "Text", FontSize->14], Cell[CellGroupData[{ Cell[BoxData[ $reWrite[dg]$], "Input"], Cell[BoxData[ RowBox[{ RowBox[{$d[z]$, " ", RowBox[{ SuperscriptBox["g", TagBox[$(0, 0, 1)$, Derivative], MultilineFunction->None], "[", $\(x + y$\/$x\^2 + y\^2$, $1 + x\ y$\/$x\^2 + y\^2$, z\), "]"}]}], "+", RowBox[{$d[y]$, " ", RowBox[{"(", RowBox[{ RowBox[{"-", FractionBox[ RowBox[{$(\(-x\^3$ + 2\ y + x\ y\^2)\), " ", RowBox[{ SuperscriptBox["g", TagBox[$(0, 1, 0)$, Derivative], MultilineFunction->None], "[", $\(x + y$\/$x\^2 + y\^2$, $1 + x\ y$\/$x\^2 + y\^2$, z\), "]"}]}], $\((x\^2 + y\^2)$\^2\)]}], "+", FractionBox[ RowBox[{$(x\^2 - 2\ x\ y - y\^2)$, " ", RowBox[{ SuperscriptBox["g", TagBox[$(1, 0, 0)$, Derivative], MultilineFunction->None], "[", $\(x + y$\/$x\^2 + y\^2$, $1 + x\ y$\/$x\^2 + y\^2$, z\), "]"}]}], $\((x\^2 + y\^2)$\^2\)]}], ")"}]}], "+", RowBox[{$d[x]$, " ", RowBox[{"(", RowBox[{ RowBox[{"-", FractionBox[ RowBox[{$(2\ x + x\^2\ y - y\^3)$, " ", RowBox[{ SuperscriptBox["g", TagBox[$(0, 1, 0)$, Derivative], MultilineFunction->None], "[", $\(x + y$\/$x\^2 + y\^2$, $1 + x\ y$\/$x\^2 + y\^2$, z\), "]"}]}], $\((x\^2 + y\^2)$\^2\)]}], "-", FractionBox[ RowBox[{$(x\^2 + 2\ x\ y - y\^2)$, " ", RowBox[{ SuperscriptBox["g", TagBox[$(1, 0, 0)$, Derivative], MultilineFunction->None], "[", $\(x + y$\/$x\^2 + y\^2$, $1 + x\ y$\/$x\^2 + y\^2$, z\), "]"}]}], $\((x\^2 + y\^2)$\^2\)]}], ")"}]}]}]], "Output"] }, Open ]], Cell["\<\ which is a more meaningful expression. Verify that it is a closed \ form:\ \>", "Text", FontSize->14], Cell[CellGroupData[{ Cell[BoxData[ $reWrite[d[%]]$], "Input"], Cell[BoxData[ $0$], "Output"] }, Open ]], Cell[BoxData[ $\(varList = {}; $\)], "Input"] }, Closed]], Cell[TextData[{ "\t", StyleBox["Note", FontWeight->"Bold"], ": The global variables ", StyleBox["simpRules", FontFamily->"Courier", FontWeight->"Bold"], " and ", StyleBox["varList", FontFamily->"Courier", FontWeight->"Bold"], " are assumed to be ", StyleBox["lists", FontSlant->"Italic"], ". Thus, to clear them, one must not use Clear[simpRules, varList]. One \ must instead set them equal to the empty list.\n" }], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[TextData[{ "\[FilledSmallCircle]\tThe function", StyleBox[" zeroQ", FontFamily->"Courier", FontWeight->"Bold"], StyleBox["[x_]", FontFamily->"Courier"], " tests if the expression ", StyleBox["x", FontFamily->"Courier"], " is identically zero (zero matrix) and returns ", StyleBox["True", FontFamily->"Courier"], " or ", StyleBox["False", FontFamily->"Courier"], ". ", StyleBox["It does not perform any simplifications:", FontSlant->"Italic"] }], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $zeroQ/@{0, a, Cos[x]^2 + Sin[x]^2 - 1, {{0, 0}, {0, 0}}, a^2 + 2 a\ b + b^2 - \((a + b)$^2}\)], "Input"], Cell[BoxData[ ${True, False, False, True, False}$], "Output"] }, Open ]], Cell[TextData[{ "\tIt should be used after simplification with ", StyleBox["reWrite", FontWeight->"Bold"], ": " }], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $zeroQ/@ reWrite[{0, a, Cos[x]^2 + Sin[x]^2 - 1, {{0, 0}, {0, 0}}, \((a + b)$^2 - a^2 - 2 a\ b - b^2}]\)], "Input"], Cell[BoxData[ ${True, False, True, True, True}$], "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[" (ii) Bar", "Subsubsection", ShowGroupOpenCloseIcon->True, FontSize->16], Cell[TextData[{ "\tThe function", StyleBox[" ", FontFamily->"Courier", FontWeight->"Bold"], StyleBox["Bar", FontFamily->"Courier", FontWeight->"Bold"], StyleBox["[x_]", FontFamily->"Courier"], " returns the complex conjugate of the expression x, ", StyleBox["assuming all symbols are complex", FontSlant->"Italic"], "." }], "Text", ShowGroupOpenCloseIcon->True, TextAlignment->Left, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $f2$], "Input"], Cell[BoxData[ $a\ Cos[a\ x + b\ y]\ d[x] - b\ d[y]\ Sin[a\ x + b\ y]$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $Bar[%]$], "Input"], Cell[BoxData[ $Bar[a]\ d[Bar[x]]\ \(Bar[Cos]$[Bar[a]\ Bar[x] + Bar[b]\ Bar[y]] - Bar[b]\ d[Bar[y]]\ $Bar[Sin]$[Bar[a]\ Bar[x] + Bar[b]\ Bar[y]]\)], "Output"] }, Open ]], Cell[TextData[{ " \tIf some symbols are real, the user must either set ", StyleBox["Bar[ai]=ai", FontFamily->"Courier"], ", or use a corresponding replacement rule, for each real symbol ", StyleBox["ai", FontFamily->"Courier"], "." }], "Text", ShowGroupOpenCloseIcon->True, TextAlignment->Left, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $% /. {Bar[x] \[Rule] x, Bar[y] \[Rule] y, Bar[Cos] \[Rule] Cos, Bar[Sin] \[Rule] Sin}$], "Input"], Cell[BoxData[ $Bar[a]\ Cos[x\ Bar[a] + y\ Bar[b]]\ d[x] - Bar[b]\ d[y]\ Sin[x\ Bar[a] + y\ Bar[b]]$], "Output"] }, Open ]], Cell[TextData[{ "\tIf most symbols are real, as in this example, one can define ", StyleBox["Bar[x_Symbol]:=x", FontFamily->"Courier", FontWeight->"Plain"], ", and still set ", StyleBox["Bar[ci]=ciB;", FontFamily->"Courier", FontWeight->"Plain"], " ", StyleBox["Bar[ciB]=ci;", FontFamily->"Courier", FontWeight->"Plain"], " for pairs of complex-conjugate symbols ", StyleBox["ci,", FontFamily->"Courier"], " ", StyleBox["ciB", FontFamily->"Courier"], " (immediate assignments are evaluated before delayed ones!)." }], "Text", ShowGroupOpenCloseIcon->True, TextAlignment->Left, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $r1 = {z -> x + I\ y}$], "Input"], Cell[BoxData[ ${z \[Rule] x + I\ y}$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $r2 = Join[r1, Bar[r1]]$], "Input"], Cell[BoxData[ ${z \[Rule] x + I\ y, Bar[z] \[Rule] Bar[x] - I\ Bar[y]}$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $Bar[x_Symbol] := x; Bar[z] = zB; Bar[zB] = z; \nr2$], "Input"], Cell[BoxData[ ${z \[Rule] x + I\ y, zB \[Rule] x - I\ y}$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $Bar[%]$], "Input"], Cell[BoxData[ ${zB \[Rule] x - I\ y, z \[Rule] x + I\ y}$], "Output"] }, Open ]], Cell[BoxData[ $Bar[x_Symbol] =. $], "Input"] }, Closed]], Cell[CellGroupData[{ Cell[" (iii) ScalFormQ, BasicScalFormQ, MatQ, BasicMatQ", "Subsubsection", ShowGroupOpenCloseIcon->True, FontSize->16], Cell[CellGroupData[{ Cell[TextData[{ "\[FilledSmallCircle] The functions ", StyleBox["ScalFormQ", FontFamily->"Courier", FontWeight->"Bold"], StyleBox["[x_], ", FontFamily->"Courier"], StyleBox["BasicScalFormQ", FontFamily->"Courier", FontWeight->"Bold"], StyleBox["[x_]", FontFamily->"Courier"], " return ", StyleBox["True", FontFamily->"Courier"], " if ", StyleBox["x", FontFamily->"Courier"], " is a (basic) differential-form expression and ", StyleBox["False", FontFamily->"Courier"], " otherwise. Basic means not expressible (as sum or product) in terms of \ other forms. Note that the complex conjugate of a basic form and the trace of \ a p(>0)-form matrix are taken to be basic forms (the symbols below have been \ defined as symbolic forms or matrices in section 2.2)." }], "Text", ShowGroupOpenCloseIcon->True, TextJustification->0, FontSize->16], Cell[BoxData[ $\(testExpr = {x, d[x], a1, U, 3\ d[x], a1 + q[1], a1\[Wedge]q[1], Bar[a1], tr[N1[1]]}; $\)], "Input"], Cell[CellGroupData[{ Cell[BoxData[ $ScalFormQ/@testExpr$], "Input"], Cell[BoxData[ ${False, True, True, False, True, True, True, True, True}$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $BasicScalFormQ/@testExpr$], "Input"], Cell[BoxData[ ${False, True, True, False, False, False, False, True, True}$], "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ "\[FilledSmallCircle] The functions ", StyleBox["MatQ", FontFamily->"Courier", FontWeight->"Bold"], StyleBox["[x_]", FontFamily->"Courier"], ", ", StyleBox["BasicMatQ", FontFamily->"Courier", FontWeight->"Bold"], StyleBox["[x_]", FontFamily->"Courier"], " return ", StyleBox["True", FontFamily->"Courier"], " if ", StyleBox["x", FontFamily->"Courier"], " is a (basic) matrix expression and ", StyleBox["False", FontFamily->"Courier"], " otherwise. Basic means not expressible (as sum or product) in terms of \ other matrices." }], "Text", ShowGroupOpenCloseIcon->True, TextJustification->0, FontSize->16], Cell[BoxData[ $\(testExpr = {x, d[x], a1, S, d[S], N1[2] + N1t[2], S\[Wedge]U, d[x]\[Wedge]U, Bar[N1[2]]}; $\)], "Input"], Cell[CellGroupData[{ Cell[BoxData[ $MatQ/@testExpr$], "Input"], Cell[BoxData[ ${False, False, False, True, True, True, True, True, True}$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $BasicMatQ/@testExpr$], "Input"], Cell[BoxData[ ${False, False, False, True, True, False, False, False, True}$], "Output"] }, Open ]] }, Closed]], Cell[TextData[{ "\tThese functions are useful in setting up conditions for applying extra \ ", StyleBox["Wedge", FontWeight->"Bold"], " definitions or rules." }], "Text", ShowGroupOpenCloseIcon->True, TextJustification->0, FontSize->16] }, Closed]], Cell[CellGroupData[{ Cell[" (iv) NoDif", "Subsubsection", ShowGroupOpenCloseIcon->True, FontSize->16], Cell["\tSee Example 3.5", "Text", ShowGroupOpenCloseIcon->True, TextJustification->0, FontSize->16] }, Closed]], Cell[CellGroupData[{ Cell[" (v) indepTerms, indepCoefs", "Subsubsection", ShowGroupOpenCloseIcon->True, FontSize->16], Cell["\<\ \tThese functions are useful in reducing large lists of \ expressions.\ \>", "Text", ShowGroupOpenCloseIcon->True, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[TextData[{ "\[FilledSmallCircle]\tThe function ", StyleBox["indepTerms", FontFamily->"Courier", FontWeight->"Bold"], StyleBox["[x_]", FontFamily->"Courier"], " returns a list of the \"independent\" elements of the list ", StyleBox["x", FontWeight->"Bold"], ". Independent here means not equal to \[PlusMinus] a numerical multiple \ of another element. Note that ", StyleBox["indepTerms", FontFamily->"Courier"], " does not perform any reductions:" }], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $indepTerms[{2 a + 2 b, a + b}]$], "Input"], Cell[BoxData[ ${a + b, 2\ a + 2\ b}$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $indepTerms[{2 \((a + b)$, a + b}]\)], "Input"], Cell[BoxData[ ${a + b}$], "Output"] }, Open ]], Cell["nor does it test for linear dependence:", "Text", ShowGroupOpenCloseIcon->True, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $indepTerms[{a - b, b - c, c - a}]$], "Input"], Cell[BoxData[ ${a - b, b - c, \(-a$ + c}\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $Plus@@%$], "Input"], Cell[BoxData[ $0$], "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ "\[FilledSmallCircle]\tThe function ", StyleBox["indepCoefs", FontFamily->"Courier", FontWeight->"Bold"], StyleBox["[", FontFamily->"Courier"], StyleBox["x_", FontFamily->"Courier", FontWeight->"Bold"], StyleBox["]", FontFamily->"Courier"], " returns a list of the \"independent\" ", StyleBox["coefficients", FontSlant->"Italic"], " of all symbolic differential forms, symbolic matrices or wedge-products \ in the elements of the list ", StyleBox["x", FontWeight->"Bold"], ". Independent here means not equal to \[PlusMinus] a numerical multiple \ of another coefficient. " }], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell["\<\ The symbols q[i] have been defined earlier as symbolic \ 1-forms.\ \>", "Text", ShowGroupOpenCloseIcon->True, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $indepCoefs[a[1]\ q[1] + a[2]\ q[2] + a[3]\ q[3]]$], "Input"], Cell[BoxData[ ${a[1], a[2], a[3]}$], "Output"] }, Open ]], Cell[TextData[{ StyleBox["indepCoefs", FontFamily->"Courier"], " works with symbolic matrices also (S has been defined earlier as a 0-form \ symmetric matrix)." }], "Text", ShowGroupOpenCloseIcon->True, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $indepCoefs[ a[0] + a[1]\ S + a[2]\ S\[Wedge]S + a[3]\ S\[Wedge]S\[Wedge]S]$], "Input"], Cell[BoxData[ ${a[0], a[1], a[2], a[3]}$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $indepCoefs[ \((a[2] + a[3])$\ q[2]\[Wedge]q[3] + $(a[3] + a[1])$\ q[3]\[Wedge]q[1] + $(a[1] - a[2])$\ q[1]\[Wedge]q[2]]\)], "Input"], Cell[BoxData[ ${a[1] - a[2], \(-a[1]$ - a[3], a[2] + a[3]}\)], "Output"] }, Open ]], Cell[TextData[{ "Like ", StyleBox["indepTerms", FontFamily->"Courier"], ", ", StyleBox["indepCoefs", FontFamily->"Courier"], " does not test for linear dependence:" }], "Text", ShowGroupOpenCloseIcon->True, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $Plus@@%$], "Input"], Cell[BoxData[ $0$], "Output"] }, Open ]], Cell[TextData[{ StyleBox["indepCoefs", FontFamily->"Courier"], " has no effect on expressions that are not differential forms or \ matrices:" }], "Text", ShowGroupOpenCloseIcon->True, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $indepCoefs[a[1]\ b[1] + a[2]\ b[2] + a[3]\ b[3]]$], "Input"], Cell[BoxData[ ${a[1]\ b[1] + a[2]\ b[2] + a[3]\ b[3]}$], "Output"] }, Open ]], Cell[TextData[{ StyleBox["indepCoefs", FontFamily->"Courier"], " can be applied to lists:" }], "Text", ShowGroupOpenCloseIcon->True, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $sym33mat = Table[\((i + j)$ $(a[i] - a[j])$ q[i]\[Wedge]q[j], {i, 3}, {j, 3}] \)], "Input"], Cell[BoxData[ ${{0, 3\ \((a[1] - a[2])$\ q[1]\[Wedge]q[2], 4\ $(a[1] - a[3])$\ q[1]\[Wedge]q[3]}, { $-3$\ $(\(-a[1]$ + a[2])\)\ q[1]\[Wedge]q[2], 0, 5\ $(a[2] - a[3])$\ q[2]\[Wedge]q[3]}, { $-4$\ $(\(-a[1]$ + a[3])\)\ q[1]\[Wedge]q[3], $-5$\ $(\(-a[2]$ + a[3])\)\ q[2]\[Wedge]q[3], 0}}\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $indepCoefs[%]$], "Input"], Cell[BoxData[ ${a[1] - a[2], a[1] - a[3], a[2] - a[3]}$], "Output"] }, Open ]], Cell[TextData[{ "Note that ", StyleBox["indepTerms", FontFamily->"Courier"], " does not recognize that ", StyleBox["(-a[1]+a[2])=-(a[1]-a[2])", FontFamily->"Courier"], ", as it does not carry out any simplifications:" }], "Text", ShowGroupOpenCloseIcon->True, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $indepTerms[sym33mat]$], "Input"], Cell[BoxData[ ${\((a[1] - a[2])$\ q[1]\[Wedge]q[2], $(\(-a[1]$ + a[2])\)\ q[1]\[Wedge]q[2], $(a[1] - a[3])$\ q[1]\[Wedge]q[3], $(\(-a[1]$ + a[3])\)\ q[1]\[Wedge]q[3], $(a[2] - a[3])$\ q[2]\[Wedge]q[3], $(\(-a[2]$ + a[3])\)\ q[2]\[Wedge]q[3]}\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $indepTerms[reWrite[sym33mat]]$], "Input"], Cell[BoxData[ ${\((a[1] - a[2])$\ q[1]\[Wedge]q[2], $(a[1] - a[3])$\ q[1]\[Wedge]q[3], $(a[2] - a[3])$\ q[2]\[Wedge]q[3]}\)], "Output"] }, Open ]] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[" (vi) GenCoef", "Subsubsection", ShowGroupOpenCloseIcon->True, FontSize->16], Cell[TextData[{ Cell[BoxData[ TagBox["", DisplayForm]]], Cell[BoxData[ TagBox["", DisplayForm]]], "\tThe function ", StyleBox["GenCoef[x_,y_]", FontFamily->"Courier", FontWeight->"Bold"], " (\"Generalized Coefficient\") is very similar to the ", StyleBox["Mathematica", FontSlant->"Italic"], " function ", StyleBox["Coefficient[x_, y_]", FontFamily->"Courier", FontWeight->"Bold"], ". Unlike ", StyleBox["Coefficient", FontFamily->"Courier", FontWeight->"Bold"], ", however, ", StyleBox["GenCoef", FontFamily->"Courier", FontWeight->"Bold"], " returns a series when ", StyleBox["x", FontFamily->"Courier", FontWeight->"Bold"], " is a series and, when both ", StyleBox["x", FontFamily->"Courier", FontWeight->"Bold"], " and ", StyleBox["y", FontFamily->"Courier", FontWeight->"Bold"], " are Lists, returns a nested List:" }], "Text", FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $seriesExpr = Series[Sum[\((a + b)$^k*x^k, {k, 0, 3}], {x, 0, 3}]\)], "Input"], Cell[BoxData[ InterpretationBox[ RowBox[{ "1", "+", $\((a + b)$\ x\), "+", $\((a + b)$\^2\ x\^2\), "+", $\((a + b)$\^3\ x\^3\), "+", InterpretationBox[$O[x]\^4$, SeriesData[ x, 0, {}, 0, 4, 1]]}], SeriesData[ x, 0, {1, Plus[ a, b], Power[ Plus[ a, b], 2], Power[ Plus[ a, b], 3]}, 0, 4, 1]]], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $Coefficient[seriesExpr, b]$], "Input"], Cell[BoxData[ $x + 2\ a\ x\^2 + 3\ a\^2\ x\^3$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $Coefficient[seriesExpr, b, 2]$], "Input"], Cell[BoxData[ $x\^2 + 3\ a\ x\^3$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $GenCoef[seriesExpr, b]$], "Input"], Cell[BoxData[ InterpretationBox[ RowBox[{"x", "+", $2\ a\ x\^2$, "+", $3\ a\^2\ x\^3$, "+", InterpretationBox[$O[x]\^4$, SeriesData[ x, 0, {}, 1, 4, 1]]}], SeriesData[ x, 0, {1, Times[ 2, a], Times[ 3, Power[ a, 2]]}, 1, 4, 1]]], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $GenCoef[seriesExpr, b, 2]$], "Input"], Cell[BoxData[ InterpretationBox[ RowBox[{$x\^2$, "+", $3\ a\ x\^3$, "+", InterpretationBox[$O[x]\^4$, SeriesData[ x, 0, {}, 2, 4, 1]]}], SeriesData[ x, 0, {1, Times[ 3, a]}, 2, 4, 1]]], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $Coefficient[{a[1] x + a[2] y, b[1] x + b[2] y}, {x, y}]$], "Input"], Cell[BoxData[ ${a[1], b[2]}$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $GenCoef[{a[1] x + a[2] y, b[1] x + b[2] y}, {x, y}]$], "Input"], Cell[BoxData[ ${{a[1], a[2]}, {b[1], b[2]}}$], "Output"] }, Open ]], Cell[TextData[{ Cell[BoxData[ TagBox["", DisplayForm]]], Cell[BoxData[ TagBox["", DisplayForm]]], "\tThus ", StyleBox["GenCoef[LinearEquations_List,unknowns_List]", FontFamily->"Courier"], " gives directly the matrix of coefficients of the unknowns in the given \ equations. " }], "Text", FontSize->16] }, Closed]], Cell[CellGroupData[{ Cell[" (vii) FormCoef", "Subsubsection", ShowGroupOpenCloseIcon->True, FontSize->16], Cell[TextData[{ Cell[BoxData[ TagBox["", DisplayForm]]], Cell[BoxData[ TagBox["", DisplayForm]]], "\tThe function ", StyleBox["FormCoef[x_,y_]", FontFamily->"Courier", FontWeight->"Bold"], " (\"Form Coefficient\") gives the \"left-coefficient\" of the differential \ form ", StyleBox["y", FontFamily->"Courier", FontWeight->"Bold"], " in the differential form expression ", StyleBox["x", FontFamily->"Courier", FontWeight->"Bold"], ", i.e., writes ", StyleBox["x", FontFamily->"Courier", FontWeight->"Bold"], " as ", StyleBox["w\[Wedge]y", FontFamily->"Courier", FontWeight->"Bold"], " + terms not containing ", StyleBox["y", FontFamily->"Courier", FontWeight->"Bold"], " and returns ", StyleBox["w", FontFamily->"Courier", FontWeight->"Bold"], ". If ", StyleBox["y", FontFamily->"Courier", FontWeight->"Bold"], " is of odd FormDegree, then ", StyleBox["w", FontFamily->"Courier", FontWeight->"Bold"], " is defined up to a multiple of ", StyleBox["y", FontFamily->"Courier", FontWeight->"Bold"], ". The differential form ", StyleBox["y", FontFamily->"Courier", FontWeight->"Bold"], " must either be a single symbolic form or a Wedge product of such forms. \ Examples (the symbols e[i] are defined as symbolic 1-forms):" }], "Text", FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $threeForm = d[f]\[Wedge]e[1]\ \[Wedge]e[3] + \((f + g)$ e[1]\[Wedge]\ e[2]\[Wedge]e[3] + d[h]\[Wedge]e[1]\ \[Wedge]e[2] + h\ e[1]\[Wedge]d[e[2]]\)], "Input"], Cell[BoxData[ $h\ e[1]\[Wedge]d[e[2]] + d[f]\[Wedge]e[1]\[Wedge]e[3] + d[h]\[Wedge]e[1]\[Wedge]e[2] + \((f + g)$\ e[1]\[Wedge]e[2]\[Wedge]e[3]\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $FormCoef[threeForm, e[1]]$], "Input"], Cell[BoxData[ $h\ d[e[2]] - d[f]\[Wedge]e[3] - d[h]\[Wedge]e[2] + \((f + g)$\ e[2]\[Wedge]e[3]\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $FormCoef[threeForm, e[2]]$], "Input"], Cell[BoxData[ $d[h]\[Wedge]e[1] - \((f + g)$\ e[1]\[Wedge]e[3]\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $FormCoef[threeForm, d[e[2]]]$], "Input"], Cell[BoxData[ $h\ e[1]$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $FormCoef[threeForm, d[f]]$], "Input"], Cell[BoxData[ $e[1]\[Wedge]e[3]$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $FormCoef[threeForm, e[1]\[Wedge]e[2]]$], "Input"], Cell[BoxData[ $d[h] + \((f + g)$\ e[3]\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $FormCoef[threeForm, d[h]\[Wedge]e[2]]$], "Input"], Cell[BoxData[ $\(-e[1]$\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $FormCoef[threeForm, e[1]\[Wedge]e[2]\[Wedge]e[3]]$], "Input"], Cell[BoxData[ $f + g$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $FormCoef[threeForm, d[f]\[Wedge]e[1]\ \[Wedge]e[3]]$], "Input"], Cell[BoxData[ $1$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $FormCoef[threeForm, f\ e[1]\[Wedge]e[2]]$], "Input"], Cell[BoxData[ $0$], "Output"] }, Open ]], Cell[TextData[{ StyleBox["FormCoef", FontFamily->"Courier", FontWeight->"Bold"], " gives here the wrong result because ", StyleBox["f", FontFamily->"Courier", FontWeight->"Bold"], " ", StyleBox["e[1]\[Wedge]e[2]", FontFamily->"Courier", FontWeight->"Bold"], " is neither a single symbolic form nor a Wedge product of such forms.", Cell[BoxData[ TagBox["", DisplayForm]]] }], "Text", FontSize->16], Cell[TextData[{ "\tThe arguments of ", StyleBox["FormCoef", FontFamily->"Courier", FontWeight->"Bold"], " can contain symbolic forms of any degree: \n\t(the symbols {a2, b2, c2} \ have been defined earlier as symbolic 2-forms)" }], "Text", FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $fourForm = e[1]\[Wedge]\ e[2]\ \[Wedge]a2 + e[2]\[Wedge]e[3]\[Wedge]\ b2 + e[3]\ \[Wedge]e[1]\[Wedge]c2 + a2\[Wedge]b2 + b2\[Wedge]c2 + a2\[Wedge]c2$], "Input"], Cell[BoxData[ $a2\[Wedge]b2 + a2\[Wedge]c2 + b2\[Wedge]c2 + e[1]\[Wedge]e[2]\[Wedge]a2 - e[1]\[Wedge]e[3]\[Wedge]c2 + e[2]\[Wedge]e[3]\[Wedge]b2$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $FormCoef[fourForm, a2]$], "Input"], Cell[BoxData[ $b2 + c2 + e[1]\[Wedge]e[2]$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $FormCoef[fourForm, e[1]]$], "Input"], Cell[BoxData[ $\(-\((e[2]\[Wedge]a2)$\) + e[3]\[Wedge]c2\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $FormCoef[fourForm, e[1]\[Wedge]a2]$], "Input"], Cell[BoxData[ $\(-e[2]$\)], "Output"] }, Open ]], Cell[TextData[{ "\tIf ", StyleBox["x", FontFamily->"Courier", FontWeight->"Bold"], " is a list of differential forms, ", StyleBox["FormCoef", FontFamily->"Courier", FontWeight->"Bold"], " returns the corresponding list of coefficients:" }], "Text", FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $FormCoef[{e[1]\[Wedge]e[2], e[2]\[Wedge]e[3], e[3]\[Wedge]e[1]}, e[1]] $], "Input"], Cell[BoxData[ ${\(-e[2]$, 0, e[3]}\)], "Output"] }, Open ]] }, Closed]] }, Closed]], Cell["", "Text"], Cell[CellGroupData[{ Cell[" 2.4 Extra matrix functions / global variables", "Subsection", ShowGroupOpenCloseIcon->True, FontSize->18], Cell["\<\ \tEven though symbolic matrices can have unequal dimensions, some \ operations defined in this section (tests for symmetry, trace, etc.) can only \ be applied to square matrices.\ \>", "Text", FontSize->16], Cell[CellGroupData[{ Cell[" (i) Transpose, SymQ, AntisymQ", "Subsubsection", ShowGroupOpenCloseIcon->True, FontSize->16], Cell[TextData[{ "\[FilledSmallCircle]\tAs mentioned in section 2.2 (ii), the built-in \ function ", StyleBox["Transpose", FontWeight->"Bold"], " has been extended to handle properly symbolic matrix expressions \ containing the symbols introduced with ", StyleBox["DeclareMatrixForms", FontFamily->"Courier"], ". (The symbols S and U, A1[_] have been defined above as a symmetric \ 0-form and antisymmetric 1-form matrices.)" }], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Transpose", "[", RowBox[{ RowBox[{"S", "\[Wedge]", StyleBox["U", FontFamily->"Courier"]}], "+", $U\[Wedge]S$}], "]"}]], "Input"], Cell[BoxData[ $\(-\((S\[Wedge]U)$\) - U\[Wedge]S\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"d", "[", RowBox[{ RowBox[{"S", "\[Wedge]", StyleBox["U", FontFamily->"Courier"]}], "+", $U\[Wedge]S$}], StyleBox["]", FontFamily->"Courier"]}], StyleBox["+", FontFamily->"Courier"], RowBox[{$A1[1]$, "\[Wedge]", RowBox[{"(", RowBox[{ RowBox[{"S", "\[Wedge]", StyleBox["U", FontFamily->"Courier"]}], "+", $U\[Wedge]S$}], ")"}]}], "+", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{"S", "\[Wedge]", StyleBox["U", FontFamily->"Courier"]}], "+", $U\[Wedge]S$}], ")"}], "\[Wedge]", $A1[1]$}]}]], "Input"], Cell[BoxData[ $S\[Wedge]d[U] - U\[Wedge]d[S] + d[S]\[Wedge]U + d[U]\[Wedge]S + S\[Wedge]U\[Wedge]A1[1] + U\[Wedge]S\[Wedge]A1[1] + A1[1]\[Wedge]S\[Wedge]U + A1[1]\[Wedge]U\[Wedge]S$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $% + Transpose[%]$], "Input"], Cell[BoxData[ $0$], "Output"] }, Open ]], Cell["\<\ Using Transpose, the following two functions have been \ defined:\ \>", "Text", ShowGroupOpenCloseIcon->True, TextAlignment->Left, TextJustification->0, FontSize->16], Cell[TextData[{ "\[FilledSmallCircle]\tThe function", StyleBox[" SymQ", FontFamily->"Courier", FontWeight->"Bold"], StyleBox["[x_]", FontFamily->"Courier"], " returns ", StyleBox["True", FontFamily->"Courier"], " if ", StyleBox["Transpose[x]=x", FontFamily->"Courier"], " and ", StyleBox["False", FontFamily->"Courier"], " otherwise.\nThe function", StyleBox[" AntisymQ", FontFamily->"Courier", FontWeight->"Bold"], StyleBox["[x_]", FontFamily->"Courier"], " returns ", StyleBox["True", FontFamily->"Courier"], " if ", StyleBox["Transpose[x]=-x", FontFamily->"Courier"], " and ", StyleBox["False", FontFamily->"Courier"], " otherwise." }], "Text", ShowGroupOpenCloseIcon->True, TextAlignment->Left, TextJustification->0, FontSize->16], Cell[TextData[{ StyleBox["\tIn ", FontWeight->"Plain"], StyleBox["SymQ", FontFamily->"Courier", FontWeight->"Bold"], StyleBox["/", FontFamily->"Courier", FontWeight->"Plain"], StyleBox["AntisymQ", FontFamily->"Courier", FontWeight->"Bold"], StyleBox[" equality is determined after taking into account the \ simplification rules contained in ", FontWeight->"Plain"], StyleBox["simpRules", FontFamily->"Courier", FontWeight->"Bold"], StyleBox[".", FontWeight->"Plain"] }], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $Transpose[ \((Cos[a]\^2 + Sin[a]\^2)$ S0[1]\[Wedge]A1[1] + A1[1]\[Wedge]S0[1]]\)], "Input"], Cell[BoxData[ $\(-\((Cos[a]\^2 + Sin[a]\^2)$\)\ A1[1]\[Wedge]S0[1] - S0[1]\[Wedge]A1[1]\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $AntisymQ[%]$], "Input"], Cell[BoxData[ $True$], "Output"] }, Open ]], Cell[TextData[{ StyleBox["\tIf", FontWeight->"Plain"], " ", StyleBox["x", FontFamily->"Courier"], " is a scalar, it is assumed to multiply the identity matrix, ", StyleBox["so ", FontWeight->"Plain"], StyleBox["SymQ", FontFamily->"Courier", FontWeight->"Bold"], StyleBox["/", FontFamily->"Courier", FontWeight->"Plain"], StyleBox["AntisymQ", FontFamily->"Courier", FontWeight->"Bold"], StyleBox[" give ", FontWeight->"Plain"], StyleBox["True", FontFamily->"Courier"], StyleBox[" /", FontWeight->"Plain"], StyleBox["False", FontFamily->"Courier"] }], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $SymQ[a]$], "Input"], Cell[BoxData[ $True$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $AntisymQ[a]$], "Input"], Cell[BoxData[ $False$], "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[" (ii) matDimension, traceOption, tr", "Subsubsection", ShowGroupOpenCloseIcon->True, FontSize->16], Cell[TextData[{ "\[FilledSmallCircle]\tThe global variable", StyleBox[" matDimension ", FontFamily->"Courier", FontWeight->"Bold"], "is a positive integer -- the matrix dimension (assumed square) -- to be \ assigned by the user. ", StyleBox["All symbolic matrices are assumed to have the same dimension", FontSlant->"Italic"], ". Together with a second global variable, ", StyleBox["traceOption", FontFamily->"Courier", FontWeight->"Bold"], ", it is used in symbolic trace calculations (see below)." }], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[TextData[{ "\[FilledSmallCircle]\tThe function ", StyleBox["tr", FontFamily->"Courier", FontWeight->"Bold"], StyleBox["[x_]", FontFamily->"Courier"], " returns the trace of the (symbolic or explicit, square) matrix expression \ ", StyleBox["x", FontFamily->"Courier"], ". If ", StyleBox["x", FontFamily->"Courier"], " is a scalar, it is assumed to multiply the identity matrix, and thus ", StyleBox["tr[x]", FontFamily->"Courier"], " returns ", StyleBox["x*matDimension", FontFamily->"Courier"], ", where ", StyleBox["matDimension", FontFamily->"Courier"], " is a global variable to be assigned by the user. When ", StyleBox["tr", FontFamily->"Courier"], " acts on products of symbolic matrices, it can apply the cyclic property \ of trace (as well as the fact that ", StyleBox["tr[Transpose[x]]=tr[x]", FontFamily->"Courier"], "), to reduce its argument to a \"canonical\" form. It can thus be made to \ recognize that the trace of the matrix expression ", StyleBox["2", FontFamily->"Courier"], " ", StyleBox["A\[Wedge]B\[Wedge]C-C\[Wedge]A\[Wedge]B-At\[Wedge]Ct\[Wedge]Bt", FontFamily->"Courier"], " is identically zero (for 0-form matrices ", StyleBox["A,B,C", FontFamily->"Courier"], " with transposes ", StyleBox["At,Bt,Ct", FontFamily->"Courier"], " respectively)." }], "Text", ShowGroupOpenCloseIcon->True, TextAlignment->Left, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $DeclareMatrixForms[{0, A, At}, {0, B, Bt}, {0, C, Ct}]$], "Input"], Cell[BoxData[ $"OK"$], "Print"] }, Open ]], Cell[TextData[{ "The behavior of ", StyleBox["tr", FontFamily->"Courier", FontWeight->"Bold"], " is controlled by the value of the global variable ", StyleBox["traceOption", FontFamily->"Courier", FontWeight->"Bold"], ", as can be seen in the following examples:" }], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[BoxData[ RowBox[{ RowBox[{"testExpr", "=", RowBox[{"{", RowBox[{ "At", ",", $Ct\[Wedge]Bt$, ",", $At\[Wedge]Ct\[Wedge]Bt$, ",", $At\[Wedge]Ct\[Wedge]Bt\[Wedge]At$, ",", RowBox[{ RowBox[{ StyleBox["2", FontFamily->"Courier"], " ", StyleBox[$A\[Wedge]B\[Wedge]C$, FontFamily->"Courier"]}], StyleBox["-", FontFamily->"Courier"], StyleBox[$C\[Wedge]A\[Wedge]B$, FontFamily->"Courier"], StyleBox["-", FontFamily->"Courier"], StyleBox[$At\[Wedge]Ct\[Wedge]Bt$, FontFamily->"Courier"]}]}], "}"}]}], ";"}]], "Input"], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ StyleBox[$traceOption = 0$, FontColor->RGBColor[0, 0, 1]], StyleBox[";", FontColor->RGBColor[0, 0, 1]], RowBox[{"(*", RowBox[{ RowBox[{"*", StyleBox[" ", FontColor->RGBColor[0, 1, 0]], StyleBox["No", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["rules", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["applied", FontColor->RGBColor[0, 0, 1]]}], StyleBox[",", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox[$other\ than\ linearity\ and\ tr[At] = tr[A]$, FontColor->RGBColor[0, 0, 1]]}], " ", "**)"}], $tr/@testExpr$}]], "Input"], Cell[BoxData[ ${tr[A], tr[Ct\[Wedge]Bt], tr[At\[Wedge]Ct\[Wedge]Bt], tr[At\[Wedge]Ct\[Wedge]Bt\[Wedge]At], 2\ tr[A\[Wedge]B\[Wedge]C] - tr[At\[Wedge]Ct\[Wedge]Bt] - tr[C\[Wedge]A\[Wedge]B]}$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ StyleBox[$traceOption = 1$, FontColor->RGBColor[0, 0, 1]], ";", RowBox[{"(*", RowBox[{"*", " ", StyleBox[ RowBox[{"C", StyleBox["yclic", FontColor->RGBColor[0, 0, 1]]}]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["rule", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["also", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["applied", FontColor->RGBColor[0, 0, 1]]}], " ", "**)"}], $tr/@testExpr$}]], "Input"], Cell[BoxData[ ${tr[A], tr[Bt\[Wedge]Ct], tr[At\[Wedge]Ct\[Wedge]Bt], tr[At\[Wedge]At\[Wedge]Ct\[Wedge]Bt], tr[A\[Wedge]B\[Wedge]C] - tr[At\[Wedge]Ct\[Wedge]Bt]}$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ StyleBox[$traceOption = 2$, FontColor->RGBColor[0, 0, 1]], ";", RowBox[{"(*", RowBox[{"*", " ", StyleBox["Cyclic", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["and", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["Transpose", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["rules", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["applied", FontColor->RGBColor[0, 0, 1]]}], " ", "**)"}], $tr/@testExpr$}]], "Input"], Cell[BoxData[ ${tr[A], tr[B\[Wedge]C], tr[A\[Wedge]B\[Wedge]C], tr[A\[Wedge]A\[Wedge]B\[Wedge]C], 0}$], "Output"] }, Open ]], Cell[TextData[{ "Note that, for single matrices, ", StyleBox["tr[At]=tr[A]", FontFamily->"Courier"], " independently of ", StyleBox["traceOption. \n\t", FontFamily->"Courier"], StyleBox["Warning", FontWeight->"Bold", FontColor->RGBColor[1, 0, 0]], ": ", StyleBox["The default value of ", FontWeight->"Plain", FontSlant->"Plain"], StyleBox["traceOption", FontFamily->"Courier", FontWeight->"Plain", FontSlant->"Plain"], StyleBox[" is ", FontWeight->"Plain", FontSlant->"Plain"], StyleBox["2", FontFamily->"Courier", FontWeight->"Plain", FontSlant->"Plain"], StyleBox[", to allow maximum simplification of complicated ", FontWeight->"Plain", FontSlant->"Plain"], StyleBox["tr", FontFamily->"Courier", FontWeight->"Plain", FontSlant->"Plain"], StyleBox[" expressions. However,", FontWeight->"Plain", FontSlant->"Plain"], StyleBox[" ", FontWeight->"Plain", FontSlant->"Italic"], StyleBox["this value can sometimes lead to infinite loops", FontWeight->"Plain"], StyleBox[" if used together with a commutator rule like ", FontWeight->"Plain", FontSlant->"Plain"], StyleBox["S0[1]\[Wedge]S0[3]->S0[3]\[Wedge]S0[1]+2I", FontFamily->"Courier"], " ", StyleBox["S0[2]", FontFamily->"Courier"], " which reverses the canonical (alphabetical) order of matrix products." }], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[TextData[{ StyleBox["tr", FontFamily->"Courier", FontWeight->"Bold"], " applies other rules also; for example, since ", StyleBox["S", FontFamily->"Courier"], " is a symmetric 0-form matrix and ", StyleBox["U", FontFamily->"Courier"], " antisymmetric, " }], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ RowBox[{"tr", "/@", RowBox[{"{", RowBox[{ RowBox[{"S", "\[Wedge]", StyleBox["U", FontFamily->"Courier"]}], ",", RowBox[{"S", "\[Wedge]", StyleBox["U", FontFamily->"Courier"], "\[Wedge]", "S", "\[Wedge]", "S"}]}], "}"}]}], " "}]], "Input"], Cell[BoxData[ ${0, 0}$], "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[" (iii) toComponents", "Subsubsection", ShowGroupOpenCloseIcon->True, FontSize->16], Cell[TextData[{ "The function ", StyleBox["toComponents", FontFamily->"Courier", FontWeight->"Bold"], StyleBox["[x_,rule_List]", FontFamily->"Courier"], " takes a symbolic matrix expression (", StyleBox["x", FontFamily->"Courier"], ") and a list of rules (", StyleBox["rule", FontFamily->"Courier"], ") and returns the explicit form (list of lists) of the symbolic matrix \ expression, introducing the identity matrix where needed. The explicit form \ of all basic symbolic matrices in ", StyleBox["x", FontFamily->"Courier"], " must be given as a set of replacement rules in the list ", StyleBox["rule", FontFamily->"Courier"], " and must satisfy the assumed matrix symmetries. If ", StyleBox["x", FontFamily->"Courier"], " is a scalar, ", StyleBox["toComponents", FontFamily->"Courier"], " returns ", StyleBox["x*IdentityMatrix[matDimension]", FontFamily->"Courier"], ".\n", StyleBox["Note", FontWeight->"Bold"], " : If the components of a p-form matrix are ", StyleBox["undefined", FontSlant->"Italic"], " scalar p-forms, ", StyleBox["DeclareForms", FontFamily->"Courier"], " must be used to introduce them. For example, if ", StyleBox["rule", FontFamily->"Courier"], " gives the components of ", StyleBox["U", FontFamily->"Courier"], " (which has been declared an antisymmetric 1-form matrix) in terms of the \ ", StyleBox["undefined", FontSlant->"Italic"], " scalar 1-forms ", StyleBox["u1,", FontFamily->"Courier"], " ", StyleBox["u2,", FontFamily->"Courier"], " ", StyleBox["u3,", FontFamily->"Courier"], " one must evaluate ", StyleBox["DeclareForms[1,u1,u2,u3]", FontFamily->"Courier"], " before using ", StyleBox["toComponents", FontFamily->"Courier"], "." }], "Text", ShowGroupOpenCloseIcon->True, TextAlignment->Left, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{$matDimension = 3$, ";", "\n", RowBox[{"matCompRules", "=", RowBox[{"{", RowBox[{ $A -> Array[aa, {3, 3}]$, ",", $At -> Transpose[Array[aa, {3, 3}]]$, ",", $S -> Array[ss, {3, 3}]$, ",", RowBox[{ StyleBox["U", FontFamily->"Courier"], "->", $Array[ucomp, {3, 3}]$}]}], "}"}]}]}]], "Input"], Cell[BoxData[ ${A \[Rule] {{aa[1, 1], aa[1, 2], aa[1, 3]}, {aa[2, 1], aa[2, 2], aa[2, 3]}, {aa[3, 1], aa[3, 2], aa[3, 3]}}, At \[Rule] {{aa[1, 1], aa[2, 1], aa[3, 1]}, {aa[1, 2], aa[2, 2], aa[3, 2]}, {aa[1, 3], aa[2, 3], aa[3, 3]}}, S \[Rule] {{ss[1, 1], ss[1, 2], ss[1, 3]}, {ss[2, 1], ss[2, 2], ss[2, 3]}, {ss[3, 1], ss[3, 2], ss[3, 3]}}, U \[Rule] {{ucomp[1, 1], ucomp[1, 2], ucomp[1, 3]}, {ucomp[2, 1], ucomp[2, 2], ucomp[2, 3]}, {ucomp[3, 1], ucomp[3, 2], ucomp[3, 3]}}}$], "Output"] }, Open ]], Cell["\<\ The components must be made to satisfy the assumed matrix \ symmetries, and must be declared to have the appropriate differential form \ degree (if >0):\ \>", "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[BoxData[ $ss[i_, j_] := ss[j, i] /; i > j; \n ucomp[i_, j_] := Sum[Signature[{i, j, k}] uu[k], {k, 3}]$], "Input"], Cell[CellGroupData[{ Cell[BoxData[ $DeclareForms[1, uu[_]]$], "Input"], Cell[BoxData[ $"OK"$], "Print"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $matCompRules$], "Input"], Cell[BoxData[ ${A \[Rule] {{aa[1, 1], aa[1, 2], aa[1, 3]}, {aa[2, 1], aa[2, 2], aa[2, 3]}, {aa[3, 1], aa[3, 2], aa[3, 3]}}, At \[Rule] {{aa[1, 1], aa[2, 1], aa[3, 1]}, {aa[1, 2], aa[2, 2], aa[3, 2]}, {aa[1, 3], aa[2, 3], aa[3, 3]}}, S \[Rule] {{ss[1, 1], ss[1, 2], ss[1, 3]}, {ss[1, 2], ss[2, 2], ss[2, 3]}, {ss[1, 3], ss[2, 3], ss[3, 3]}}, U \[Rule] {{0, uu[3], \(-uu[2]$}, {$-uu[3]$, 0, uu[1]}, {uu[2], $-uu[1]$, 0}}}\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"MatrixForm", "[", RowBox[{"toComponents", "[", RowBox[{ RowBox[{"S", "\[Wedge]", StyleBox["U", FontFamily->"Courier"]}], ",", "matCompRules"}], "]"}], "]"}]], "Input"], Cell[BoxData[ TagBox[ RowBox[{"(", GridBox[{ {$ss[1, 3]\ uu[2] - ss[1, 2]\ uu[3]$, $\(-ss[1, 3]$\ uu[1] + ss[1, 1]\ uu[3]\), $ss[1, 2]\ uu[1] - ss[1, 1]\ uu[2]$}, {$ss[2, 3]\ uu[2] - ss[2, 2]\ uu[3]$, $\(-ss[2, 3]$\ uu[1] + ss[1, 2]\ uu[3]\), $ss[2, 2]\ uu[1] - ss[1, 2]\ uu[2]$}, {$ss[3, 3]\ uu[2] - ss[2, 3]\ uu[3]$, $\(-ss[3, 3]$\ uu[1] + ss[1, 3]\ uu[3]\), $ss[2, 3]\ uu[1] - ss[1, 3]\ uu[2]$} }], ")"}], (MatrixForm[ #]&)]], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $tr[%]$], "Input"], Cell[BoxData[ $0$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $FormDegree[%%]$], "Input"], Cell[BoxData[ $1$], "Output"] }, Open ]], Cell[TextData[{ StyleBox["toComponents", FontFamily->"Courier", FontWeight->"Bold"], " understands that, in the expression ", StyleBox["A", FontFamily->"Courier"], " ", StyleBox["+", FontFamily->"Courier"], " ", StyleBox["lamda", FontFamily->"Courier"], ", the scalar ", StyleBox["lamda", FontFamily->"Courier"], " multiplies the identity matrix:" }], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $MatrixForm[toComponents[A\ + \ lamda, matCompRules]]$], "Input"], Cell[BoxData[ TagBox[ RowBox[{"(", GridBox[{ {$lamda + aa[1, 1]$, $aa[1, 2]$, $aa[1, 3]$}, {$aa[2, 1]$, $lamda + aa[2, 2]$, $aa[2, 3]$}, {$aa[3, 1]$, $aa[3, 2]$, $lamda + aa[3, 3]$} }], ")"}], (MatrixForm[ #]&)]], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $tr[%]$], "Input"], Cell[BoxData[ $3\ lamda + aa[1, 1] + aa[2, 2] + aa[3, 3]$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $\((A\ + \ lamda)$\[Wedge]Transpose[A\ + \ lamda]\)], "Input"], Cell[BoxData[ $A\ lamda + At\ lamda + lamda\^2 + A\[Wedge]At$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $tr[%]$], "Input"], Cell[BoxData[ $3\ lamda\^2 + 2\ lamda\ tr[A] + tr[A\[Wedge]At]$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $MatrixForm[toComponents[%%, matCompRules]]$], "Input"], Cell[BoxData[ TagBox[ RowBox[{"(", GridBox[{ {$lamda\^2 + 2\ lamda\ aa[1, 1] + aa[1, 1]\^2 + aa[1, 2]\^2 + aa[1, 3]\^2$, $lamda\ aa[1, 2] + lamda\ aa[2, 1] + aa[1, 1]\ aa[2, 1] + aa[1, 2]\ aa[2, 2] + aa[1, 3]\ aa[2, 3]$, $lamda\ aa[1, 3] + lamda\ aa[3, 1] + aa[1, 1]\ aa[3, 1] + aa[1, 2]\ aa[3, 2] + aa[1, 3]\ aa[3, 3]$}, {$lamda\ aa[1, 2] + lamda\ aa[2, 1] + aa[1, 1]\ aa[2, 1] + aa[1, 2]\ aa[2, 2] + aa[1, 3]\ aa[2, 3]$, $lamda\^2 + aa[2, 1]\^2 + 2\ lamda\ aa[2, 2] + aa[2, 2]\^2 + aa[2, 3]\^2$, $lamda\ aa[2, 3] + aa[2, 1]\ aa[3, 1] + lamda\ aa[3, 2] + aa[2, 2]\ aa[3, 2] + aa[2, 3]\ aa[3, 3]$}, {$lamda\ aa[1, 3] + lamda\ aa[3, 1] + aa[1, 1]\ aa[3, 1] + aa[1, 2]\ aa[3, 2] + aa[1, 3]\ aa[3, 3]$, $lamda\ aa[2, 3] + aa[2, 1]\ aa[3, 1] + lamda\ aa[3, 2] + aa[2, 2]\ aa[3, 2] + aa[2, 3]\ aa[3, 3]$, $lamda\^2 + aa[3, 1]\^2 + aa[3, 2]\^2 + 2\ lamda\ aa[3, 3] + aa[3, 3]\^2$} }], ")"}], (MatrixForm[ #]&)]], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $SymQ[%]$], "Input"], Cell[BoxData[ $True$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $tr[%%]$], "Input"], Cell[BoxData[ $3\ lamda\^2 + 2\ lamda\ aa[1, 1] + aa[1, 1]\^2 + aa[1, 2]\^2 + aa[1, 3]\^2 + aa[2, 1]\^2 + 2\ lamda\ aa[2, 2] + aa[2, 2]\^2 + aa[2, 3]\^2 + aa[3, 1]\^2 + aa[3, 2]\^2 + 2\ lamda\ aa[3, 3] + aa[3, 3]\^2$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $Collect[%, lamda, Factor]$], "Input"], Cell[BoxData[ $3\ lamda\^2 + aa[1, 1]\^2 + aa[1, 2]\^2 + aa[1, 3]\^2 + aa[2, 1]\^2 + aa[2, 2]\^2 + aa[2, 3]\^2 + aa[3, 1]\^2 + aa[3, 2]\^2 + aa[3, 3]\^2 + 2\ lamda\ \((aa[1, 1] + aa[2, 2] + aa[3, 3])$\)], "Output"] }, Open ]], Cell[BoxData[ $matDimension =. $], "Input"] }, Closed]], Cell[CellGroupData[{ Cell[" (iv) CHrule, detTOtr", "Subsubsection", ShowGroupOpenCloseIcon->True, FontSize->16], Cell[TextData[{ "\[FilledSmallCircle]\tThe function ", StyleBox["CHrule", FontFamily->"Courier", FontWeight->"Bold"], StyleBox["[n_Integer, mat_:$]", FontFamily->"Courier"], " returns a rule for implementing the Cayley-Hamilton theorem for the \ 0-form symbolic matrix ", StyleBox["mat", FontFamily->"Courier"], " with ", StyleBox["matDimension=n", FontFamily->"Courier"], ". The second argument is optional; if it is missing ", StyleBox["CHrule", FontFamily->"Courier"], " returns a delayed rule that can be applied to any ", StyleBox["n", FontFamily->"Courier"], " x ", StyleBox["n", FontFamily->"Courier"], " 0-form matrix, using the symbol ", StyleBox["$", FontFamily->"Courier"], " which is defined in EDC as a 0-form symbolic matrix. \n", StyleBox["Note", FontColor->RGBColor[1, 0, 0]], ": After calling ", StyleBox["CHrule[n]", FontFamily->"Courier"], ", ", StyleBox["matDimension", FontFamily->"Courier"], " is set to ", StyleBox["n", FontFamily->"Courier"], ". " }], "Text", ShowGroupOpenCloseIcon->True, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $CHrule[3, A]$], "Input"], Cell[BoxData[ ${A\[Wedge]A\[Wedge]A \[Rule] tr[A]\^3\/6 + A\ \((\(-\(1\/2$\)\ tr[A]\^2 + 1\/2\ tr[A\[Wedge]A])\) - 1\/2\ tr[A]\ tr[A\[Wedge]A] + 1\/3\ tr[A\[Wedge]A\[Wedge]A] + tr[A]\ A\[Wedge]A}\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $matDimension$], "Input"], Cell[BoxData[ $3$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $CH3 = CHrule[3]$], "Input"], Cell[BoxData[ ${HoldPattern[$_\[Wedge]$_\[Wedge]$_] \[RuleDelayed] tr[$]\^3\/6 + $\ \((\(-\(1\/2$\)\ tr[$]\^2 + 1\/2\ tr[$\[Wedge]$]) \) - 1\/2\ tr[$]\ tr[$\[Wedge]$] + 1\/3\ tr[$\[Wedge]$\[Wedge]$] + tr[$]\ $\[Wedge]$ /; MatQ[$] && FormDegree[$] === 0 && matDimension === 3}\)], "Output"] }, Open ]], Cell[TextData[{ StyleBox["The rule applies only when ", FontWeight->"Plain"], StyleBox["$", FontFamily->"Courier", FontWeight->"Plain"], StyleBox[" is a 0-form matrix expression. It is applied for products of \ matrices also:", FontWeight->"Plain"] }], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $reWrite[A\[Wedge]B\[Wedge]A\[Wedge]B\[Wedge]A\[Wedge]B\[Wedge]A /. CH3] $], "Input"], Cell[BoxData[ $A\ \(( 1\/6\ tr[A\[Wedge]B]\^3 - 1\/2\ tr[A\[Wedge]B]\ tr[A\[Wedge]B\[Wedge]A\[Wedge]B] + 1\/3\ tr[A\[Wedge]B\[Wedge]A\[Wedge]B\[Wedge]A\[Wedge]B])$ + $(\(-\(1\/2$\)\ tr[A\[Wedge]B]\^2 + 1\/2\ tr[A\[Wedge]B\[Wedge]A\[Wedge]B])\)\ A\[Wedge]B\[Wedge]A + tr[A\[Wedge]B]\ A\[Wedge]B\[Wedge]A\[Wedge]B\[Wedge]A\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $CH4 = CHrule[4]$], "Input"], Cell[BoxData[ ${HoldPattern[$_\[Wedge]$_\[Wedge]$_\[Wedge]$_] \[RuleDelayed] \(-\(1\/24$\)\ tr[$]\^4 + 1\/4\ tr[$]\^2\ tr[$\[Wedge]$] - 1\/8\ tr[$\[Wedge]$]\^2 + $\ $( tr[$]\^3\/6 - 1\/2\ tr[$]\ tr[$\[Wedge]$] + 1\/3\ tr[$\[Wedge]$\[Wedge]$])$ - 1\/3\ tr[$]\ tr[$\[Wedge]$\[Wedge]$] + 1\/4\ tr[$\[Wedge]$\[Wedge]$\[Wedge]$] + $(\(-\(1\/2$\)\ tr[$]\^2 + 1\/2\ tr[$\[Wedge]$])\)\ $\[Wedge]$ + tr[$]\ $\[Wedge]$\[Wedge]$ /; MatQ[$] && FormDegree[$] === 0 && matDimension === 4}\)], "Output"] }, Open ]], Cell[TextData[{ "Now ", StyleBox["matDimension", FontFamily->"Courier"], " is set to 4, so ", StyleBox["CH3", FontFamily->"Courier"], " has no effect:" }], "Text", FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $reWrite[A\[Wedge]B\[Wedge]A\[Wedge]B\[Wedge]A\[Wedge]B\[Wedge]A /. CH3] $], "Input"], Cell[BoxData[ $A\[Wedge]B\[Wedge]A\[Wedge]B\[Wedge]A\[Wedge]B\[Wedge]A$], "Output"] }, Open ]], Cell[TextData[{ StyleBox["For antisymmetric matrices the trace function (", FontWeight->"Plain"], StyleBox["tr", FontWeight->"Bold"], StyleBox[") gives 0 for odd powers, simplifying the expression:", FontWeight->"Plain"] }], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $DeclareMatrixForms[{0, H, \(-H$}]\)], "Input"], Cell[BoxData[ $"OK"$], "Print"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $CHrule[4, H]$], "Input"], Cell[BoxData[ ${H\[Wedge]H\[Wedge]H\[Wedge]H \[Rule] \(-\(1\/8$\)\ tr[H\[Wedge]H]\^2 + 1\/4\ tr[H\[Wedge]H\[Wedge]H\[Wedge]H] + 1\/2\ tr[H\[Wedge]H]\ H\[Wedge]H}\)], "Output"] }, Open ]], Cell[TextData[StyleBox["The same result is obtained using the general rule \ CH4:", FontWeight->"Plain"]], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $%[\([1, 1]$] /. CH4\)], "Input"], Cell[BoxData[ $\(-\(1\/8$\)\ tr[H\[Wedge]H]\^2 + 1\/4\ tr[H\[Wedge]H\[Wedge]H\[Wedge]H] + 1\/2\ tr[H\[Wedge]H]\ H\[Wedge]H\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[TextData[{ StyleBox["\t", FontWeight->"Bold"], StyleBox["Warning", FontWeight->"Bold", FontColor->RGBColor[1, 0, 0]], StyleBox[" ", FontWeight->"Bold"], ": ", StyleBox["The rules returned by ", FontWeight->"Plain"], StyleBox["CHrule", FontFamily->"Courier", FontWeight->"Plain"], StyleBox[" must never be applied repeatedly (", FontWeight->"Plain"], StyleBox["//.", FontFamily->"Courier", FontWeight->"Plain"], StyleBox["), as there is a term on the rhs that matches the lhs (", FontWeight->"Plain"], StyleBox["tr[lhs]", FontFamily->"Courier", FontWeight->"Plain"], StyleBox["), To apply these rules repeatedly, one must use another symbol, \ say ", FontWeight->"Plain"], StyleBox["trnA", FontFamily->"Courier", FontWeight->"Plain"], StyleBox[", for the trace of the product of n A matrices.", FontWeight->"Plain"] }], "Text", ShowGroupOpenCloseIcon->True, TextAlignment->Left, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $TimeConstrained[A\[Wedge]A\[Wedge]A //. CHrule[3, A], 2]$], "Input"], Cell[BoxData[ $$Aborted$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $Timing[ A\[Wedge]A\[Wedge]A //. \((CHrule[3, A] /. tr[A\[Wedge]A\[Wedge]A] -> tr3A)$]\)], "Input"], Cell[BoxData[ ${0.0333333333333349912`\ Second, tr3A\/3 + tr[A]\^3\/6 + A\ \((\(-\(1\/2$\)\ tr[A]\^2 + 1\/2\ tr[A\[Wedge]A])\) - 1\/2\ tr[A]\ tr[A\[Wedge]A] + tr[A]\ A\[Wedge]A}\)], "Output"] }, Open ]] }, Closed]], Cell[TextData[{ "\[FilledSmallCircle]\tThe function ", StyleBox["detTOtr", FontFamily->"Courier", FontWeight->"Bold"], StyleBox["[n_Integer, mat_:$]", FontFamily->"Courier"], " uses ", StyleBox["CHrule", FontWeight->"Bold"], " to express the determinant of the 0-form symbolic matrix ", StyleBox["mat", FontFamily->"Courier"], " with ", StyleBox["matDimension=n", FontFamily->"Courier"], ", as an n-th order polynomial in the traces of ", StyleBox["mat", FontFamily->"Courier"], ". When the second argument is omitted, the symbol ", StyleBox["$", FontFamily->"Courier"], " is used for the matrix. Examples:" }], "Text", ShowGroupOpenCloseIcon->True, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $detTOtr[2]$], "Input"], Cell[BoxData[ $tr[$]\^2\/2 - 1\/2\ tr[$\[Wedge]$]$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $detTOtr[3, A]$], "Input"], Cell[BoxData[ $tr[A]\^3\/6 - 1\/2\ tr[A]\ tr[A\[Wedge]A] + 1\/3\ tr[A\[Wedge]A\[Wedge]A]$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $detTOtr[4, B]$], "Input"], Cell[BoxData[ $tr[B]\^4\/24 - 1\/4\ tr[B]\^2\ tr[B\[Wedge]B] + 1\/8\ tr[B\[Wedge]B]\^2 + 1\/3\ tr[B]\ tr[B\[Wedge]B\[Wedge]B] - 1\/4\ tr[B\[Wedge]B\[Wedge]B\[Wedge]B]$], "Output"] }, Open ]], Cell[TextData[{ StyleBox["Using explicit matrices, one can check that ", FontWeight->"Plain"], StyleBox["detTOtr", FontWeight->"Bold"], StyleBox[" gives the correct result:", FontWeight->"Plain"] }], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[BoxData[ $detTOtrTEST[n_] := \((nxnMat = Array[mij, {n, n}]; Factor[detTOtr[n] /. $ \[Rule] nxnMat] === Factor[Det[nxnMat]])$\)], "Input"], Cell[CellGroupData[{ Cell[BoxData[ $detTOtrTEST/@{2, 3, 4, 5}$], "Input"], Cell[BoxData[ ${True, True, True, True}$], "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[" (v) subMatTK, subMatDR", "Subsubsection", ShowGroupOpenCloseIcon->True, FontSize->16], Cell[TextData[{ "\tThe functions ", StyleBox["subMatTK", FontFamily->"Courier", FontWeight->"Bold"], StyleBox["[x_, rr_, cc_]", FontFamily->"Courier"], " and ", StyleBox["subMatDR", FontFamily->"Courier", FontWeight->"Bold"], StyleBox["[x_, rr_, cc_]", FontFamily->"Courier"], " return the sub-matrices that are obtained by Taking (TK) or Dropping (DR) \ the rows indicated by ", StyleBox["rr", FontFamily->"Courier"], " and the columns indicated by ", StyleBox["cc", FontFamily->"Courier"], " of the matrix ", StyleBox["x", FontFamily->"Courier"], ". The parameters ", StyleBox["rr", FontFamily->"Courier"], " and ", StyleBox["cc", FontFamily->"Courier"], " have the same form as in the corresponding ", StyleBox["Mathematica", FontSlant->"Italic"], " commands (Take, Drop): either a list of two integers ", StyleBox["{n1, n2}", FontFamily->"Courier"], " indicating the range ", StyleBox["{n1...n2}", FontFamily->"Courier"], " of rows (columns), or a single integer ", StyleBox["n", FontFamily->"Courier"], " which is interpreted as ", StyleBox["{1, n}", FontFamily->"Courier"], ". For example, let mat67 be a 6x7 matrix:" }], "Text", Evaluatable->False, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $mat67 = Array[mm, {6, 7}]$], "Input"], Cell[BoxData[ ${{mm[1, 1], mm[1, 2], mm[1, 3], mm[1, 4], mm[1, 5], mm[1, 6], mm[1, 7]}, {mm[2, 1], mm[2, 2], mm[2, 3], mm[2, 4], mm[2, 5], mm[2, 6], mm[2, 7]}, {mm[3, 1], mm[3, 2], mm[3, 3], mm[3, 4], mm[3, 5], mm[3, 6], mm[3, 7]}, {mm[4, 1], mm[4, 2], mm[4, 3], mm[4, 4], mm[4, 5], mm[4, 6], mm[4, 7]}, {mm[5, 1], mm[5, 2], mm[5, 3], mm[5, 4], mm[5, 5], mm[5, 6], mm[5, 7]}, {mm[6, 1], mm[6, 2], mm[6, 3], mm[6, 4], mm[6, 5], mm[6, 6], mm[6, 7]}}$], "Output"] }, Open ]], Cell[TextData[StyleBox["The following matrix consists of the entries in rows \ (2,3,4) and columns (6,7) of mat67:", FontWeight->"Plain"]], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $subMatTK[mat67, {2, 4}, {6, 7}]$], "Input"], Cell[BoxData[ ${{mm[2, 6], mm[2, 7]}, {mm[3, 6], mm[3, 7]}, {mm[4, 6], mm[4, 7]}}$], "Output"] }, Open ]], Cell[TextData[StyleBox["The following matrix consists of the entries in rows \ (1,5,6) and columns (1,2,3,4,5) of mat67:", FontWeight->"Plain"]], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $subMatDR[mat67, {2, 4}, {6, 7}]$], "Input"], Cell[BoxData[ ${{mm[1, 1], mm[1, 2], mm[1, 3], mm[1, 4], mm[1, 5]}, {mm[5, 1], mm[5, 2], mm[5, 3], mm[5, 4], mm[5, 5]}, {mm[6, 1], mm[6, 2], mm[6, 3], mm[6, 4], mm[6, 5]}}$], "Output"] }, Open ]], Cell[TextData[StyleBox[ "Similarly, taking or dropping the first 3 rows and columns (5,6) of mat67:", FontWeight->"Plain"]], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $subMatTK[mat67, 3, {5, 6}]$], "Input"], Cell[BoxData[ ${{mm[1, 5], mm[1, 6]}, {mm[2, 5], mm[2, 6]}, {mm[3, 5], mm[3, 6]}}$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $subMatDR[mat67, 3, {5, 6}]$], "Input"], Cell[BoxData[ ${{mm[4, 1], mm[4, 2], mm[4, 3], mm[4, 4], mm[4, 7]}, {mm[5, 1], mm[5, 2], mm[5, 3], mm[5, 4], mm[5, 7]}, {mm[6, 1], mm[6, 2], mm[6, 3], mm[6, 4], mm[6, 7]}}$], "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[" (vi) DirectSum, FlatOuter", "Subsubsection", ShowGroupOpenCloseIcon->True, FontSize->16], Cell["\tLet us define some explicit matrices:", "Text", Evaluatable->False, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $A22 = Array[a, {2, 2}]$], "Input"], Cell[BoxData[ ${{a[1, 1], a[1, 2]}, {a[2, 1], a[2, 2]}}$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $B33 = Array[b, {3, 3}]$], "Input"], Cell[BoxData[ ${{b[1, 1], b[1, 2], b[1, 3]}, {b[2, 1], b[2, 2], b[2, 3]}, {b[3, 1], b[3, 2], b[3, 3]}}$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $P32 = Array[p, {3, 2}]$], "Input"], Cell[BoxData[ ${{p[1, 1], p[1, 2]}, {p[2, 1], p[2, 2]}, {p[3, 1], p[3, 2]}}$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $Q23 = Array[q, {2, 3}]$], "Input"], Cell[BoxData[ ${{q[1, 1], q[1, 2], q[1, 3]}, {q[2, 1], q[2, 2], q[2, 3]}}$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $MatrixForm/@{A22, B33, P32, Q23}$], "Input"], Cell[BoxData[ RowBox[{"{", RowBox[{ TagBox[ RowBox[{"(", GridBox[{ {$a[1, 1]$, $a[1, 2]$}, {$a[2, 1]$, $a[2, 2]$} }], ")"}], (MatrixForm[ #]&)], ",", TagBox[ RowBox[{"(", GridBox[{ {$b[1, 1]$, $b[1, 2]$, $b[1, 3]$}, {$b[2, 1]$, $b[2, 2]$, $b[2, 3]$}, {$b[3, 1]$, $b[3, 2]$, $b[3, 3]$} }], ")"}], (MatrixForm[ #]&)], ",", TagBox[ RowBox[{"(", GridBox[{ {$p[1, 1]$, $p[1, 2]$}, {$p[2, 1]$, $p[2, 2]$}, {$p[3, 1]$, $p[3, 2]$} }], ")"}], (MatrixForm[ #]&)], ",", TagBox[ RowBox[{"(", GridBox[{ {$q[1, 1]$, $q[1, 2]$, $q[1, 3]$}, {$q[2, 1]$, $q[2, 2]$, $q[2, 3]$} }], ")"}], (MatrixForm[ #]&)]}], "}"}]], "Output"] }, Open ]], Cell[TextData[{ "\[FilledSmallCircle]\tThe function ", StyleBox["DirectSum", FontWeight->"Bold"], StyleBox["[x__]", FontFamily->"Courier"], " takes two or more explicit matrices of dimensions ", Cell[BoxData[ $r\_i$]], " x ", Cell[BoxData[ $c\_i$]], " and constructs their direct sum, a matrix with dimensions \ \[CapitalSigma] ", Cell[BoxData[ $r\_i$]], " x \[CapitalSigma] ", Cell[BoxData[ $c\_i$]], ", having the given matrices along the main diagonal and 0 everywhere \ else:" }], "Text", Evaluatable->False, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $MatrixForm[DirectSum[A22, B33, P32, Q23]]$], "Input"], Cell[BoxData[ TagBox[ RowBox[{"(", GridBox[{ {$a[1, 1]$, $a[1, 2]$, "0", "0", "0", "0", "0", "0", "0", "0"}, {$a[2, 1]$, $a[2, 2]$, "0", "0", "0", "0", "0", "0", "0", "0"}, {"0", "0", $b[1, 1]$, $b[1, 2]$, $b[1, 3]$, "0", "0", "0", "0", "0"}, {"0", "0", $b[2, 1]$, $b[2, 2]$, $b[2, 3]$, "0", "0", "0", "0", "0"}, {"0", "0", $b[3, 1]$, $b[3, 2]$, $b[3, 3]$, "0", "0", "0", "0", "0"}, {"0", "0", "0", "0", "0", $p[1, 1]$, $p[1, 2]$, "0", "0", "0"}, {"0", "0", "0", "0", "0", $p[2, 1]$, $p[2, 2]$, "0", "0", "0"}, {"0", "0", "0", "0", "0", $p[3, 1]$, $p[3, 2]$, "0", "0", "0"}, {"0", "0", "0", "0", "0", "0", "0", $q[1, 1]$, $q[1, 2]$, $q[1, 3]$}, {"0", "0", "0", "0", "0", "0", "0", $q[2, 1]$, $q[2, 2]$, $q[2, 3]$} }], ")"}], (MatrixForm[ #]&)]], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $Dimensions[%]$], "Input"], Cell[BoxData[ ${10, 10}$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $Plus@@\((Dimensions/@{A22, B33, P32, Q23})$\)], "Input"], Cell[BoxData[ ${10, 10}$], "Output"] }, Open ]], Cell[TextData[{ "\[FilledSmallCircle]\tThe function ", StyleBox["FlatOuter", FontWeight->"Bold"], StyleBox["[x__]", FontFamily->"Courier"], " takes two or more explicit matrices of dimensions r_i x c_i and \ constructs their outer product (KroneckerProduct), a matrix with dimensions \ \[CapitalPi] ", Cell[BoxData[ $r\_i$]], " x \[CapitalPi] ", Cell[BoxData[ $c\_i$]], " (", StyleBox["KroneckerProduct", FontFamily->"Courier", FontWeight->"Bold"], " is a built-in function in ", StyleBox["Mathematica", FontSlant->"Italic"], " 6 or later):" }], "Text", Evaluatable->False, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $MatrixForm[FlatOuter[A22, P32]]$], "Input"], Cell[BoxData[ TagBox[ RowBox[{"(", GridBox[{ {$a[1, 1]\ p[1, 1]$, $a[1, 1]\ p[1, 2]$, $a[1, 2]\ p[1, 1]$, $a[1, 2]\ p[1, 2]$}, {$a[1, 1]\ p[2, 1]$, $a[1, 1]\ p[2, 2]$, $a[1, 2]\ p[2, 1]$, $a[1, 2]\ p[2, 2]$}, {$a[1, 1]\ p[3, 1]$, $a[1, 1]\ p[3, 2]$, $a[1, 2]\ p[3, 1]$, $a[1, 2]\ p[3, 2]$}, {$a[2, 1]\ p[1, 1]$, $a[2, 1]\ p[1, 2]$, $a[2, 2]\ p[1, 1]$, $a[2, 2]\ p[1, 2]$}, {$a[2, 1]\ p[2, 1]$, $a[2, 1]\ p[2, 2]$, $a[2, 2]\ p[2, 1]$, $a[2, 2]\ p[2, 2]$}, {$a[2, 1]\ p[3, 1]$, $a[2, 1]\ p[3, 2]$, $a[2, 2]\ p[3, 1]$, $a[2, 2]\ p[3, 2]$} }], ")"}], (MatrixForm[ #]&)]], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $MatrixForm[FlatOuter[P32, A22]]$], "Input"], Cell[BoxData[ TagBox[ RowBox[{"(", GridBox[{ {$a[1, 1]\ p[1, 1]$, $a[1, 2]\ p[1, 1]$, $a[1, 1]\ p[1, 2]$, $a[1, 2]\ p[1, 2]$}, {$a[2, 1]\ p[1, 1]$, $a[2, 2]\ p[1, 1]$, $a[2, 1]\ p[1, 2]$, $a[2, 2]\ p[1, 2]$}, {$a[1, 1]\ p[2, 1]$, $a[1, 2]\ p[2, 1]$, $a[1, 1]\ p[2, 2]$, $a[1, 2]\ p[2, 2]$}, {$a[2, 1]\ p[2, 1]$, $a[2, 2]\ p[2, 1]$, $a[2, 1]\ p[2, 2]$, $a[2, 2]\ p[2, 2]$}, {$a[1, 1]\ p[3, 1]$, $a[1, 2]\ p[3, 1]$, $a[1, 1]\ p[3, 2]$, $a[1, 2]\ p[3, 2]$}, {$a[2, 1]\ p[3, 1]$, $a[2, 2]\ p[3, 1]$, $a[2, 1]\ p[3, 2]$, $a[2, 2]\ p[3, 2]$} }], ")"}], (MatrixForm[ #]&)]], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $MatrixForm[FlatOuter[P32, A22, Q23]]$], "Input"], Cell[BoxData[ TagBox[ RowBox[{"(", GridBox[{ {$a[1, 1]\ p[1, 1]\ q[1, 1]$, $a[1, 1]\ p[1, 1]\ q[1, 2]$, $a[1, 1]\ p[1, 1]\ q[1, 3]$, $a[1, 2]\ p[1, 1]\ q[1, 1]$, $a[1, 2]\ p[1, 1]\ q[1, 2]$, $a[1, 2]\ p[1, 1]\ q[1, 3]$, $a[1, 1]\ p[1, 2]\ q[1, 1]$, $a[1, 1]\ p[1, 2]\ q[1, 2]$, $a[1, 1]\ p[1, 2]\ q[1, 3]$, $a[1, 2]\ p[1, 2]\ q[1, 1]$, $a[1, 2]\ p[1, 2]\ q[1, 2]$, $a[1, 2]\ p[1, 2]\ q[1, 3]$}, {$a[1, 1]\ p[1, 1]\ q[2, 1]$, $a[1, 1]\ p[1, 1]\ q[2, 2]$, $a[1, 1]\ p[1, 1]\ q[2, 3]$, $a[1, 2]\ p[1, 1]\ q[2, 1]$, $a[1, 2]\ p[1, 1]\ q[2, 2]$, $a[1, 2]\ p[1, 1]\ q[2, 3]$, $a[1, 1]\ p[1, 2]\ q[2, 1]$, $a[1, 1]\ p[1, 2]\ q[2, 2]$, $a[1, 1]\ p[1, 2]\ q[2, 3]$, $a[1, 2]\ p[1, 2]\ q[2, 1]$, $a[1, 2]\ p[1, 2]\ q[2, 2]$, $a[1, 2]\ p[1, 2]\ q[2, 3]$}, {$a[2, 1]\ p[1, 1]\ q[1, 1]$, $a[2, 1]\ p[1, 1]\ q[1, 2]$, $a[2, 1]\ p[1, 1]\ q[1, 3]$, $a[2, 2]\ p[1, 1]\ q[1, 1]$, $a[2, 2]\ p[1, 1]\ q[1, 2]$, $a[2, 2]\ p[1, 1]\ q[1, 3]$, $a[2, 1]\ p[1, 2]\ q[1, 1]$, $a[2, 1]\ p[1, 2]\ q[1, 2]$, $a[2, 1]\ p[1, 2]\ q[1, 3]$, $a[2, 2]\ p[1, 2]\ q[1, 1]$, $a[2, 2]\ p[1, 2]\ q[1, 2]$, $a[2, 2]\ p[1, 2]\ q[1, 3]$}, {$a[2, 1]\ p[1, 1]\ q[2, 1]$, $a[2, 1]\ p[1, 1]\ q[2, 2]$, $a[2, 1]\ p[1, 1]\ q[2, 3]$, $a[2, 2]\ p[1, 1]\ q[2, 1]$, $a[2, 2]\ p[1, 1]\ q[2, 2]$, $a[2, 2]\ p[1, 1]\ q[2, 3]$, $a[2, 1]\ p[1, 2]\ q[2, 1]$, $a[2, 1]\ p[1, 2]\ q[2, 2]$, $a[2, 1]\ p[1, 2]\ q[2, 3]$, $a[2, 2]\ p[1, 2]\ q[2, 1]$, $a[2, 2]\ p[1, 2]\ q[2, 2]$, $a[2, 2]\ p[1, 2]\ q[2, 3]$}, {$a[1, 1]\ p[2, 1]\ q[1, 1]$, $a[1, 1]\ p[2, 1]\ q[1, 2]$, $a[1, 1]\ p[2, 1]\ q[1, 3]$, $a[1, 2]\ p[2, 1]\ q[1, 1]$, $a[1, 2]\ p[2, 1]\ q[1, 2]$, $a[1, 2]\ p[2, 1]\ q[1, 3]$, $a[1, 1]\ p[2, 2]\ q[1, 1]$, $a[1, 1]\ p[2, 2]\ q[1, 2]$, $a[1, 1]\ p[2, 2]\ q[1, 3]$, $a[1, 2]\ p[2, 2]\ q[1, 1]$, $a[1, 2]\ p[2, 2]\ q[1, 2]$, $a[1, 2]\ p[2, 2]\ q[1, 3]$}, {$a[1, 1]\ p[2, 1]\ q[2, 1]$, $a[1, 1]\ p[2, 1]\ q[2, 2]$, $a[1, 1]\ p[2, 1]\ q[2, 3]$, $a[1, 2]\ p[2, 1]\ q[2, 1]$, $a[1, 2]\ p[2, 1]\ q[2, 2]$, $a[1, 2]\ p[2, 1]\ q[2, 3]$, $a[1, 1]\ p[2, 2]\ q[2, 1]$, $a[1, 1]\ p[2, 2]\ q[2, 2]$, $a[1, 1]\ p[2, 2]\ q[2, 3]$, $a[1, 2]\ p[2, 2]\ q[2, 1]$, $a[1, 2]\ p[2, 2]\ q[2, 2]$, $a[1, 2]\ p[2, 2]\ q[2, 3]$}, {$a[2, 1]\ p[2, 1]\ q[1, 1]$, $a[2, 1]\ p[2, 1]\ q[1, 2]$, $a[2, 1]\ p[2, 1]\ q[1, 3]$, $a[2, 2]\ p[2, 1]\ q[1, 1]$, $a[2, 2]\ p[2, 1]\ q[1, 2]$, $a[2, 2]\ p[2, 1]\ q[1, 3]$, $a[2, 1]\ p[2, 2]\ q[1, 1]$, $a[2, 1]\ p[2, 2]\ q[1, 2]$, $a[2, 1]\ p[2, 2]\ q[1, 3]$, $a[2, 2]\ p[2, 2]\ q[1, 1]$, $a[2, 2]\ p[2, 2]\ q[1, 2]$, $a[2, 2]\ p[2, 2]\ q[1, 3]$}, {$a[2, 1]\ p[2, 1]\ q[2, 1]$, $a[2, 1]\ p[2, 1]\ q[2, 2]$, $a[2, 1]\ p[2, 1]\ q[2, 3]$, $a[2, 2]\ p[2, 1]\ q[2, 1]$, $a[2, 2]\ p[2, 1]\ q[2, 2]$, $a[2, 2]\ p[2, 1]\ q[2, 3]$, $a[2, 1]\ p[2, 2]\ q[2, 1]$, $a[2, 1]\ p[2, 2]\ q[2, 2]$, $a[2, 1]\ p[2, 2]\ q[2, 3]$, $a[2, 2]\ p[2, 2]\ q[2, 1]$, $a[2, 2]\ p[2, 2]\ q[2, 2]$, $a[2, 2]\ p[2, 2]\ q[2, 3]$}, {$a[1, 1]\ p[3, 1]\ q[1, 1]$, $a[1, 1]\ p[3, 1]\ q[1, 2]$, $a[1, 1]\ p[3, 1]\ q[1, 3]$, $a[1, 2]\ p[3, 1]\ q[1, 1]$, $a[1, 2]\ p[3, 1]\ q[1, 2]$, $a[1, 2]\ p[3, 1]\ q[1, 3]$, $a[1, 1]\ p[3, 2]\ q[1, 1]$, $a[1, 1]\ p[3, 2]\ q[1, 2]$, $a[1, 1]\ p[3, 2]\ q[1, 3]$, $a[1, 2]\ p[3, 2]\ q[1, 1]$, $a[1, 2]\ p[3, 2]\ q[1, 2]$, $a[1, 2]\ p[3, 2]\ q[1, 3]$}, {$a[1, 1]\ p[3, 1]\ q[2, 1]$, $a[1, 1]\ p[3, 1]\ q[2, 2]$, $a[1, 1]\ p[3, 1]\ q[2, 3]$, $a[1, 2]\ p[3, 1]\ q[2, 1]$, $a[1, 2]\ p[3, 1]\ q[2, 2]$, $a[1, 2]\ p[3, 1]\ q[2, 3]$, $a[1, 1]\ p[3, 2]\ q[2, 1]$, $a[1, 1]\ p[3, 2]\ q[2, 2]$, $a[1, 1]\ p[3, 2]\ q[2, 3]$, $a[1, 2]\ p[3, 2]\ q[2, 1]$, $a[1, 2]\ p[3, 2]\ q[2, 2]$, $a[1, 2]\ p[3, 2]\ q[2, 3]$}, {$a[2, 1]\ p[3, 1]\ q[1, 1]$, $a[2, 1]\ p[3, 1]\ q[1, 2]$, $a[2, 1]\ p[3, 1]\ q[1, 3]$, $a[2, 2]\ p[3, 1]\ q[1, 1]$, $a[2, 2]\ p[3, 1]\ q[1, 2]$, $a[2, 2]\ p[3, 1]\ q[1, 3]$, $a[2, 1]\ p[3, 2]\ q[1, 1]$, $a[2, 1]\ p[3, 2]\ q[1, 2]$, $a[2, 1]\ p[3, 2]\ q[1, 3]$, $a[2, 2]\ p[3, 2]\ q[1, 1]$, $a[2, 2]\ p[3, 2]\ q[1, 2]$, $a[2, 2]\ p[3, 2]\ q[1, 3]$}, {$a[2, 1]\ p[3, 1]\ q[2, 1]$, $a[2, 1]\ p[3, 1]\ q[2, 2]$, $a[2, 1]\ p[3, 1]\ q[2, 3]$, $a[2, 2]\ p[3, 1]\ q[2, 1]$, $a[2, 2]\ p[3, 1]\ q[2, 2]$, $a[2, 2]\ p[3, 1]\ q[2, 3]$, $a[2, 1]\ p[3, 2]\ q[2, 1]$, $a[2, 1]\ p[3, 2]\ q[2, 2]$, $a[2, 1]\ p[3, 2]\ q[2, 3]$, $a[2, 2]\ p[3, 2]\ q[2, 1]$, $a[2, 2]\ p[3, 2]\ q[2, 2]$, $a[2, 2]\ p[3, 2]\ q[2, 3]$} }], ")"}], (MatrixForm[ #]&)]], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $Dimensions[%]$], "Input"], Cell[BoxData[ ${12, 12}$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $Times@@\((Dimensions/@{P32, A22, Q23})$\)], "Input"], Cell[BoxData[ ${12, 12}$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $MatrixForm[FlatOuter[P32, Q23, A22]]$], "Input"], Cell[BoxData[ TagBox[ RowBox[{"(", GridBox[{ {$a[1, 1]\ p[1, 1]\ q[1, 1]$, $a[1, 2]\ p[1, 1]\ q[1, 1]$, $a[1, 1]\ p[1, 1]\ q[1, 2]$, $a[1, 2]\ p[1, 1]\ q[1, 2]$, $a[1, 1]\ p[1, 1]\ q[1, 3]$, $a[1, 2]\ p[1, 1]\ q[1, 3]$, $a[1, 1]\ p[1, 2]\ q[1, 1]$, $a[1, 2]\ p[1, 2]\ q[1, 1]$, $a[1, 1]\ p[1, 2]\ q[1, 2]$, $a[1, 2]\ p[1, 2]\ q[1, 2]$, $a[1, 1]\ p[1, 2]\ q[1, 3]$, $a[1, 2]\ p[1, 2]\ q[1, 3]$}, {$a[2, 1]\ p[1, 1]\ q[1, 1]$, $a[2, 2]\ p[1, 1]\ q[1, 1]$, $a[2, 1]\ p[1, 1]\ q[1, 2]$, $a[2, 2]\ p[1, 1]\ q[1, 2]$, $a[2, 1]\ p[1, 1]\ q[1, 3]$, $a[2, 2]\ p[1, 1]\ q[1, 3]$, $a[2, 1]\ p[1, 2]\ q[1, 1]$, $a[2, 2]\ p[1, 2]\ q[1, 1]$, $a[2, 1]\ p[1, 2]\ q[1, 2]$, $a[2, 2]\ p[1, 2]\ q[1, 2]$, $a[2, 1]\ p[1, 2]\ q[1, 3]$, $a[2, 2]\ p[1, 2]\ q[1, 3]$}, {$a[1, 1]\ p[1, 1]\ q[2, 1]$, $a[1, 2]\ p[1, 1]\ q[2, 1]$, $a[1, 1]\ p[1, 1]\ q[2, 2]$, $a[1, 2]\ p[1, 1]\ q[2, 2]$, $a[1, 1]\ p[1, 1]\ q[2, 3]$, $a[1, 2]\ p[1, 1]\ q[2, 3]$, $a[1, 1]\ p[1, 2]\ q[2, 1]$, $a[1, 2]\ p[1, 2]\ q[2, 1]$, $a[1, 1]\ p[1, 2]\ q[2, 2]$, $a[1, 2]\ p[1, 2]\ q[2, 2]$, $a[1, 1]\ p[1, 2]\ q[2, 3]$, $a[1, 2]\ p[1, 2]\ q[2, 3]$}, {$a[2, 1]\ p[1, 1]\ q[2, 1]$, $a[2, 2]\ p[1, 1]\ q[2, 1]$, $a[2, 1]\ p[1, 1]\ q[2, 2]$, $a[2, 2]\ p[1, 1]\ q[2, 2]$, $a[2, 1]\ p[1, 1]\ q[2, 3]$, $a[2, 2]\ p[1, 1]\ q[2, 3]$, $a[2, 1]\ p[1, 2]\ q[2, 1]$, $a[2, 2]\ p[1, 2]\ q[2, 1]$, $a[2, 1]\ p[1, 2]\ q[2, 2]$, $a[2, 2]\ p[1, 2]\ q[2, 2]$, $a[2, 1]\ p[1, 2]\ q[2, 3]$, $a[2, 2]\ p[1, 2]\ q[2, 3]$}, {$a[1, 1]\ p[2, 1]\ q[1, 1]$, $a[1, 2]\ p[2, 1]\ q[1, 1]$, $a[1, 1]\ p[2, 1]\ q[1, 2]$, $a[1, 2]\ p[2, 1]\ q[1, 2]$, $a[1, 1]\ p[2, 1]\ q[1, 3]$, $a[1, 2]\ p[2, 1]\ q[1, 3]$, $a[1, 1]\ p[2, 2]\ q[1, 1]$, $a[1, 2]\ p[2, 2]\ q[1, 1]$, $a[1, 1]\ p[2, 2]\ q[1, 2]$, $a[1, 2]\ p[2, 2]\ q[1, 2]$, $a[1, 1]\ p[2, 2]\ q[1, 3]$, $a[1, 2]\ p[2, 2]\ q[1, 3]$}, {$a[2, 1]\ p[2, 1]\ q[1, 1]$, $a[2, 2]\ p[2, 1]\ q[1, 1]$, $a[2, 1]\ p[2, 1]\ q[1, 2]$, $a[2, 2]\ p[2, 1]\ q[1, 2]$, $a[2, 1]\ p[2, 1]\ q[1, 3]$, $a[2, 2]\ p[2, 1]\ q[1, 3]$, $a[2, 1]\ p[2, 2]\ q[1, 1]$, $a[2, 2]\ p[2, 2]\ q[1, 1]$, $a[2, 1]\ p[2, 2]\ q[1, 2]$, $a[2, 2]\ p[2, 2]\ q[1, 2]$, $a[2, 1]\ p[2, 2]\ q[1, 3]$, $a[2, 2]\ p[2, 2]\ q[1, 3]$}, {$a[1, 1]\ p[2, 1]\ q[2, 1]$, $a[1, 2]\ p[2, 1]\ q[2, 1]$, $a[1, 1]\ p[2, 1]\ q[2, 2]$, $a[1, 2]\ p[2, 1]\ q[2, 2]$, $a[1, 1]\ p[2, 1]\ q[2, 3]$, $a[1, 2]\ p[2, 1]\ q[2, 3]$, $a[1, 1]\ p[2, 2]\ q[2, 1]$, $a[1, 2]\ p[2, 2]\ q[2, 1]$, $a[1, 1]\ p[2, 2]\ q[2, 2]$, $a[1, 2]\ p[2, 2]\ q[2, 2]$, $a[1, 1]\ p[2, 2]\ q[2, 3]$, $a[1, 2]\ p[2, 2]\ q[2, 3]$}, {$a[2, 1]\ p[2, 1]\ q[2, 1]$, $a[2, 2]\ p[2, 1]\ q[2, 1]$, $a[2, 1]\ p[2, 1]\ q[2, 2]$, $a[2, 2]\ p[2, 1]\ q[2, 2]$, $a[2, 1]\ p[2, 1]\ q[2, 3]$, $a[2, 2]\ p[2, 1]\ q[2, 3]$, $a[2, 1]\ p[2, 2]\ q[2, 1]$, $a[2, 2]\ p[2, 2]\ q[2, 1]$, $a[2, 1]\ p[2, 2]\ q[2, 2]$, $a[2, 2]\ p[2, 2]\ q[2, 2]$, $a[2, 1]\ p[2, 2]\ q[2, 3]$, $a[2, 2]\ p[2, 2]\ q[2, 3]$}, {$a[1, 1]\ p[3, 1]\ q[1, 1]$, $a[1, 2]\ p[3, 1]\ q[1, 1]$, $a[1, 1]\ p[3, 1]\ q[1, 2]$, $a[1, 2]\ p[3, 1]\ q[1, 2]$, $a[1, 1]\ p[3, 1]\ q[1, 3]$, $a[1, 2]\ p[3, 1]\ q[1, 3]$, $a[1, 1]\ p[3, 2]\ q[1, 1]$, $a[1, 2]\ p[3, 2]\ q[1, 1]$, $a[1, 1]\ p[3, 2]\ q[1, 2]$, $a[1, 2]\ p[3, 2]\ q[1, 2]$, $a[1, 1]\ p[3, 2]\ q[1, 3]$, $a[1, 2]\ p[3, 2]\ q[1, 3]$}, {$a[2, 1]\ p[3, 1]\ q[1, 1]$, $a[2, 2]\ p[3, 1]\ q[1, 1]$, $a[2, 1]\ p[3, 1]\ q[1, 2]$, $a[2, 2]\ p[3, 1]\ q[1, 2]$, $a[2, 1]\ p[3, 1]\ q[1, 3]$, $a[2, 2]\ p[3, 1]\ q[1, 3]$, $a[2, 1]\ p[3, 2]\ q[1, 1]$, $a[2, 2]\ p[3, 2]\ q[1, 1]$, $a[2, 1]\ p[3, 2]\ q[1, 2]$, $a[2, 2]\ p[3, 2]\ q[1, 2]$, $a[2, 1]\ p[3, 2]\ q[1, 3]$, $a[2, 2]\ p[3, 2]\ q[1, 3]$}, {$a[1, 1]\ p[3, 1]\ q[2, 1]$, $a[1, 2]\ p[3, 1]\ q[2, 1]$, $a[1, 1]\ p[3, 1]\ q[2, 2]$, $a[1, 2]\ p[3, 1]\ q[2, 2]$, $a[1, 1]\ p[3, 1]\ q[2, 3]$, $a[1, 2]\ p[3, 1]\ q[2, 3]$, $a[1, 1]\ p[3, 2]\ q[2, 1]$, $a[1, 2]\ p[3, 2]\ q[2, 1]$, $a[1, 1]\ p[3, 2]\ q[2, 2]$, $a[1, 2]\ p[3, 2]\ q[2, 2]$, $a[1, 1]\ p[3, 2]\ q[2, 3]$, $a[1, 2]\ p[3, 2]\ q[2, 3]$}, {$a[2, 1]\ p[3, 1]\ q[2, 1]$, $a[2, 2]\ p[3, 1]\ q[2, 1]$, $a[2, 1]\ p[3, 1]\ q[2, 2]$, $a[2, 2]\ p[3, 1]\ q[2, 2]$, $a[2, 1]\ p[3, 1]\ q[2, 3]$, $a[2, 2]\ p[3, 1]\ q[2, 3]$, $a[2, 1]\ p[3, 2]\ q[2, 1]$, $a[2, 2]\ p[3, 2]\ q[2, 1]$, $a[2, 1]\ p[3, 2]\ q[2, 2]$, $a[2, 2]\ p[3, 2]\ q[2, 2]$, $a[2, 1]\ p[3, 2]\ q[2, 3]$, $a[2, 2]\ p[3, 2]\ q[2, 3]$} }], ")"}], (MatrixForm[ #]&)]], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $FlatOuter[P32, Q23, A22] === FlatOuter[FlatOuter[P32, Q23], A22]$], "Input"], Cell[BoxData[ $True$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $FlatOuter[P32, Q23, A22] === FlatOuter[P32, FlatOuter[Q23, A22]]$], "Input"], Cell[BoxData[ $True$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $If[$VersionNumber > 5.5, FlatOuter[P32, A22, Q23] === KroneckerProduct[P32, A22, Q23]]$], "Input"], Cell[BoxData[ $True$], "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[" (vii) Contract, multiDot", "Subsubsection", ShowGroupOpenCloseIcon->True, FontSize->16], Cell["\<\ \tThese functions perform contractions on nested lists. It is \ convenient to think of an nth-level nested list as an nth-rank tensor. \ Contraction then produces lower rank tensors. For use in the examples we \ define the following rank-3 and rank-4 tensors in three dimensions:\ \>", \ "Text", Evaluatable->False, FontSize->16], Cell[BoxData[ $T3 = Array[t3, {3, 3, 3}]; \nT4 = Array[t4, {3, 3, 3, 3}]; $], "Input"], Cell[CellGroupData[{ Cell[TextData[{ "\[FilledSmallCircle]\tThe function ", StyleBox["Contract[x_,{i1,j1},{i2,j2},...]", FontFamily->"Courier", FontWeight->"Bold"], " takes as arguments an nth-rank tensor ", StyleBox["x", FontFamily->"Courier", FontWeight->"Bold"], ", and one or more lists of pairs of integers, indicating the positions of \ the indices to be contracted. It returns a tensor of rank ", StyleBox["n-2k", FontSlant->"Italic"], ", where ", StyleBox["k", FontSlant->"Italic"], " is the number of lists:" }], "Text", Evaluatable->False, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $Contract[T3, {1, 2}]$], "Input"], Cell[BoxData[ ${t3[1, 1, 1] + t3[2, 2, 1] + t3[3, 3, 1], t3[1, 1, 2] + t3[2, 2, 2] + t3[3, 3, 2], t3[1, 1, 3] + t3[2, 2, 3] + t3[3, 3, 3]}$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $Contract[T3, {1, 3}]$], "Input"], Cell[BoxData[ ${t3[1, 1, 1] + t3[2, 1, 2] + t3[3, 1, 3], t3[1, 2, 1] + t3[2, 2, 2] + t3[3, 2, 3], t3[1, 3, 1] + t3[2, 3, 2] + t3[3, 3, 3]}$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $Contract[T4, {1, 2}]$], "Input"], Cell[BoxData[ ${{t4[1, 1, 1, 1] + t4[2, 2, 1, 1] + t4[3, 3, 1, 1], t4[1, 1, 1, 2] + t4[2, 2, 1, 2] + t4[3, 3, 1, 2], t4[1, 1, 1, 3] + t4[2, 2, 1, 3] + t4[3, 3, 1, 3]}, { t4[1, 1, 2, 1] + t4[2, 2, 2, 1] + t4[3, 3, 2, 1], t4[1, 1, 2, 2] + t4[2, 2, 2, 2] + t4[3, 3, 2, 2], t4[1, 1, 2, 3] + t4[2, 2, 2, 3] + t4[3, 3, 2, 3]}, { t4[1, 1, 3, 1] + t4[2, 2, 3, 1] + t4[3, 3, 3, 1], t4[1, 1, 3, 2] + t4[2, 2, 3, 2] + t4[3, 3, 3, 2], t4[1, 1, 3, 3] + t4[2, 2, 3, 3] + t4[3, 3, 3, 3]}}$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $Contract[T4, {1, 2}, {3, 4}]$], "Input"], Cell[BoxData[ $t4[1, 1, 1, 1] + t4[1, 1, 2, 2] + t4[1, 1, 3, 3] + t4[2, 2, 1, 1] + t4[2, 2, 2, 2] + t4[2, 2, 3, 3] + t4[3, 3, 1, 1] + t4[3, 3, 2, 2] + t4[3, 3, 3, 3]$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $Contract[T4, {1, 4}, {2, 3}]$], "Input"], Cell[BoxData[ $t4[1, 1, 1, 1] + t4[1, 2, 2, 1] + t4[1, 3, 3, 1] + t4[2, 1, 1, 2] + t4[2, 2, 2, 2] + t4[2, 3, 3, 2] + t4[3, 1, 1, 3] + t4[3, 2, 2, 3] + t4[3, 3, 3, 3]$], "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ "\[FilledSmallCircle]\tThe function ", StyleBox["multiDot[x_,y_,{i1,j1},{i2,j2},...]", FontFamily->"Courier", FontWeight->"Bold"], " is similar to ", StyleBox["Contract", FontWeight->"Bold"], ", and generalizes the built-in function ", StyleBox["Dot", FontWeight->"Bold"], ". It takes as arguments two tensors -- ", StyleBox["x", FontFamily->"Courier", FontWeight->"Bold"], ", ", StyleBox["y", FontFamily->"Courier", FontWeight->"Bold"], " -- and one or more lists of pairs of integers. For each such pair {i, j}, \ it contracts the ", StyleBox["i", FontWeight->"Bold"], "th index of the first tensor (", StyleBox["x", FontFamily->"Courier", FontWeight->"Bold"], ") with the ", StyleBox["j", FontWeight->"Bold"], "th index of the second tensor (", StyleBox["y", FontFamily->"Courier", FontWeight->"Bold"], "), returning a tensor of rank ", StyleBox["m+n-2k", FontSlant->"Italic"], ", where ", StyleBox["m", FontSlant->"Italic"], ", ", StyleBox["n", FontSlant->"Italic"], " are the ranks of ", StyleBox["x", FontFamily->"Courier", FontWeight->"Bold"], ", ", StyleBox["y", FontFamily->"Courier", FontWeight->"Bold"], ", respectively, and ", StyleBox["k", FontSlant->"Italic"], " is the number of index pairs. (When the components of ", StyleBox["x", FontFamily->"Courier", FontWeight->"Bold"], " and ", StyleBox["y", FontFamily->"Courier", FontWeight->"Bold"], " are differential forms, ", StyleBox["multiDot", FontWeight->"Bold"], " multiplies them using ", StyleBox["Wedge", FontWeight->"Bold"], ")." }], "Text", Evaluatable->False, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $multiDot[T3, T3, {1, 1}]$], "Input"], Cell[BoxData[ \({{{{t3[1, 1, 1]\^2 + t3[2, 1, 1]\^2 + t3[3, 1, 1]\^2, t3[1, 1, 1]\ t3[1, 1, 2] + t3[2, 1, 1]\ t3[2, 1, 2] + t3[3, 1, 1]\ t3[3, 1, 2], t3[1, 1, 1]\ t3[1, 1, 3] + t3[2, 1, 1]\ t3[2, 1, 3] + t3[3, 1, 1]\ t3[3, 1, 3]}, { t3[1, 1, 1]\ t3[1, 2, 1] + t3[2, 1, 1]\ t3[2, 2, 1] + t3[3, 1, 1]\ t3[3, 2, 1], t3[1, 1, 1]\ t3[1, 2, 2] + t3[2, 1, 1]\ t3[2, 2, 2] + t3[3, 1, 1]\ t3[3, 2, 2], t3[1, 1, 1]\ t3[1, 2, 3] + t3[2, 1, 1]\ t3[2, 2, 3] + t3[3, 1, 1]\ t3[3, 2, 3]}, { t3[1, 1, 1]\ t3[1, 3, 1] + t3[2, 1, 1]\ t3[2, 3, 1] + t3[3, 1, 1]\ t3[3, 3, 1], t3[1, 1, 1]\ t3[1, 3, 2] + t3[2, 1, 1]\ t3[2, 3, 2] + t3[3, 1, 1]\ t3[3, 3, 2], t3[1, 1, 1]\ t3[1, 3, 3] + t3[2, 1, 1]\ t3[2, 3, 3] + t3[3, 1, 1]\ t3[3, 3, 3]}}, {{ t3[1, 1, 1]\ t3[1, 1, 2] + t3[2, 1, 1]\ t3[2, 1, 2] + t3[3, 1, 1]\ t3[3, 1, 2], t3[1, 1, 2]\^2 + t3[2, 1, 2]\^2 + t3[3, 1, 2]\^2, t3[1, 1, 2]\ t3[1, 1, 3] + t3[2, 1, 2]\ t3[2, 1, 3] + t3[3, 1, 2]\ t3[3, 1, 3]}, { t3[1, 1, 2]\ t3[1, 2, 1] + t3[2, 1, 2]\ t3[2, 2, 1] + t3[3, 1, 2]\ t3[3, 2, 1], t3[1, 1, 2]\ t3[1, 2, 2] + t3[2, 1, 2]\ t3[2, 2, 2] + t3[3, 1, 2]\ t3[3, 2, 2], t3[1, 1, 2]\ t3[1, 2, 3] + t3[2, 1, 2]\ t3[2, 2, 3] + t3[3, 1, 2]\ t3[3, 2, 3]}, { t3[1, 1, 2]\ t3[1, 3, 1] + t3[2, 1, 2]\ t3[2, 3, 1] + t3[3, 1, 2]\ t3[3, 3, 1], t3[1, 1, 2]\ t3[1, 3, 2] + t3[2, 1, 2]\ t3[2, 3, 2] + t3[3, 1, 2]\ t3[3, 3, 2], t3[1, 1, 2]\ t3[1, 3, 3] + t3[2, 1, 2]\ t3[2, 3, 3] + t3[3, 1, 2]\ t3[3, 3, 3]}}, {{ t3[1, 1, 1]\ t3[1, 1, 3] + t3[2, 1, 1]\ t3[2, 1, 3] + t3[3, 1, 1]\ t3[3, 1, 3], t3[1, 1, 2]\ t3[1, 1, 3] + t3[2, 1, 2]\ t3[2, 1, 3] + t3[3, 1, 2]\ t3[3, 1, 3], t3[1, 1, 3]\^2 + t3[2, 1, 3]\^2 + t3[3, 1, 3]\^2}, { t3[1, 1, 3]\ t3[1, 2, 1] + t3[2, 1, 3]\ t3[2, 2, 1] + t3[3, 1, 3]\ t3[3, 2, 1], t3[1, 1, 3]\ t3[1, 2, 2] + t3[2, 1, 3]\ t3[2, 2, 2] + t3[3, 1, 3]\ t3[3, 2, 2], t3[1, 1, 3]\ t3[1, 2, 3] + t3[2, 1, 3]\ t3[2, 2, 3] + t3[3, 1, 3]\ t3[3, 2, 3]}, { t3[1, 1, 3]\ t3[1, 3, 1] + t3[2, 1, 3]\ t3[2, 3, 1] + t3[3, 1, 3]\ t3[3, 3, 1], t3[1, 1, 3]\ t3[1, 3, 2] + t3[2, 1, 3]\ t3[2, 3, 2] + t3[3, 1, 3]\ t3[3, 3, 2], t3[1, 1, 3]\ t3[1, 3, 3] + t3[2, 1, 3]\ t3[2, 3, 3] + t3[3, 1, 3]\ t3[3, 3, 3]}}}, {{{ t3[1, 1, 1]\ t3[1, 2, 1] + t3[2, 1, 1]\ t3[2, 2, 1] + t3[3, 1, 1]\ t3[3, 2, 1], t3[1, 1, 2]\ t3[1, 2, 1] + t3[2, 1, 2]\ t3[2, 2, 1] + t3[3, 1, 2]\ t3[3, 2, 1], t3[1, 1, 3]\ t3[1, 2, 1] + t3[2, 1, 3]\ t3[2, 2, 1] + t3[3, 1, 3]\ t3[3, 2, 1]}, { t3[1, 2, 1]\^2 + t3[2, 2, 1]\^2 + t3[3, 2, 1]\^2, t3[1, 2, 1]\ t3[1, 2, 2] + t3[2, 2, 1]\ t3[2, 2, 2] + t3[3, 2, 1]\ t3[3, 2, 2], t3[1, 2, 1]\ t3[1, 2, 3] + t3[2, 2, 1]\ t3[2, 2, 3] + t3[3, 2, 1]\ t3[3, 2, 3]}, { t3[1, 2, 1]\ t3[1, 3, 1] + t3[2, 2, 1]\ t3[2, 3, 1] + t3[3, 2, 1]\ t3[3, 3, 1], t3[1, 2, 1]\ t3[1, 3, 2] + t3[2, 2, 1]\ t3[2, 3, 2] + t3[3, 2, 1]\ t3[3, 3, 2], t3[1, 2, 1]\ t3[1, 3, 3] + t3[2, 2, 1]\ t3[2, 3, 3] + t3[3, 2, 1]\ t3[3, 3, 3]}}, {{ t3[1, 1, 1]\ t3[1, 2, 2] + t3[2, 1, 1]\ t3[2, 2, 2] + t3[3, 1, 1]\ t3[3, 2, 2], t3[1, 1, 2]\ t3[1, 2, 2] + t3[2, 1, 2]\ t3[2, 2, 2] + t3[3, 1, 2]\ t3[3, 2, 2], t3[1, 1, 3]\ t3[1, 2, 2] + t3[2, 1, 3]\ t3[2, 2, 2] + t3[3, 1, 3]\ t3[3, 2, 2]}, { t3[1, 2, 1]\ t3[1, 2, 2] + t3[2, 2, 1]\ t3[2, 2, 2] + t3[3, 2, 1]\ t3[3, 2, 2], t3[1, 2, 2]\^2 + t3[2, 2, 2]\^2 + t3[3, 2, 2]\^2, t3[1, 2, 2]\ t3[1, 2, 3] + t3[2, 2, 2]\ t3[2, 2, 3] + t3[3, 2, 2]\ t3[3, 2, 3]}, { t3[1, 2, 2]\ t3[1, 3, 1] + t3[2, 2, 2]\ t3[2, 3, 1] + t3[3, 2, 2]\ t3[3, 3, 1], t3[1, 2, 2]\ t3[1, 3, 2] + t3[2, 2, 2]\ t3[2, 3, 2] + t3[3, 2, 2]\ t3[3, 3, 2], t3[1, 2, 2]\ t3[1, 3, 3] + t3[2, 2, 2]\ t3[2, 3, 3] + t3[3, 2, 2]\ t3[3, 3, 3]}}, {{ t3[1, 1, 1]\ t3[1, 2, 3] + t3[2, 1, 1]\ t3[2, 2, 3] + t3[3, 1, 1]\ t3[3, 2, 3], t3[1, 1, 2]\ t3[1, 2, 3] + t3[2, 1, 2]\ t3[2, 2, 3] + t3[3, 1, 2]\ t3[3, 2, 3], t3[1, 1, 3]\ t3[1, 2, 3] + t3[2, 1, 3]\ t3[2, 2, 3] + t3[3, 1, 3]\ t3[3, 2, 3]}, { t3[1, 2, 1]\ t3[1, 2, 3] + t3[2, 2, 1]\ t3[2, 2, 3] + t3[3, 2, 1]\ t3[3, 2, 3], t3[1, 2, 2]\ t3[1, 2, 3] + t3[2, 2, 2]\ t3[2, 2, 3] + t3[3, 2, 2]\ t3[3, 2, 3], t3[1, 2, 3]\^2 + t3[2, 2, 3]\^2 + t3[3, 2, 3]\^2}, { t3[1, 2, 3]\ t3[1, 3, 1] + t3[2, 2, 3]\ t3[2, 3, 1] + t3[3, 2, 3]\ t3[3, 3, 1], t3[1, 2, 3]\ t3[1, 3, 2] + t3[2, 2, 3]\ t3[2, 3, 2] + t3[3, 2, 3]\ t3[3, 3, 2], t3[1, 2, 3]\ t3[1, 3, 3] + t3[2, 2, 3]\ t3[2, 3, 3] + t3[3, 2, 3]\ t3[3, 3, 3]}}}, {{{ t3[1, 1, 1]\ t3[1, 3, 1] + t3[2, 1, 1]\ t3[2, 3, 1] + t3[3, 1, 1]\ t3[3, 3, 1], t3[1, 1, 2]\ t3[1, 3, 1] + t3[2, 1, 2]\ t3[2, 3, 1] + t3[3, 1, 2]\ t3[3, 3, 1], t3[1, 1, 3]\ t3[1, 3, 1] + t3[2, 1, 3]\ t3[2, 3, 1] + t3[3, 1, 3]\ t3[3, 3, 1]}, { t3[1, 2, 1]\ t3[1, 3, 1] + t3[2, 2, 1]\ t3[2, 3, 1] + t3[3, 2, 1]\ t3[3, 3, 1], t3[1, 2, 2]\ t3[1, 3, 1] + t3[2, 2, 2]\ t3[2, 3, 1] + t3[3, 2, 2]\ t3[3, 3, 1], t3[1, 2, 3]\ t3[1, 3, 1] + t3[2, 2, 3]\ t3[2, 3, 1] + t3[3, 2, 3]\ t3[3, 3, 1]}, { t3[1, 3, 1]\^2 + t3[2, 3, 1]\^2 + t3[3, 3, 1]\^2, t3[1, 3, 1]\ t3[1, 3, 2] + t3[2, 3, 1]\ t3[2, 3, 2] + t3[3, 3, 1]\ t3[3, 3, 2], t3[1, 3, 1]\ t3[1, 3, 3] + t3[2, 3, 1]\ t3[2, 3, 3] + t3[3, 3, 1]\ t3[3, 3, 3]}}, {{ t3[1, 1, 1]\ t3[1, 3, 2] + t3[2, 1, 1]\ t3[2, 3, 2] + t3[3, 1, 1]\ t3[3, 3, 2], t3[1, 1, 2]\ t3[1, 3, 2] + t3[2, 1, 2]\ t3[2, 3, 2] + t3[3, 1, 2]\ t3[3, 3, 2], t3[1, 1, 3]\ t3[1, 3, 2] + t3[2, 1, 3]\ t3[2, 3, 2] + t3[3, 1, 3]\ t3[3, 3, 2]}, { t3[1, 2, 1]\ t3[1, 3, 2] + t3[2, 2, 1]\ t3[2, 3, 2] + t3[3, 2, 1]\ t3[3, 3, 2], t3[1, 2, 2]\ t3[1, 3, 2] + t3[2, 2, 2]\ t3[2, 3, 2] + t3[3, 2, 2]\ t3[3, 3, 2], t3[1, 2, 3]\ t3[1, 3, 2] + t3[2, 2, 3]\ t3[2, 3, 2] + t3[3, 2, 3]\ t3[3, 3, 2]}, { t3[1, 3, 1]\ t3[1, 3, 2] + t3[2, 3, 1]\ t3[2, 3, 2] + t3[3, 3, 1]\ t3[3, 3, 2], t3[1, 3, 2]\^2 + t3[2, 3, 2]\^2 + t3[3, 3, 2]\^2, t3[1, 3, 2]\ t3[1, 3, 3] + t3[2, 3, 2]\ t3[2, 3, 3] + t3[3, 3, 2]\ t3[3, 3, 3]}}, {{ t3[1, 1, 1]\ t3[1, 3, 3] + t3[2, 1, 1]\ t3[2, 3, 3] + t3[3, 1, 1]\ t3[3, 3, 3], t3[1, 1, 2]\ t3[1, 3, 3] + t3[2, 1, 2]\ t3[2, 3, 3] + t3[3, 1, 2]\ t3[3, 3, 3], t3[1, 1, 3]\ t3[1, 3, 3] + t3[2, 1, 3]\ t3[2, 3, 3] + t3[3, 1, 3]\ t3[3, 3, 3]}, { t3[1, 2, 1]\ t3[1, 3, 3] + t3[2, 2, 1]\ t3[2, 3, 3] + t3[3, 2, 1]\ t3[3, 3, 3], t3[1, 2, 2]\ t3[1, 3, 3] + t3[2, 2, 2]\ t3[2, 3, 3] + t3[3, 2, 2]\ t3[3, 3, 3], t3[1, 2, 3]\ t3[1, 3, 3] + t3[2, 2, 3]\ t3[2, 3, 3] + t3[3, 2, 3]\ t3[3, 3, 3]}, { t3[1, 3, 1]\ t3[1, 3, 3] + t3[2, 3, 1]\ t3[2, 3, 3] + t3[3, 3, 1]\ t3[3, 3, 3], t3[1, 3, 2]\ t3[1, 3, 3] + t3[2, 3, 2]\ t3[2, 3, 3] + t3[3, 3, 2]\ t3[3, 3, 3], t3[1, 3, 3]\^2 + t3[2, 3, 3]\^2 + t3[3, 3, 3]\^2}}}}\)], "Output"] }, Closed]], Cell[CellGroupData[{ Cell[BoxData[ $Dimensions[%]$], "Input"], Cell[BoxData[ ${3, 3, 3, 3}$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $multiDot[T3, T3, {1, 1}, {2, 2}]$], "Input"], Cell[BoxData[ \({{t3[1, 1, 1]\^2 + t3[1, 2, 1]\^2 + t3[1, 3, 1]\^2 + t3[2, 1, 1]\^2 + t3[2, 2, 1]\^2 + t3[2, 3, 1]\^2 + t3[3, 1, 1]\^2 + t3[3, 2, 1]\^2 + t3[3, 3, 1]\^2, t3[1, 1, 1]\ t3[1, 1, 2] + t3[1, 2, 1]\ t3[1, 2, 2] + t3[1, 3, 1]\ t3[1, 3, 2] + t3[2, 1, 1]\ t3[2, 1, 2] + t3[2, 2, 1]\ t3[2, 2, 2] + t3[2, 3, 1]\ t3[2, 3, 2] + t3[3, 1, 1]\ t3[3, 1, 2] + t3[3, 2, 1]\ t3[3, 2, 2] + t3[3, 3, 1]\ t3[3, 3, 2], t3[1, 1, 1]\ t3[1, 1, 3] + t3[1, 2, 1]\ t3[1, 2, 3] + t3[1, 3, 1]\ t3[1, 3, 3] + t3[2, 1, 1]\ t3[2, 1, 3] + t3[2, 2, 1]\ t3[2, 2, 3] + t3[2, 3, 1]\ t3[2, 3, 3] + t3[3, 1, 1]\ t3[3, 1, 3] + t3[3, 2, 1]\ t3[3, 2, 3] + t3[3, 3, 1]\ t3[3, 3, 3]}, { t3[1, 1, 1]\ t3[1, 1, 2] + t3[1, 2, 1]\ t3[1, 2, 2] + t3[1, 3, 1]\ t3[1, 3, 2] + t3[2, 1, 1]\ t3[2, 1, 2] + t3[2, 2, 1]\ t3[2, 2, 2] + t3[2, 3, 1]\ t3[2, 3, 2] + t3[3, 1, 1]\ t3[3, 1, 2] + t3[3, 2, 1]\ t3[3, 2, 2] + t3[3, 3, 1]\ t3[3, 3, 2], t3[1, 1, 2]\^2 + t3[1, 2, 2]\^2 + t3[1, 3, 2]\^2 + t3[2, 1, 2]\^2 + t3[2, 2, 2]\^2 + t3[2, 3, 2]\^2 + t3[3, 1, 2]\^2 + t3[3, 2, 2]\^2 + t3[3, 3, 2]\^2, t3[1, 1, 2]\ t3[1, 1, 3] + t3[1, 2, 2]\ t3[1, 2, 3] + t3[1, 3, 2]\ t3[1, 3, 3] + t3[2, 1, 2]\ t3[2, 1, 3] + t3[2, 2, 2]\ t3[2, 2, 3] + t3[2, 3, 2]\ t3[2, 3, 3] + t3[3, 1, 2]\ t3[3, 1, 3] + t3[3, 2, 2]\ t3[3, 2, 3] + t3[3, 3, 2]\ t3[3, 3, 3]}, { t3[1, 1, 1]\ t3[1, 1, 3] + t3[1, 2, 1]\ t3[1, 2, 3] + t3[1, 3, 1]\ t3[1, 3, 3] + t3[2, 1, 1]\ t3[2, 1, 3] + t3[2, 2, 1]\ t3[2, 2, 3] + t3[2, 3, 1]\ t3[2, 3, 3] + t3[3, 1, 1]\ t3[3, 1, 3] + t3[3, 2, 1]\ t3[3, 2, 3] + t3[3, 3, 1]\ t3[3, 3, 3], t3[1, 1, 2]\ t3[1, 1, 3] + t3[1, 2, 2]\ t3[1, 2, 3] + t3[1, 3, 2]\ t3[1, 3, 3] + t3[2, 1, 2]\ t3[2, 1, 3] + t3[2, 2, 2]\ t3[2, 2, 3] + t3[2, 3, 2]\ t3[2, 3, 3] + t3[3, 1, 2]\ t3[3, 1, 3] + t3[3, 2, 2]\ t3[3, 2, 3] + t3[3, 3, 2]\ t3[3, 3, 3], t3[1, 1, 3]\^2 + t3[1, 2, 3]\^2 + t3[1, 3, 3]\^2 + t3[2, 1, 3]\^2 + t3[2, 2, 3]\^2 + t3[2, 3, 3]\^2 + t3[3, 1, 3]\^2 + t3[3, 2, 3]\^2 + t3[3, 3, 3]\^2}}\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $Dimensions[%]$], "Input"], Cell[BoxData[ ${3, 3}$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $multiDot[T3, T3, {1, 2}, {2, 1}]$], "Input"], Cell[BoxData[ \({{t3[1, 1, 1]\^2 + 2\ t3[1, 2, 1]\ t3[2, 1, 1] + t3[2, 2, 1]\^2 + 2\ t3[1, 3, 1]\ t3[3, 1, 1] + 2\ t3[2, 3, 1]\ t3[3, 2, 1] + t3[3, 3, 1]\^2, t3[1, 1, 1]\ t3[1, 1, 2] + t3[1, 2, 2]\ t3[2, 1, 1] + t3[1, 2, 1]\ t3[2, 1, 2] + t3[2, 2, 1]\ t3[2, 2, 2] + t3[1, 3, 2]\ t3[3, 1, 1] + t3[1, 3, 1]\ t3[3, 1, 2] + t3[2, 3, 2]\ t3[3, 2, 1] + t3[2, 3, 1]\ t3[3, 2, 2] + t3[3, 3, 1]\ t3[3, 3, 2], t3[1, 1, 1]\ t3[1, 1, 3] + t3[1, 2, 3]\ t3[2, 1, 1] + t3[1, 2, 1]\ t3[2, 1, 3] + t3[2, 2, 1]\ t3[2, 2, 3] + t3[1, 3, 3]\ t3[3, 1, 1] + t3[1, 3, 1]\ t3[3, 1, 3] + t3[2, 3, 3]\ t3[3, 2, 1] + t3[2, 3, 1]\ t3[3, 2, 3] + t3[3, 3, 1]\ t3[3, 3, 3]}, { t3[1, 1, 1]\ t3[1, 1, 2] + t3[1, 2, 2]\ t3[2, 1, 1] + t3[1, 2, 1]\ t3[2, 1, 2] + t3[2, 2, 1]\ t3[2, 2, 2] + t3[1, 3, 2]\ t3[3, 1, 1] + t3[1, 3, 1]\ t3[3, 1, 2] + t3[2, 3, 2]\ t3[3, 2, 1] + t3[2, 3, 1]\ t3[3, 2, 2] + t3[3, 3, 1]\ t3[3, 3, 2], t3[1, 1, 2]\^2 + 2\ t3[1, 2, 2]\ t3[2, 1, 2] + t3[2, 2, 2]\^2 + 2\ t3[1, 3, 2]\ t3[3, 1, 2] + 2\ t3[2, 3, 2]\ t3[3, 2, 2] + t3[3, 3, 2]\^2, t3[1, 1, 2]\ t3[1, 1, 3] + t3[1, 2, 3]\ t3[2, 1, 2] + t3[1, 2, 2]\ t3[2, 1, 3] + t3[2, 2, 2]\ t3[2, 2, 3] + t3[1, 3, 3]\ t3[3, 1, 2] + t3[1, 3, 2]\ t3[3, 1, 3] + t3[2, 3, 3]\ t3[3, 2, 2] + t3[2, 3, 2]\ t3[3, 2, 3] + t3[3, 3, 2]\ t3[3, 3, 3]}, { t3[1, 1, 1]\ t3[1, 1, 3] + t3[1, 2, 3]\ t3[2, 1, 1] + t3[1, 2, 1]\ t3[2, 1, 3] + t3[2, 2, 1]\ t3[2, 2, 3] + t3[1, 3, 3]\ t3[3, 1, 1] + t3[1, 3, 1]\ t3[3, 1, 3] + t3[2, 3, 3]\ t3[3, 2, 1] + t3[2, 3, 1]\ t3[3, 2, 3] + t3[3, 3, 1]\ t3[3, 3, 3], t3[1, 1, 2]\ t3[1, 1, 3] + t3[1, 2, 3]\ t3[2, 1, 2] + t3[1, 2, 2]\ t3[2, 1, 3] + t3[2, 2, 2]\ t3[2, 2, 3] + t3[1, 3, 3]\ t3[3, 1, 2] + t3[1, 3, 2]\ t3[3, 1, 3] + t3[2, 3, 3]\ t3[3, 2, 2] + t3[2, 3, 2]\ t3[3, 2, 3] + t3[3, 3, 2]\ t3[3, 3, 3], t3[1, 1, 3]\^2 + 2\ t3[1, 2, 3]\ t3[2, 1, 3] + t3[2, 2, 3]\^2 + 2\ t3[1, 3, 3]\ t3[3, 1, 3] + 2\ t3[2, 3, 3]\ t3[3, 2, 3] + t3[3, 3, 3]\^2}}\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $multiDot[T3, T3, {1, 1}, {2, 2}, {3, 3}]$], "Input"], Cell[BoxData[ $t3[1, 1, 1]\^2 + t3[1, 1, 2]\^2 + t3[1, 1, 3]\^2 + t3[1, 2, 1]\^2 + t3[1, 2, 2]\^2 + t3[1, 2, 3]\^2 + t3[1, 3, 1]\^2 + t3[1, 3, 2]\^2 + t3[1, 3, 3]\^2 + t3[2, 1, 1]\^2 + t3[2, 1, 2]\^2 + t3[2, 1, 3]\^2 + t3[2, 2, 1]\^2 + t3[2, 2, 2]\^2 + t3[2, 2, 3]\^2 + t3[2, 3, 1]\^2 + t3[2, 3, 2]\^2 + t3[2, 3, 3]\^2 + t3[3, 1, 1]\^2 + t3[3, 1, 2]\^2 + t3[3, 1, 3]\^2 + t3[3, 2, 1]\^2 + t3[3, 2, 2]\^2 + t3[3, 2, 3]\^2 + t3[3, 3, 1]\^2 + t3[3, 3, 2]\^2 + t3[3, 3, 3]\^2$], "Output"] }, Open ]], Cell[TextData[{ "\tIf we declare the ", StyleBox["t3[__]", FontWeight->"Bold"], " to be 1-forms, this contraction vanishes, as ", StyleBox["multiDot", FontWeight->"Bold"], " uses ", StyleBox["Wedge", FontWeight->"Bold"], ":" }], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $DeclareForms[1, t3[_]]$], "Input"], Cell[BoxData[ $"OK"$], "Print"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $multiDot[T3, T3, {1, 1}, {2, 2}, {3, 3}]$], "Input"], Cell[BoxData[ $0$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $multiDot[T3, T3, {1, 2}, {2, 1}]$], "Input"], Cell[BoxData[ ${{0, t3[1, 1, 1]\[Wedge]t3[1, 1, 2] + t3[1, 2, 1]\[Wedge]t3[2, 1, 2] - t3[1, 2, 2]\[Wedge]t3[2, 1, 1] + t3[1, 3, 1]\[Wedge]t3[3, 1, 2] - t3[1, 3, 2]\[Wedge]t3[3, 1, 1] + t3[2, 2, 1]\[Wedge]t3[2, 2, 2] + t3[2, 3, 1]\[Wedge]t3[3, 2, 2] - t3[2, 3, 2]\[Wedge]t3[3, 2, 1] + t3[3, 3, 1]\[Wedge]t3[3, 3, 2], t3[1, 1, 1]\[Wedge]t3[1, 1, 3] + t3[1, 2, 1]\[Wedge]t3[2, 1, 3] - t3[1, 2, 3]\[Wedge]t3[2, 1, 1] + t3[1, 3, 1]\[Wedge]t3[3, 1, 3] - t3[1, 3, 3]\[Wedge]t3[3, 1, 1] + t3[2, 2, 1]\[Wedge]t3[2, 2, 3] + t3[2, 3, 1]\[Wedge]t3[3, 2, 3] - t3[2, 3, 3]\[Wedge]t3[3, 2, 1] + t3[3, 3, 1]\[Wedge]t3[3, 3, 3]}, { \(-\((t3[1, 1, 1]\[Wedge]t3[1, 1, 2])$\) - t3[1, 2, 1]\[Wedge]t3[2, 1, 2] + t3[1, 2, 2]\[Wedge]t3[2, 1, 1] - t3[1, 3, 1]\[Wedge]t3[3, 1, 2] + t3[1, 3, 2]\[Wedge]t3[3, 1, 1] - t3[2, 2, 1]\[Wedge]t3[2, 2, 2] - t3[2, 3, 1]\[Wedge]t3[3, 2, 2] + t3[2, 3, 2]\[Wedge]t3[3, 2, 1] - t3[3, 3, 1]\[Wedge]t3[3, 3, 2], 0, t3[1, 1, 2]\[Wedge]t3[1, 1, 3] + t3[1, 2, 2]\[Wedge]t3[2, 1, 3] - t3[1, 2, 3]\[Wedge]t3[2, 1, 2] + t3[1, 3, 2]\[Wedge]t3[3, 1, 3] - t3[1, 3, 3]\[Wedge]t3[3, 1, 2] + t3[2, 2, 2]\[Wedge]t3[2, 2, 3] + t3[2, 3, 2]\[Wedge]t3[3, 2, 3] - t3[2, 3, 3]\[Wedge]t3[3, 2, 2] + t3[3, 3, 2]\[Wedge]t3[3, 3, 3]}, { $-\((t3[1, 1, 1]\[Wedge]t3[1, 1, 3])$\) - t3[1, 2, 1]\[Wedge]t3[2, 1, 3] + t3[1, 2, 3]\[Wedge]t3[2, 1, 1] - t3[1, 3, 1]\[Wedge]t3[3, 1, 3] + t3[1, 3, 3]\[Wedge]t3[3, 1, 1] - t3[2, 2, 1]\[Wedge]t3[2, 2, 3] - t3[2, 3, 1]\[Wedge]t3[3, 2, 3] + t3[2, 3, 3]\[Wedge]t3[3, 2, 1] - t3[3, 3, 1]\[Wedge]t3[3, 3, 3], $-\((t3[1, 1, 2]\[Wedge]t3[1, 1, 3])$\) - t3[1, 2, 2]\[Wedge]t3[2, 1, 3] + t3[1, 2, 3]\[Wedge]t3[2, 1, 2] - t3[1, 3, 2]\[Wedge]t3[3, 1, 3] + t3[1, 3, 3]\[Wedge]t3[3, 1, 2] - t3[2, 2, 2]\[Wedge]t3[2, 2, 3] - t3[2, 3, 2]\[Wedge]t3[3, 2, 3] + t3[2, 3, 3]\[Wedge]t3[3, 2, 2] - t3[3, 3, 2]\[Wedge]t3[3, 3, 3], 0}} \)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $multiDot[T3, T4, {1, 1}, {2, 2}, {3, 3}]$], "Input"], Cell[BoxData[ \({t3[1, 1, 1]\ t4[1, 1, 1, 1] + t3[1, 1, 2]\ t4[1, 1, 2, 1] + t3[1, 1, 3]\ t4[1, 1, 3, 1] + t3[1, 2, 1]\ t4[1, 2, 1, 1] + t3[1, 2, 2]\ t4[1, 2, 2, 1] + t3[1, 2, 3]\ t4[1, 2, 3, 1] + t3[1, 3, 1]\ t4[1, 3, 1, 1] + t3[1, 3, 2]\ t4[1, 3, 2, 1] + t3[1, 3, 3]\ t4[1, 3, 3, 1] + t3[2, 1, 1]\ t4[2, 1, 1, 1] + t3[2, 1, 2]\ t4[2, 1, 2, 1] + t3[2, 1, 3]\ t4[2, 1, 3, 1] + t3[2, 2, 1]\ t4[2, 2, 1, 1] + t3[2, 2, 2]\ t4[2, 2, 2, 1] + t3[2, 2, 3]\ t4[2, 2, 3, 1] + t3[2, 3, 1]\ t4[2, 3, 1, 1] + t3[2, 3, 2]\ t4[2, 3, 2, 1] + t3[2, 3, 3]\ t4[2, 3, 3, 1] + t3[3, 1, 1]\ t4[3, 1, 1, 1] + t3[3, 1, 2]\ t4[3, 1, 2, 1] + t3[3, 1, 3]\ t4[3, 1, 3, 1] + t3[3, 2, 1]\ t4[3, 2, 1, 1] + t3[3, 2, 2]\ t4[3, 2, 2, 1] + t3[3, 2, 3]\ t4[3, 2, 3, 1] + t3[3, 3, 1]\ t4[3, 3, 1, 1] + t3[3, 3, 2]\ t4[3, 3, 2, 1] + t3[3, 3, 3]\ t4[3, 3, 3, 1], t3[1, 1, 1]\ t4[1, 1, 1, 2] + t3[1, 1, 2]\ t4[1, 1, 2, 2] + t3[1, 1, 3]\ t4[1, 1, 3, 2] + t3[1, 2, 1]\ t4[1, 2, 1, 2] + t3[1, 2, 2]\ t4[1, 2, 2, 2] + t3[1, 2, 3]\ t4[1, 2, 3, 2] + t3[1, 3, 1]\ t4[1, 3, 1, 2] + t3[1, 3, 2]\ t4[1, 3, 2, 2] + t3[1, 3, 3]\ t4[1, 3, 3, 2] + t3[2, 1, 1]\ t4[2, 1, 1, 2] + t3[2, 1, 2]\ t4[2, 1, 2, 2] + t3[2, 1, 3]\ t4[2, 1, 3, 2] + t3[2, 2, 1]\ t4[2, 2, 1, 2] + t3[2, 2, 2]\ t4[2, 2, 2, 2] + t3[2, 2, 3]\ t4[2, 2, 3, 2] + t3[2, 3, 1]\ t4[2, 3, 1, 2] + t3[2, 3, 2]\ t4[2, 3, 2, 2] + t3[2, 3, 3]\ t4[2, 3, 3, 2] + t3[3, 1, 1]\ t4[3, 1, 1, 2] + t3[3, 1, 2]\ t4[3, 1, 2, 2] + t3[3, 1, 3]\ t4[3, 1, 3, 2] + t3[3, 2, 1]\ t4[3, 2, 1, 2] + t3[3, 2, 2]\ t4[3, 2, 2, 2] + t3[3, 2, 3]\ t4[3, 2, 3, 2] + t3[3, 3, 1]\ t4[3, 3, 1, 2] + t3[3, 3, 2]\ t4[3, 3, 2, 2] + t3[3, 3, 3]\ t4[3, 3, 3, 2], t3[1, 1, 1]\ t4[1, 1, 1, 3] + t3[1, 1, 2]\ t4[1, 1, 2, 3] + t3[1, 1, 3]\ t4[1, 1, 3, 3] + t3[1, 2, 1]\ t4[1, 2, 1, 3] + t3[1, 2, 2]\ t4[1, 2, 2, 3] + t3[1, 2, 3]\ t4[1, 2, 3, 3] + t3[1, 3, 1]\ t4[1, 3, 1, 3] + t3[1, 3, 2]\ t4[1, 3, 2, 3] + t3[1, 3, 3]\ t4[1, 3, 3, 3] + t3[2, 1, 1]\ t4[2, 1, 1, 3] + t3[2, 1, 2]\ t4[2, 1, 2, 3] + t3[2, 1, 3]\ t4[2, 1, 3, 3] + t3[2, 2, 1]\ t4[2, 2, 1, 3] + t3[2, 2, 2]\ t4[2, 2, 2, 3] + t3[2, 2, 3]\ t4[2, 2, 3, 3] + t3[2, 3, 1]\ t4[2, 3, 1, 3] + t3[2, 3, 2]\ t4[2, 3, 2, 3] + t3[2, 3, 3]\ t4[2, 3, 3, 3] + t3[3, 1, 1]\ t4[3, 1, 1, 3] + t3[3, 1, 2]\ t4[3, 1, 2, 3] + t3[3, 1, 3]\ t4[3, 1, 3, 3] + t3[3, 2, 1]\ t4[3, 2, 1, 3] + t3[3, 2, 2]\ t4[3, 2, 2, 3] + t3[3, 2, 3]\ t4[3, 2, 3, 3] + t3[3, 3, 1]\ t4[3, 3, 1, 3] + t3[3, 3, 2]\ t4[3, 3, 2, 3] + t3[3, 3, 3]\ t4[3, 3, 3, 3]}\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $Dimensions[%]$], "Input"], Cell[BoxData[ ${3}$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $multiDot[T4, T4, {1, 1}, {2, 2}, {3, 3}]$], "Input"], Cell[BoxData[ \({{t4[1, 1, 1, 1]\^2 + t4[1, 1, 2, 1]\^2 + t4[1, 1, 3, 1]\^2 + t4[1, 2, 1, 1]\^2 + t4[1, 2, 2, 1]\^2 + t4[1, 2, 3, 1]\^2 + t4[1, 3, 1, 1]\^2 + t4[1, 3, 2, 1]\^2 + t4[1, 3, 3, 1]\^2 + t4[2, 1, 1, 1]\^2 + t4[2, 1, 2, 1]\^2 + t4[2, 1, 3, 1]\^2 + t4[2, 2, 1, 1]\^2 + t4[2, 2, 2, 1]\^2 + t4[2, 2, 3, 1]\^2 + t4[2, 3, 1, 1]\^2 + t4[2, 3, 2, 1]\^2 + t4[2, 3, 3, 1]\^2 + t4[3, 1, 1, 1]\^2 + t4[3, 1, 2, 1]\^2 + t4[3, 1, 3, 1]\^2 + t4[3, 2, 1, 1]\^2 + t4[3, 2, 2, 1]\^2 + t4[3, 2, 3, 1]\^2 + t4[3, 3, 1, 1]\^2 + t4[3, 3, 2, 1]\^2 + t4[3, 3, 3, 1]\^2, t4[1, 1, 1, 1]\ t4[1, 1, 1, 2] + t4[1, 1, 2, 1]\ t4[1, 1, 2, 2] + t4[1, 1, 3, 1]\ t4[1, 1, 3, 2] + t4[1, 2, 1, 1]\ t4[1, 2, 1, 2] + t4[1, 2, 2, 1]\ t4[1, 2, 2, 2] + t4[1, 2, 3, 1]\ t4[1, 2, 3, 2] + t4[1, 3, 1, 1]\ t4[1, 3, 1, 2] + t4[1, 3, 2, 1]\ t4[1, 3, 2, 2] + t4[1, 3, 3, 1]\ t4[1, 3, 3, 2] + t4[2, 1, 1, 1]\ t4[2, 1, 1, 2] + t4[2, 1, 2, 1]\ t4[2, 1, 2, 2] + t4[2, 1, 3, 1]\ t4[2, 1, 3, 2] + t4[2, 2, 1, 1]\ t4[2, 2, 1, 2] + t4[2, 2, 2, 1]\ t4[2, 2, 2, 2] + t4[2, 2, 3, 1]\ t4[2, 2, 3, 2] + t4[2, 3, 1, 1]\ t4[2, 3, 1, 2] + t4[2, 3, 2, 1]\ t4[2, 3, 2, 2] + t4[2, 3, 3, 1]\ t4[2, 3, 3, 2] + t4[3, 1, 1, 1]\ t4[3, 1, 1, 2] + t4[3, 1, 2, 1]\ t4[3, 1, 2, 2] + t4[3, 1, 3, 1]\ t4[3, 1, 3, 2] + t4[3, 2, 1, 1]\ t4[3, 2, 1, 2] + t4[3, 2, 2, 1]\ t4[3, 2, 2, 2] + t4[3, 2, 3, 1]\ t4[3, 2, 3, 2] + t4[3, 3, 1, 1]\ t4[3, 3, 1, 2] + t4[3, 3, 2, 1]\ t4[3, 3, 2, 2] + t4[3, 3, 3, 1]\ t4[3, 3, 3, 2], t4[1, 1, 1, 1]\ t4[1, 1, 1, 3] + t4[1, 1, 2, 1]\ t4[1, 1, 2, 3] + t4[1, 1, 3, 1]\ t4[1, 1, 3, 3] + t4[1, 2, 1, 1]\ t4[1, 2, 1, 3] + t4[1, 2, 2, 1]\ t4[1, 2, 2, 3] + t4[1, 2, 3, 1]\ t4[1, 2, 3, 3] + t4[1, 3, 1, 1]\ t4[1, 3, 1, 3] + t4[1, 3, 2, 1]\ t4[1, 3, 2, 3] + t4[1, 3, 3, 1]\ t4[1, 3, 3, 3] + t4[2, 1, 1, 1]\ t4[2, 1, 1, 3] + t4[2, 1, 2, 1]\ t4[2, 1, 2, 3] + t4[2, 1, 3, 1]\ t4[2, 1, 3, 3] + t4[2, 2, 1, 1]\ t4[2, 2, 1, 3] + t4[2, 2, 2, 1]\ t4[2, 2, 2, 3] + t4[2, 2, 3, 1]\ t4[2, 2, 3, 3] + t4[2, 3, 1, 1]\ t4[2, 3, 1, 3] + t4[2, 3, 2, 1]\ t4[2, 3, 2, 3] + t4[2, 3, 3, 1]\ t4[2, 3, 3, 3] + t4[3, 1, 1, 1]\ t4[3, 1, 1, 3] + t4[3, 1, 2, 1]\ t4[3, 1, 2, 3] + t4[3, 1, 3, 1]\ t4[3, 1, 3, 3] + t4[3, 2, 1, 1]\ t4[3, 2, 1, 3] + t4[3, 2, 2, 1]\ t4[3, 2, 2, 3] + t4[3, 2, 3, 1]\ t4[3, 2, 3, 3] + t4[3, 3, 1, 1]\ t4[3, 3, 1, 3] + t4[3, 3, 2, 1]\ t4[3, 3, 2, 3] + t4[3, 3, 3, 1]\ t4[3, 3, 3, 3]}, { t4[1, 1, 1, 1]\ t4[1, 1, 1, 2] + t4[1, 1, 2, 1]\ t4[1, 1, 2, 2] + t4[1, 1, 3, 1]\ t4[1, 1, 3, 2] + t4[1, 2, 1, 1]\ t4[1, 2, 1, 2] + t4[1, 2, 2, 1]\ t4[1, 2, 2, 2] + t4[1, 2, 3, 1]\ t4[1, 2, 3, 2] + t4[1, 3, 1, 1]\ t4[1, 3, 1, 2] + t4[1, 3, 2, 1]\ t4[1, 3, 2, 2] + t4[1, 3, 3, 1]\ t4[1, 3, 3, 2] + t4[2, 1, 1, 1]\ t4[2, 1, 1, 2] + t4[2, 1, 2, 1]\ t4[2, 1, 2, 2] + t4[2, 1, 3, 1]\ t4[2, 1, 3, 2] + t4[2, 2, 1, 1]\ t4[2, 2, 1, 2] + t4[2, 2, 2, 1]\ t4[2, 2, 2, 2] + t4[2, 2, 3, 1]\ t4[2, 2, 3, 2] + t4[2, 3, 1, 1]\ t4[2, 3, 1, 2] + t4[2, 3, 2, 1]\ t4[2, 3, 2, 2] + t4[2, 3, 3, 1]\ t4[2, 3, 3, 2] + t4[3, 1, 1, 1]\ t4[3, 1, 1, 2] + t4[3, 1, 2, 1]\ t4[3, 1, 2, 2] + t4[3, 1, 3, 1]\ t4[3, 1, 3, 2] + t4[3, 2, 1, 1]\ t4[3, 2, 1, 2] + t4[3, 2, 2, 1]\ t4[3, 2, 2, 2] + t4[3, 2, 3, 1]\ t4[3, 2, 3, 2] + t4[3, 3, 1, 1]\ t4[3, 3, 1, 2] + t4[3, 3, 2, 1]\ t4[3, 3, 2, 2] + t4[3, 3, 3, 1]\ t4[3, 3, 3, 2], t4[1, 1, 1, 2]\^2 + t4[1, 1, 2, 2]\^2 + t4[1, 1, 3, 2]\^2 + t4[1, 2, 1, 2]\^2 + t4[1, 2, 2, 2]\^2 + t4[1, 2, 3, 2]\^2 + t4[1, 3, 1, 2]\^2 + t4[1, 3, 2, 2]\^2 + t4[1, 3, 3, 2]\^2 + t4[2, 1, 1, 2]\^2 + t4[2, 1, 2, 2]\^2 + t4[2, 1, 3, 2]\^2 + t4[2, 2, 1, 2]\^2 + t4[2, 2, 2, 2]\^2 + t4[2, 2, 3, 2]\^2 + t4[2, 3, 1, 2]\^2 + t4[2, 3, 2, 2]\^2 + t4[2, 3, 3, 2]\^2 + t4[3, 1, 1, 2]\^2 + t4[3, 1, 2, 2]\^2 + t4[3, 1, 3, 2]\^2 + t4[3, 2, 1, 2]\^2 + t4[3, 2, 2, 2]\^2 + t4[3, 2, 3, 2]\^2 + t4[3, 3, 1, 2]\^2 + t4[3, 3, 2, 2]\^2 + t4[3, 3, 3, 2]\^2, t4[1, 1, 1, 2]\ t4[1, 1, 1, 3] + t4[1, 1, 2, 2]\ t4[1, 1, 2, 3] + t4[1, 1, 3, 2]\ t4[1, 1, 3, 3] + t4[1, 2, 1, 2]\ t4[1, 2, 1, 3] + t4[1, 2, 2, 2]\ t4[1, 2, 2, 3] + t4[1, 2, 3, 2]\ t4[1, 2, 3, 3] + t4[1, 3, 1, 2]\ t4[1, 3, 1, 3] + t4[1, 3, 2, 2]\ t4[1, 3, 2, 3] + t4[1, 3, 3, 2]\ t4[1, 3, 3, 3] + t4[2, 1, 1, 2]\ t4[2, 1, 1, 3] + t4[2, 1, 2, 2]\ t4[2, 1, 2, 3] + t4[2, 1, 3, 2]\ t4[2, 1, 3, 3] + t4[2, 2, 1, 2]\ t4[2, 2, 1, 3] + t4[2, 2, 2, 2]\ t4[2, 2, 2, 3] + t4[2, 2, 3, 2]\ t4[2, 2, 3, 3] + t4[2, 3, 1, 2]\ t4[2, 3, 1, 3] + t4[2, 3, 2, 2]\ t4[2, 3, 2, 3] + t4[2, 3, 3, 2]\ t4[2, 3, 3, 3] + t4[3, 1, 1, 2]\ t4[3, 1, 1, 3] + t4[3, 1, 2, 2]\ t4[3, 1, 2, 3] + t4[3, 1, 3, 2]\ t4[3, 1, 3, 3] + t4[3, 2, 1, 2]\ t4[3, 2, 1, 3] + t4[3, 2, 2, 2]\ t4[3, 2, 2, 3] + t4[3, 2, 3, 2]\ t4[3, 2, 3, 3] + t4[3, 3, 1, 2]\ t4[3, 3, 1, 3] + t4[3, 3, 2, 2]\ t4[3, 3, 2, 3] + t4[3, 3, 3, 2]\ t4[3, 3, 3, 3]}, { t4[1, 1, 1, 1]\ t4[1, 1, 1, 3] + t4[1, 1, 2, 1]\ t4[1, 1, 2, 3] + t4[1, 1, 3, 1]\ t4[1, 1, 3, 3] + t4[1, 2, 1, 1]\ t4[1, 2, 1, 3] + t4[1, 2, 2, 1]\ t4[1, 2, 2, 3] + t4[1, 2, 3, 1]\ t4[1, 2, 3, 3] + t4[1, 3, 1, 1]\ t4[1, 3, 1, 3] + t4[1, 3, 2, 1]\ t4[1, 3, 2, 3] + t4[1, 3, 3, 1]\ t4[1, 3, 3, 3] + t4[2, 1, 1, 1]\ t4[2, 1, 1, 3] + t4[2, 1, 2, 1]\ t4[2, 1, 2, 3] + t4[2, 1, 3, 1]\ t4[2, 1, 3, 3] + t4[2, 2, 1, 1]\ t4[2, 2, 1, 3] + t4[2, 2, 2, 1]\ t4[2, 2, 2, 3] + t4[2, 2, 3, 1]\ t4[2, 2, 3, 3] + t4[2, 3, 1, 1]\ t4[2, 3, 1, 3] + t4[2, 3, 2, 1]\ t4[2, 3, 2, 3] + t4[2, 3, 3, 1]\ t4[2, 3, 3, 3] + t4[3, 1, 1, 1]\ t4[3, 1, 1, 3] + t4[3, 1, 2, 1]\ t4[3, 1, 2, 3] + t4[3, 1, 3, 1]\ t4[3, 1, 3, 3] + t4[3, 2, 1, 1]\ t4[3, 2, 1, 3] + t4[3, 2, 2, 1]\ t4[3, 2, 2, 3] + t4[3, 2, 3, 1]\ t4[3, 2, 3, 3] + t4[3, 3, 1, 1]\ t4[3, 3, 1, 3] + t4[3, 3, 2, 1]\ t4[3, 3, 2, 3] + t4[3, 3, 3, 1]\ t4[3, 3, 3, 3], t4[1, 1, 1, 2]\ t4[1, 1, 1, 3] + t4[1, 1, 2, 2]\ t4[1, 1, 2, 3] + t4[1, 1, 3, 2]\ t4[1, 1, 3, 3] + t4[1, 2, 1, 2]\ t4[1, 2, 1, 3] + t4[1, 2, 2, 2]\ t4[1, 2, 2, 3] + t4[1, 2, 3, 2]\ t4[1, 2, 3, 3] + t4[1, 3, 1, 2]\ t4[1, 3, 1, 3] + t4[1, 3, 2, 2]\ t4[1, 3, 2, 3] + t4[1, 3, 3, 2]\ t4[1, 3, 3, 3] + t4[2, 1, 1, 2]\ t4[2, 1, 1, 3] + t4[2, 1, 2, 2]\ t4[2, 1, 2, 3] + t4[2, 1, 3, 2]\ t4[2, 1, 3, 3] + t4[2, 2, 1, 2]\ t4[2, 2, 1, 3] + t4[2, 2, 2, 2]\ t4[2, 2, 2, 3] + t4[2, 2, 3, 2]\ t4[2, 2, 3, 3] + t4[2, 3, 1, 2]\ t4[2, 3, 1, 3] + t4[2, 3, 2, 2]\ t4[2, 3, 2, 3] + t4[2, 3, 3, 2]\ t4[2, 3, 3, 3] + t4[3, 1, 1, 2]\ t4[3, 1, 1, 3] + t4[3, 1, 2, 2]\ t4[3, 1, 2, 3] + t4[3, 1, 3, 2]\ t4[3, 1, 3, 3] + t4[3, 2, 1, 2]\ t4[3, 2, 1, 3] + t4[3, 2, 2, 2]\ t4[3, 2, 2, 3] + t4[3, 2, 3, 2]\ t4[3, 2, 3, 3] + t4[3, 3, 1, 2]\ t4[3, 3, 1, 3] + t4[3, 3, 2, 2]\ t4[3, 3, 2, 3] + t4[3, 3, 3, 2]\ t4[3, 3, 3, 3], t4[1, 1, 1, 3]\^2 + t4[1, 1, 2, 3]\^2 + t4[1, 1, 3, 3]\^2 + t4[1, 2, 1, 3]\^2 + t4[1, 2, 2, 3]\^2 + t4[1, 2, 3, 3]\^2 + t4[1, 3, 1, 3]\^2 + t4[1, 3, 2, 3]\^2 + t4[1, 3, 3, 3]\^2 + t4[2, 1, 1, 3]\^2 + t4[2, 1, 2, 3]\^2 + t4[2, 1, 3, 3]\^2 + t4[2, 2, 1, 3]\^2 + t4[2, 2, 2, 3]\^2 + t4[2, 2, 3, 3]\^2 + t4[2, 3, 1, 3]\^2 + t4[2, 3, 2, 3]\^2 + t4[2, 3, 3, 3]\^2 + t4[3, 1, 1, 3]\^2 + t4[3, 1, 2, 3]\^2 + t4[3, 1, 3, 3]\^2 + t4[3, 2, 1, 3]\^2 + t4[3, 2, 2, 3]\^2 + t4[3, 2, 3, 3]\^2 + t4[3, 3, 1, 3]\^2 + t4[3, 3, 2, 3]\^2 + t4[3, 3, 3, 3]\^2}}\)], "Output"] }, Closed]], Cell[CellGroupData[{ Cell[BoxData[ $Dimensions[%]$], "Input"], Cell[BoxData[ ${3, 3}$], "Output"] }, Open ]] }, Closed]], Cell[TextData[{ "\t", StyleBox["Note1", FontSlant->"Italic"], ": In both ", StyleBox["Contract", FontWeight->"Bold"], " and ", StyleBox["multiDot", FontWeight->"Bold"], " \"contraction\" is simple summation; the tensor indices to be contracted \ must have opposite variance (one co- and one contra- variant)." }], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[TextData[{ "\t", StyleBox["Note2", FontSlant->"Italic"], ": One can use ", StyleBox["Contract", FontWeight->"Bold"], " and ", StyleBox["multiDot", FontWeight->"Bold"], " to contract nested lists with unequal index dimensions (provided, of \ course, that the indices to be contracted have the same dimension); thus, if \ A has dimensions {2, 3, 3, 4} and B {3, 2, 4}, ", StyleBox["Contract[A, {2,3}]", FontWeight->"Bold"], " will return a tensor with dimensions {2, 4} and ", StyleBox["multiDot[A, B, {1,2}, {3,1}]", FontWeight->"Bold"], " will return a tensor with dimensions {3, 4, 4}." }], "Text", TextAlignment->Left, TextJustification->0, FontSize->16] }, Closed]] }, Closed]], Cell["", "Text"], Cell[CellGroupData[{ Cell[" 2.5 interiorProduct, LieDcartan", "Subsection", ShowGroupOpenCloseIcon->True, FontSize->18], Cell[TextData[{ "\tTwo new functions introduced in version 3.8.5 are ", StyleBox["interiorProduct[vector_,form_]", FontFamily->"Courier", FontWeight->"Bold"], ", giving the interior product (contraction) between a vector and a p-form, \ resulting in a (p-1)-form, and ", StyleBox["LieDcartan", FontFamily->"Courier", FontWeight->"Bold"], StyleBox["[", FontWeight->"Bold"], StyleBox["vector_,form_", FontFamily->"Courier", FontWeight->"Bold"], StyleBox["]", FontWeight->"Bold"], ", giving the Lie derivative of the differential form expression ", StyleBox["form", FontWeight->"Bold"], " w.r.t. the ", StyleBox["vector", FontWeight->"Bold"], ". ", StyleBox["LieDcartan", FontFamily->"Courier", FontWeight->"Bold"], " is defined in terms of ", StyleBox["interiorProduct", FontFamily->"Courier", FontWeight->"Bold"], " using Cartan's identity. ", StyleBox["interiorProduct", FontFamily->"Courier", FontWeight->"Bold", FontSlant->"Italic"], StyleBox[" (and hence ", FontSlant->"Italic"], StyleBox["LieDcartan", FontFamily->"Courier", FontWeight->"Bold", FontSlant->"Italic"], StyleBox[ ") only applies to p-forms that are expressed as wedge products of certain \ basic 1-forms. It has no effect on symbolic p-forms. ", FontSlant->"Italic"] }], "Text", FontSize->16], Cell[TextData[{ "\tThe vector in the first argument of ", StyleBox["interiorProduct[vector_,form_]", FontFamily->"Courier", FontWeight->"Bold"], ", must be given as ", StyleBox["a list of its contravariant components", FontSlant->"Italic"], " in a frame dual to the basic 1-forms used: if the coframe basis is, say, \ {e[1], e[2], ..., e[n]}, then the list {", Cell[BoxData[ $V\^1$]], ",", Cell[BoxData[ $V\^2$]], ",...,", Cell[BoxData[ $V\^n$]], "} will denote the vector ", Cell[BoxData[ $V\^1$]], Cell[BoxData[ $X\_1$]], "+ ", Cell[BoxData[ $V\^2$]], Cell[BoxData[ $X\_2$]], "+... +", Cell[BoxData[ $V\^n$]], Cell[BoxData[ $X\_n$]], ", where the frame basis vectors ", Cell[BoxData[ $X\_k$]], " satisfy ", Cell[BoxData[ $X\_a$]], Cell[BoxData[ $e\^b$]], "=", Cell[BoxData[ TagBox[$\[Delta]\_a\^b$, DisplayForm]]], " (", Cell[BoxData[ $e\^b$]], "= e[b]). The symbols e[_] are declared as 1-forms in the matrixEDC code." }], "Text", FontSize->16], Cell[TextData[{ "\tThe coframe basis used to express all p-forms must be either a numbered \ set like {\[Sigma][1], \[Sigma][2], ..., \[Sigma][n]} or {\[Omega][1], \ \[Omega][2], ..., \[Omega][n]} (the symbols \[Sigma][_], \[Omega][_] must \ first be declared as 1-forms), or the differentials of the coordinates {d[x], \ d[y],...,d[", Cell[BoxData[ $w$]], "]}. However, when the coordinate differentials are used ", StyleBox["interiorProduct", FontFamily->"Courier", FontWeight->"Bold"], " requires a third argument -- the ordered list of coordinates -- so as to \ know which vector component corresponds to which coordinate. For example,", StyleBox[" \ninteriorProduct[{1,0,0,0}, d[x]\[Wedge]d[t],{x,y,z,t}]", FontFamily->"Courier"], " gives ", StyleBox["d[t]", FontFamily->"Courier"], ", but \n", StyleBox["interiorProduct", FontFamily->"Courier"], StyleBox["[{1,0,0,0}, d[x]\[Wedge]d[t],{t,x,y,z}]", FontFamily->"Courier"], " gives", StyleBox[" -d[x]", FontFamily->"Courier"], "." }], "Text", FontSize->16], Cell[CellGroupData[{ Cell[TextData[{ "\tThe following examples illustrate the use of ", StyleBox["interiorProduct", FontFamily->"Courier", FontWeight->"Bold"], " and ", StyleBox["LieDcartan", FontFamily->"Courier", FontWeight->"Bold"], ":" }], "Text", FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $vector = {v[1], v[2], v[3], v[4]}$], "Input"], Cell[BoxData[ ${v[1], v[2], v[3], v[4]}$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $test1form = X\ e[1] + Y\ e[2] + Z\ e[3] + T\ e[4]$], "Input"], Cell[BoxData[ $X\ e[1] + Y\ e[2] + Z\ e[3] + T\ e[4]$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $test2form = P\ \ e[1]\[Wedge]e[4] + Q\ e[2]\[Wedge]e[4] + R\ \ e[3]\[Wedge]e[4] + E\ e[2]\[Wedge]e[3] + F\ \ e[3]\[Wedge]e[1] + G\ e[1]\[Wedge]e[2]$], "Input"], Cell[BoxData[ $G\ e[1]\[Wedge]e[2] - F\ e[1]\[Wedge]e[3] + P\ e[1]\[Wedge]e[4] + E\ e[2]\[Wedge]e[3] + Q\ e[2]\[Wedge]e[4] + R\ e[3]\[Wedge]e[4]$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $test3form = K\ \ e[1]\[Wedge]e[2]\[Wedge]e[3] + L\ e[2]\[Wedge]e[3]\[Wedge]e[4]\ + M\ \ e[1]\[Wedge]e[3]\[Wedge]e[4] + N\ e[1]\[Wedge]e[2]\[Wedge]e[4]$], "Input"], Cell[BoxData[ $K\ e[1]\[Wedge]e[2]\[Wedge]e[3] + N\ e[1]\[Wedge]e[2]\[Wedge]e[4] + M\ e[1]\[Wedge]e[3]\[Wedge]e[4] + L\ e[2]\[Wedge]e[3]\[Wedge]e[4]$], "Output"] }, Open ]], Cell["", "Text"], Cell[CellGroupData[{ Cell[BoxData[ $interiorProduct[vector, test1form]$], "Input"], Cell[BoxData[ $X\ v[1] + Y\ v[2] + Z\ v[3] + T\ v[4]$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $interiorProduct[vector, test2form]$], "Input"], Cell[BoxData[ $e[4]\ \((P\ v[1] + Q\ v[2] + R\ v[3])$ + e[1]\ $(\(-G$\ v[2] + F\ v[3] - P\ v[4])\) + e[2]\ $(G\ v[1] - E\ v[3] - Q\ v[4])$ + e[3]\ $(\(-F$\ v[1] + E\ v[2] - R\ v[4])\)\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $interiorProduct[vector, test3form]$], "Input"], Cell[BoxData[ $\((K\ v[3] + N\ v[4])$\ e[1]\[Wedge]e[2] + $(\(-K$\ v[2] + M\ v[4])\)\ e[1]\[Wedge]e[3] + $(\(-N$\ v[2] - M\ v[3])\)\ e[1]\[Wedge]e[4] + $(K\ v[1] + L\ v[4])$\ e[2]\[Wedge]e[3] + $(N\ v[1] - L\ v[3])$\ e[2]\[Wedge]e[4] + $(M\ v[1] + L\ v[2])$\ e[3]\[Wedge]e[4]\)], "Output"] }, Open ]], Cell["", "Text"], Cell[TextData[{ "The first argument of ", StyleBox["interiorProduct", FontFamily->"Courier", FontWeight->"Bold"], " must be a list:" }], "Text", FontSize->14], Cell[CellGroupData[{ Cell[BoxData[ $interiorProduct[test1form, test3form]$], "Input"], Cell[BoxData[ $interiorProduct[X\ e[1] + Y\ e[2] + Z\ e[3] + T\ e[4], K\ e[1]\[Wedge]e[2]\[Wedge]e[3] + N\ e[1]\[Wedge]e[2]\[Wedge]e[4] + M\ e[1]\[Wedge]e[3]\[Wedge]e[4] + L\ e[2]\[Wedge]e[3]\[Wedge]e[4]]$], "Output"] }, Open ]], Cell[TextData[{ StyleBox["interiorProduct", FontFamily->"Courier", FontWeight->"Bold"], " has no effect on symbolic forms:" }], "Text", FontSize->14], Cell[CellGroupData[{ Cell[BoxData[ $DeclareForms[{1, form1}, \ {2, form2}]$], "Input"], Cell[BoxData[ $"OK"$], "Print"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $interiorProduct[vector, form2]$], "Input"], Cell[BoxData[ $interiorProduct[{v[1], v[2], v[3], v[4]}, form2]$], "Output"] }, Open ]], Cell["", "Text"], Cell[TextData[{ "\[FilledSmallCircle]\t", StyleBox["interiorProduct", FontFamily->"Courier", FontWeight->"Bold"], " can also be applied to lists of forms, giving the corresponding list of \ contractions with the given vector:" }], "Text", FontSize->14], Cell[CellGroupData[{ Cell[BoxData[ $interiorProduct[ vector, {e[1]\[Wedge]e[2]\[Wedge]e[3], e[2]\[Wedge]e[3]\[Wedge]e[4], e[3]\[Wedge]e[4]\[Wedge]e[1], e[4]\[Wedge]e[1]\[Wedge]e[2]}]$], "Input"], Cell[BoxData[ ${v[3]\ e[1]\[Wedge]e[2] - v[2]\ e[1]\[Wedge]e[3] + v[1]\ e[2]\[Wedge]e[3], v[4]\ e[2]\[Wedge]e[3] - v[3]\ e[2]\[Wedge]e[4] + v[2]\ e[3]\[Wedge]e[4], v[4]\ e[1]\[Wedge]e[3] - v[3]\ e[1]\[Wedge]e[4] + v[1]\ e[3]\[Wedge]e[4], v[4]\ e[1]\[Wedge]e[2] - v[2]\ e[1]\[Wedge]e[4] + v[1]\ e[2]\[Wedge]e[4]}$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $form2array = Array[Wedge[e[#1], e[#2]]&, {4, 4}]$], "Input"], Cell[BoxData[ ${{0, e[1]\[Wedge]e[2], e[1]\[Wedge]e[3], e[1]\[Wedge]e[4]}, { \(-\((e[1]\[Wedge]e[2])$\), 0, e[2]\[Wedge]e[3], e[2]\[Wedge]e[4]}, { $-\((e[1]\[Wedge]e[3])$\), $-\((e[2]\[Wedge]e[3])$\), 0, e[3]\[Wedge]e[4]}, {$-\((e[1]\[Wedge]e[4])$\), $-\((e[2]\[Wedge]e[4])$\), $-\((e[3]\[Wedge]e[4])$\), 0}}\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $interiorProduct[vector, form2array]$], "Input"], Cell[BoxData[ ${{0, e[2]\ v[1] - e[1]\ v[2], e[3]\ v[1] - e[1]\ v[3], e[4]\ v[1] - e[1]\ v[4]}, {\(-e[2]$\ v[1] + e[1]\ v[2], 0, e[3]\ v[2] - e[2]\ v[3], e[4]\ v[2] - e[2]\ v[4]}, { $-e[3]$\ v[1] + e[1]\ v[3], $-e[3]$\ v[2] + e[2]\ v[3], 0, e[4]\ v[3] - e[3]\ v[4]}, {$-e[4]$\ v[1] + e[1]\ v[4], $-e[4]$\ v[2] + e[2]\ v[4], $-e[4]$\ v[3] + e[3]\ v[4], 0}}\)], "Output"] }, Open ]], Cell["", "Text"], Cell[TextData[ "\[FilledSmallCircle]\tOne can use any numbered set of 1-forms as basis \ 1-forms:"], "Text", FontSize->14], Cell[CellGroupData[{ Cell[BoxData[ $DeclareForms[1, \[Sigma][_], \[Omega][_]]$], "Input"], Cell[BoxData[ $"OK"$], "Print"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $test2form /. e \[Rule] \[Sigma]$], "Input"], Cell[BoxData[ $G\ \[Sigma][1]\[Wedge]\[Sigma][2] - F\ \[Sigma][1]\[Wedge]\[Sigma][3] + P\ \[Sigma][1]\[Wedge]\[Sigma][4] + E\ \[Sigma][2]\[Wedge]\[Sigma][3] + Q\ \[Sigma][2]\[Wedge]\[Sigma][4] + R\ \[Sigma][3]\[Wedge]\[Sigma][4]$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $interiorProduct[vector, %]$], "Input"], Cell[BoxData[ $\((\(-G$\ v[2] + F\ v[3] - P\ v[4])\)\ \[Sigma][1] + $(G\ v[1] - E\ v[3] - Q\ v[4])$\ \[Sigma][2] + $(\(-F$\ v[1] + E\ v[2] - R\ v[4])\)\ \[Sigma][3] + $(P\ v[1] + Q\ v[2] + R\ v[3])$\ \[Sigma][4]\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $test3form /. e \[Rule] \[Omega]$], "Input"], Cell[BoxData[ $K\ \[Omega][1]\[Wedge]\[Omega][2]\[Wedge]\[Omega][3] + N\ \[Omega][1]\[Wedge]\[Omega][2]\[Wedge]\[Omega][4] + M\ \[Omega][1]\[Wedge]\[Omega][3]\[Wedge]\[Omega][4] + L\ \[Omega][2]\[Wedge]\[Omega][3]\[Wedge]\[Omega][4]$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $interiorProduct[vector, %]$], "Input"], Cell[BoxData[ $\((K\ v[3] + N\ v[4])$\ \[Omega][1]\[Wedge]\[Omega][2] + $(\(-K$\ v[2] + M\ v[4])\)\ \[Omega][1]\[Wedge]\[Omega][3] + $(\(-N$\ v[2] - M\ v[3])\)\ \[Omega][1]\[Wedge]\[Omega][4] + $(K\ v[1] + L\ v[4])$\ \[Omega][2]\[Wedge]\[Omega][3] + $(N\ v[1] - L\ v[3])$\ \[Omega][2]\[Wedge]\[Omega][4] + $(M\ v[1] + L\ v[2])$\ \[Omega][3]\[Wedge]\[Omega][4]\)], "Output"] }, Open ]], Cell["", "Text"], Cell[TextData[ "\[FilledSmallCircle]\tHowever, when the coordinate differential basis is \ used, a third argument is required to define the order of the vector \ components:"], "Text", FontSize->14], Cell[CellGroupData[{ Cell[BoxData[ StyleBox[$interiorProduct[{1, 0, 0, 0}, \ d[x]\[Wedge]d[t]]$, FontFamily->"Courier"]], "Input"], Cell[BoxData[ $"Must give ordered list of variables (coordinates) as 3rd argument"$], "Output", FontSize->16, FontSlant->"Italic", FontColor->RGBColor[1, 0, 1]] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ StyleBox[ $interiorProduct[{1, 0, 0, 0}, \ d[x]\[Wedge]d[t], {x, y, z, t}]$, FontFamily->"Courier"]], "Input"], Cell[BoxData[ $d[t]$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ StyleBox[ $interiorProduct[{1, 0, 0, 0}, \ d[x]\[Wedge]d[t], {t, x, y, z}]$, FontFamily->"Courier"]], "Input"], Cell[BoxData[ $\(-d[x]$\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ StyleBox[ $interiorProduct[{1, 0, 0, 0}, \ d[x]\[Wedge]d[t], {z, x, y, t}]$, FontFamily->"Courier"]], "Input"], Cell[BoxData[ $0$], "Output"] }, Open ]], Cell["", "Text"], Cell[TextData[{ "\[FilledSmallCircle]\tThe Lie derivative of forms, ", StyleBox["LieDcartan", FontFamily->"Courier", FontWeight->"Bold"], ", has been defined using ", StyleBox["interiorProduct", FontFamily->"Courier", FontWeight->"Bold"], " and Cartan's identity. But as it involves exterior derivatives, which \ treat all symbols as variables, it cannot be completely evaluated unless one \ gives the exterior derivatives of the basis 1-forms, and of all other symbols \ used, in terms of the basis 1-forms. For example:" }], "Text", FontSize->14], Cell[BoxData[ $\(d[e[4]] = 0; $\)], "Input"], Cell[BoxData[ $d[e[i_]] := 1/2 Sum[Signature[{i, j, k}] Wedge[e[j], e[k]], {j, 3}, {k, 3}]$], "Input"], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ StyleBox["LieDcartan", FontWeight->"Bold"], "[", $vector, test2form$, "]"}]], "Input"], Cell[BoxData[ $"To complete the calculation, all exterior derivatives must be \ expressed in terms of the basis 1-forms!"$], "Output", FontSize->16, FontSlant->"Italic", FontColor->RGBColor[1, 0, 1]], Cell[BoxData[ $\(-int$Prod[{v[1], v[2], v[3], v[4]}, d[F]\[Wedge]e[1]\[Wedge]e[3]]$ + int$Prod[{v[1], v[2], v[3], v[4]}, d[G]\[Wedge]e[1]\[Wedge]e[2]] + int$Prod[{v[1], v[2], v[3], v[4]}, d[P]\[Wedge]e[1]\[Wedge]e[4]] + int$Prod[{v[1], v[2], v[3], v[4]}, d[Q]\[Wedge]e[2]\[Wedge]e[4]] + int$Prod[{v[1], v[2], v[3], v[4]}, d[R]\[Wedge]e[3]\[Wedge]e[4]] + v[3]\ d[F]\[Wedge]e[1] - v[1]\ d[F]\[Wedge]e[3] - v[2]\ d[G]\[Wedge]e[1] + v[1]\ d[G]\[Wedge]e[2] - v[4]\ d[P]\[Wedge]e[1] + v[1]\ d[P]\[Wedge]e[4] - v[4]\ d[Q]\[Wedge]e[2] + v[2]\ d[Q]\[Wedge]e[4] - v[4]\ d[R]\[Wedge]e[3] + v[3]\ d[R]\[Wedge]e[4] + G\ d[v[1]]\[Wedge]e[2] - F\ d[v[1]]\[Wedge]e[3] + P\ d[v[1]]\[Wedge]e[4] - G\ d[v[2]]\[Wedge]e[1] + E\ d[v[2]]\[Wedge]e[3] + Q\ d[v[2]]\[Wedge]e[4] + F\ d[v[3]]\[Wedge]e[1] - E\ d[v[3]]\[Wedge]e[2] + R\ d[v[3]]\[Wedge]e[4] - P\ d[v[4]]\[Wedge]e[1] - Q\ d[v[4]]\[Wedge]e[2] - R\ d[v[4]]\[Wedge]e[3] - F\ v[1]\ e[1]\[Wedge]e[2] + E\ v[2]\ e[1]\[Wedge]e[2] - G\ v[1]\ e[1]\[Wedge]e[3] + E\ v[3]\ e[1]\[Wedge]e[3] - R\ v[2]\ e[1]\[Wedge]e[4] + Q\ v[3]\ e[1]\[Wedge]e[4] - G\ v[2]\ e[2]\[Wedge]e[3] + F\ v[3]\ e[2]\[Wedge]e[3] + R\ v[1]\ e[2]\[Wedge]e[4] - P\ v[3]\ e[2]\[Wedge]e[4] - Q\ v[1]\ e[3]\[Wedge]e[4] + P\ v[2]\ e[3]\[Wedge]e[4]\)], "Output"] }, Open ]], Cell["\<\ To complete the evaluation, d[v[k]], d[P], d[Q], etc., must be \ given in terms of the basis e[a]. For example, consistent with our choice of \ d[e[i]], we can define:\ \>", "Text", FontSize->14], Cell[BoxData[ $d[v[4]] = e[4]; d[v[k_]] = 0; $], "Input"], Cell[BoxData[ $d[x_Symbol] := 0 /; FormDegree[x] === 0$], "Input"], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{ StyleBox["LieDcartan", FontWeight->"Bold"], "[", $vector, test2form$, "]"}]], "Input"], Cell[BoxData[ $\((\(-F$\ v[1] + E\ v[2])\)\ e[1]\[Wedge]e[2] + $(\(-G$\ v[1] + E\ v[3])\)\ e[1]\[Wedge]e[3] + $(P - R\ v[2] + Q\ v[3])$\ e[1]\[Wedge]e[4] + $(\(-G$\ v[2] + F\ v[3])\)\ e[2]\[Wedge]e[3] + $(Q + R\ v[1] - P\ v[3])$\ e[2]\[Wedge]e[4] + $(R - Q\ v[1] + P\ v[2])$\ e[3]\[Wedge]e[4]\)], "Output"] }, Open ]], Cell[TextData[{ "As with ", StyleBox["interiorProduct", FontFamily->"Courier", FontWeight->"Bold"], ", ", StyleBox["LieDcartan", FontFamily->"Courier", FontWeight->"Bold"], " requires a third argument in a coordinate frame:" }], "Text", FontSize->14], Cell[BoxData[ $d[x_Symbol] =. ; d[v[4]] =. ; $], "Input"], Cell[CellGroupData[{ Cell[BoxData[ $LieDcartan[vector, K[x, y, z] d[x]\[Wedge]d[t] + L[x, y, z] d[y]\[Wedge]d[t] + M[x, y, z] d[z]\[Wedge]d[t]]$], "Input"], Cell[BoxData[ $"Must give ordered list of variables (coordinates) as 3rd argument"$], "Output", FontSize->16, FontSlant->"Italic", FontColor->RGBColor[1, 0, 1]], Cell[BoxData[ $"Must give ordered list of variables (coordinates) as 3rd argument"$], "Output", FontSize->16, FontSlant->"Italic", FontColor->RGBColor[1, 0, 1]], Cell[BoxData[ $Null + d[Null]$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $LieDcartan[vector, K[x, y, z] d[x]\[Wedge]d[t] + L[x, y, z] d[y]\[Wedge]d[t] + M[x, y, z] d[z]\[Wedge]d[t], {x, y, z, t}]$], "Input"], Cell[BoxData[ RowBox[{ RowBox[{$d[t]\[Wedge]d[x]$, " ", RowBox[{"(", RowBox[{ RowBox[{$-v[3]$, " ", RowBox[{ SuperscriptBox["K", TagBox[$(0, 0, 1)$, Derivative], MultilineFunction->None], "[", $x, y, z$, "]"}]}], "-", RowBox[{$v[2]$, " ", RowBox[{ SuperscriptBox["K", TagBox[$(0, 1, 0)$, Derivative], MultilineFunction->None], "[", $x, y, z$, "]"}]}], "-", RowBox[{$v[1]$, " ", RowBox[{ SuperscriptBox["K", TagBox[$(1, 0, 0)$, Derivative], MultilineFunction->None], "[", $x, y, z$, "]"}]}]}], ")"}]}], "+", RowBox[{$d[t]\[Wedge]d[y]$, " ", RowBox[{"(", RowBox[{ RowBox[{$-v[3]$, " ", RowBox[{ SuperscriptBox["L", TagBox[$(0, 0, 1)$, Derivative], MultilineFunction->None], "[", $x, y, z$, "]"}]}], "-", RowBox[{$v[2]$, " ", RowBox[{ SuperscriptBox["L", TagBox[$(0, 1, 0)$, Derivative], MultilineFunction->None], "[", $x, y, z$, "]"}]}], "-", RowBox[{$v[1]$, " ", RowBox[{ SuperscriptBox["L", TagBox[$(1, 0, 0)$, Derivative], MultilineFunction->None], "[", $x, y, z$, "]"}]}]}], ")"}]}], "+", RowBox[{$d[t]\[Wedge]d[z]$, " ", RowBox[{"(", RowBox[{ RowBox[{$-v[3]$, " ", RowBox[{ SuperscriptBox["M", TagBox[$(0, 0, 1)$, Derivative], MultilineFunction->None], "[", $x, y, z$, "]"}]}], "-", RowBox[{$v[2]$, " ", RowBox[{ SuperscriptBox["M", TagBox[$(0, 1, 0)$, Derivative], MultilineFunction->None], "[", $x, y, z$, "]"}]}], "-", RowBox[{$v[1]$, " ", RowBox[{ SuperscriptBox["M", TagBox[$(1, 0, 0)$, Derivative], MultilineFunction->None], "[", $x, y, z$, "]"}]}]}], ")"}]}]}]], "Output"] }, Open ]], Cell["", "Text"], Cell[TextData[{ "Note that, because of its definition in terms of ", StyleBox["interiorProduct", FontFamily->"Courier", FontWeight->"Bold"], ", ", StyleBox["LieDcartan", FontFamily->"Courier", FontWeight->"Bold"], " acts on lists as a collection of scalar p-forms and not as the components \ of a tensor. In the combined EDCRGTCcode a second Lie derivative, ", StyleBox["LieD", FontFamily->"Courier", FontWeight->"Bold"], ", is defined that treats lists as the components of a tensor." }], "Text", FontSize->14], Cell["", "Text"], Cell[TextData[{ "The operators ", StyleBox["d", FontWeight->"Bold"], " and ", StyleBox["LieDcartan", FontFamily->"Courier", FontWeight->"Bold"], " commute, even though the calculations cannot be completed, due to \ d[d[anything]]=0:" }], "Text", FontSize->14], Cell[CellGroupData[{ Cell[BoxData[ $reWrite[ d[LieDcartan[vector, test2form]] - LieDcartan[vector, d[test2form]]]$], "Input"], Cell[BoxData[ $"To complete the calculation, all exterior derivatives must be \ expressed in terms of the basis 1-forms!"$], "Output", FontSize->16, FontSlant->"Italic", FontColor->RGBColor[1, 0, 1]], Cell[BoxData[ $"To complete the calculation, all exterior derivatives must be \ expressed in terms of the basis 1-forms!"$], "Output", FontSize->16, FontSlant->"Italic", FontColor->RGBColor[1, 0, 1]], Cell[BoxData[ $0$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $reWrite[ d[LieDcartan[vector, test3form]] - LieDcartan[vector, d[test3form]]]$], "Input"], Cell[BoxData[ $"To complete the calculation, all exterior derivatives must be \ expressed in terms of the basis 1-forms!"$], "Output", FontSize->16, FontSlant->"Italic", FontColor->RGBColor[1, 0, 1]], Cell[BoxData[ $"To complete the calculation, all exterior derivatives must be \ expressed in terms of the basis 1-forms!"$], "Output", FontSize->16, FontSlant->"Italic", FontColor->RGBColor[1, 0, 1]], Cell[BoxData[ $0$], "Output"] }, Open ]], Cell[TextData[{ "For the same reason, even though ", StyleBox["LieDcartan", FontFamily->"Courier", FontWeight->"Bold"], " does not evaluate on symbolic forms, its commutator with ", StyleBox["d", FontWeight->"Bold"], " vanishes:" }], "Text", FontSize->14], Cell[CellGroupData[{ Cell[BoxData[ $LieDcartan[vector, form2]$], "Input"], Cell[BoxData[ $Null + d[interiorProduct[{v[1], v[2], v[3], v[4]}, form2, Null]]$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $reWrite[d[LieDcartan[vector, form2]] - LieDcartan[vector, d[form2]]]$], "Input"], Cell[BoxData[ $0$], "Output"] }, Open ]], Cell[BoxData[ $d[v[k_]] =. ; d[e[i_]] =. ; $], "Input"] }, Closed]], Cell["", "Text"] }, Closed]], Cell["", "Text"], Cell[CellGroupData[{ Cell[" 2.6 Input Palette", "Subsection", ShowGroupOpenCloseIcon->True, FontSize->18], Cell[TextData[{ "\tThe notebook ", StyleBox["EDCpalette.nb", FontWeight->"Bold"], " is an input palette containing most of the new functions/variables, so \ they can be entered easily without misspellings." }], "Text", FontSize->16] }, Closed]], Cell["", "Text"] }, Closed]], Cell[BoxData[""], "Input"], Cell[CellGroupData[{ Cell[TextData[StyleBox[" 3 Examples", FontWeight->"Bold"]], "Section", ShowGroupOpenCloseIcon->True, FontSize->24, FontColor->RGBColor[0, 0, 1]], Cell[TextData[{ "\tAll symbolic calculations with EDC begin with (i) defining symbols for \ the ", StyleBox["basic,", FontSlant->"Italic"], " ", StyleBox["undefined", FontSlant->"Italic"], " forms and matrices one intends to use and (ii) giving definitions for the \ action of ", StyleBox["Wedge, d, tr", FontWeight->"Bold"], ", etc. on these symbols. The following examples illustrate these steps. \ More examples in the notebook ", ButtonBox["matrixEDCexamples.nb", ButtonData:>{ URL[ "http://www.inp.demokritos.gr/~sbonano/EDC/matrixEDCexamples.nb"], None}, ButtonStyle->"Hyperlink"], "." }], "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[" 3.1 Symbolic Identity Matrix", "Subsection", ShowGroupOpenCloseIcon->True, FontSize->18], Cell["\<\ \tAllthough EDC uses the number 1 in symbolic matrix expressions \ for the identity matrix, one can give appropriate definitions to make any \ other symbol behave as a symbolic identity matrix. For example:\ \>", "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $DeclareMatrixForms[{0, IdMat, IdMat}]$], "Input"], Cell[BoxData[ $"OK"$], "Print"] }, Open ]], Cell[BoxData[ $\(tr[IdMat] = matDimension; $\)], "Input"], Cell[BoxData[ $d[IdMat] = 0; Bar[IdMat] = IdMat; $], "Input"], Cell[BoxData[ $\(Wedge[IdMat, IdMat] = IdMat; $\)], "Input"], Cell[BoxData[ $Wedge[IdMat, x_?MatQ] := x; Wedge[x_?MatQ, IdMat] := x; $], "Input"], Cell["These rules are used below:", "Text", TextAlignment->Left, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $Alam = A - lamda*IdMat; \nWedge[Alam, Alam, Alam]$], "Input"], Cell[BoxData[ $3\ A\ lamda\^2 - IdMat\ lamda\^3 - 3\ lamda\ A\[Wedge]A + A\[Wedge]A\[Wedge]A$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $d[%]$], "Input"], Cell[BoxData[ $3\ lamda\^2\ d[A] - 3\ lamda\ A\[Wedge]d[A] - 3\ lamda\ d[A]\[Wedge]A + 6\ lamda\ d[lamda]\[Wedge]A - 3\ lamda\^2\ d[lamda]\[Wedge]IdMat + A\[Wedge]A\[Wedge]d[A] + A\[Wedge]d[A]\[Wedge]A + d[A]\[Wedge]A\[Wedge]A - 3\ d[lamda]\[Wedge]A\[Wedge]A$], "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[" 3.2 Polynomial Matrix Algebra", "Subsection", ShowGroupOpenCloseIcon->True, FontSize->18], Cell[TextData[{ "Suppose one wishes to simplify products of polynomials in a matrix \ variable ", StyleBox["Z", FontFamily->"Courier"], ", say in 3 dimensions, using the Cayley-Hamilton theorem. ", StyleBox["EDC", FontWeight->"Bold"], " cannot easily handle the notation ", StyleBox["Z^n", FontFamily->"Courier"], " for powers of a matrix, but one can use the notation ", StyleBox["Z[n]", FontFamily->"Courier"], " for the n-th power of the matrix ", StyleBox["Z[1] ", FontFamily->"Courier"], "and define appropriate rules for wedge-products of ", StyleBox["Z[k_]", FontFamily->"Courier"], " matrices", StyleBox[".", FontFamily->"Courier"], " Thus" }], "Text", TextJustification->0, FontSize->14], Cell[CellGroupData[{ Cell[BoxData[ $DeclareMatrixForms[{0, Z[_], Z[_]}]$], "Input"], Cell[BoxData[ $"OK"$], "Print"] }, Open ]], Cell[BoxData[ $\(Z[i_]\[Wedge]Z[k_] := Z[i + k]; $\)], "Input"], Cell[TextData[{ " Use the Cayley-Hamilton Theorem to reduce the ", StyleBox["Z[k]", FontFamily->"Courier"], " " }], "Text", FontSize->14], Cell[CellGroupData[{ Cell[BoxData[ $CH3 = CHrule[3, Z[1]]$], "Input"], Cell[BoxData[ ${Z[3] \[Rule] 1\/6\ tr[Z[1]]\^3 - 1\/2\ tr[Z[1]]\ tr[Z[2]] + 1\/3\ tr[Z[3]] + \((\(-\(1\/2$\)\ tr[Z[1]]\^2 + 1\/2\ tr[Z[2]])\)\ Z[1] + tr[Z[1]]\ Z[2]}\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $CH3rhs = \(CH3[\([1]$]\)[$[2]$]\)], "Input"], Cell[BoxData[ $1\/6\ tr[Z[1]]\^3 - 1\/2\ tr[Z[1]]\ tr[Z[2]] + 1\/3\ tr[Z[3]] + \((\(-\(1\/2$\)\ tr[Z[1]]\^2 + 1\/2\ tr[Z[2]])\)\ Z[1] + tr[Z[1]]\ Z[2]\)], "Output"] }, Open ]], Cell[" For simplicity (and to avoid infinite loops!) set", "Text", FontSize->14], Cell[BoxData[ $tr[Z[1]] = s1; tr[Z[2]] = s2; tr[Z[3]] = s3; $], "Input"], Cell[CellGroupData[{ Cell[BoxData[ $CH3rhs$], "Input"], Cell[BoxData[ $s1\^3\/6 - \(s1\ s2$\/2 + s3\/3 + $(\(-\(s1\^2\/2$\) + s2\/2)\)\ Z[1] + s1\ Z[2]\)], "Output"] }, Open ]], Cell[TextData[{ "In this notation ", StyleBox["Z[0]", FontFamily->"Courier"], " is the identity matrix. One can either set ", StyleBox["Z[0]=1", FontFamily->"Courier"], ", or set ", StyleBox["Z[0]=IdMat", FontFamily->"Courier"], " (defined in Example 3.1). For this example however, as only products with \ ", StyleBox["Z[i]", FontFamily->"Courier"], " are involved, it is enough to set" }], "Text", FontSize->14], Cell[BoxData[ $\(\ \(tr[Z[0]] = 3; $\)\)], "Input"], Cell[TextData[{ "and use ", StyleBox["Z[0]", FontFamily->"Courier"], " to rewrite ", StyleBox["CH3rhs", FontFamily->"Courier"], ":" }], "Text", FontSize->14], Cell[CellGroupData[{ Cell[BoxData[ $CH3rhs = reWrite[CH3rhs\[Wedge]Z[0]]$], "Input"], Cell[BoxData[ $1\/6\ \((s1\^3 - 3\ s1\ s2 + 2\ s3)$\ Z[0] + 1\/2\ $(\(-s1\^2$ + s2)\)\ Z[1] + s1\ Z[2]\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{$reWrite[tr[%]]$, RowBox[{"(*", RowBox[{ RowBox[{"*", " ", StyleBox["check", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["that", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["trace", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["of", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["CHrhs", FontColor->RGBColor[0, 0, 1]]}], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["=", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox[$tr[Z[3]]$, FontColor->RGBColor[0, 0, 1]]}], " ", "**)"}]}]], "Input"], Cell[BoxData[ $s3$], "Output"] }, Open ]], Cell[TextData[{ "Now define rules for simplifying ", StyleBox["Z[i]", FontFamily->"Courier"], " matrices" }], "Text", FontSize->14], Cell[BoxData[ $Z[i_ /; i > 2] := reWrite[Z[i - 3]\[Wedge]CH3rhs]$], "Input"], Cell["\<\ With these rules one can calculate arbitrary powers of polynomials \ in the given matrix:\ \>", "Text", FontSize->14], Cell[CellGroupData[{ Cell[BoxData[ $Z[10] // Timing$], "Input"], Cell[BoxData[ ${0.149999999999998578`\ Second, 1\/144\ \((s1\^3 - 3\ s1\ s2 + 2\ s3)$\ $(s1\^7 - 3\ s1\^5\ s2 - 9\ s1\^3\ s2\^2 + 3\ s1\ s2\^3 + 6\ s1\^4\ s3 + 12\ s1\^2\ s2\ s3 + 6\ s2\^2\ s3 + 8\ s1\ s3\^2) $\ Z[0] - 1\/108\ $(s1\^3 - s3)$\ $(s1\^6 - 27\ s1\^2\ s2\^2 + 18\ s2\^3 + 4\ s1\^3\ s3 + 36\ s1\ s2\ s3 + 4\ s3\^2)$\ Z[1] + 1\/48\ $( s1\^8 - 2\ s1\^6\ s2 - 12\ s1\^4\ s2\^2 - 6\ s1\^2\ s2\^3 + 3\ s2\^4 + 8\ s1\^5\ s3 + 24\ s1\ s2\^2\ s3 + 24\ s1\^2\ s3\^2 + 8\ s2\ s3\^2)$\ Z[2]}\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $reWrite[Z[5]\[Wedge]Z[7]] // Timing$], "Input"], Cell[BoxData[ ${0.199999999999999289`\ Second, \(1\/2592\(( \((s1\^3 - 3\ s1\ s2 + 2\ s3)$\ $(5\ s1\^9 - 18\ s1\^7\ s2 - 126\ s1\^3\ s2\^3 + 27\ s1\ s2\^4 + 60\ s1\^6\ s3 - 144\ s1\^4\ s2\ s3 + 108\ s1\^2\ s2\^2\ s3 + 72\ s2\^3\ s3 + 216\ s1\^3\ s3\^2 + 216\ s1\ s2\ s3\^2 + 16\ s3\^3)$\ Z[0])\)\) - 1\/432\ $(s1\^3 - s3)$\ $(s1\^8 - 4\ s1\^6\ s2 + 18\ s1\^4\ s2\^2 - 108\ s1\^2\ s2\^3 + 45\ s2\^4 + 16\ s1\^5\ s3 - 64\ s1\^3\ s2\ s3 + 144\ s1\ s2\^2\ s3 + 64\ s1\^2\ s3\^2 + 32\ s2\ s3\^2)$\ Z[1] + 1\/864\ $(7\ s1\^10 - 45\ s1\^8\ s2 + 90\ s1\^6\ s2\^2 - 126\ s1\^4\ s2\^3 - 81\ s1\^2\ s2\^4 + 27\ s2\^5 + 96\ s1\^7\ s3 - 288\ s1\^5\ s2\ s3 - 288\ s1\^3\ s2\^2\ s3 + 288\ s1\ s2\^3\ s3 + 336\ s1\^4\ s3\^2 + 576\ s1\^2\ s2\ s3\^2 + 144\ s2\^2\ s3\^2 + 128\ s1\ s3\^3)$\ Z[2]}\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $matPoly = Z[0] + k1\ Z[1] + k2\ Z[2]$], "Input"], Cell[BoxData[ $Z[0] + k1\ Z[1] + k2\ Z[2]$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $reWrite[matPoly\[Wedge]matPoly\[Wedge]matPoly] // Timing$], "Input"], Cell[BoxData[ ${0.25`\ Second, 1\/36\ \(( 36 + 6\ k1\^3\ s1\^3 + 36\ k1\ k2\ s1\^3 + 18\ k1\^2\ k2\ s1\^4 + 18\ k2\^2\ s1\^4 + 9\ k1\ k2\^2\ s1\^5 + k2\^3\ s1\^6 - 18\ k1\^3\ s1\ s2 - 108\ k1\ k2\ s1\ s2 - 54\ k1\^2\ k2\ s1\^2\ s2 - 54\ k2\^2\ s1\^2\ s2 - 18\ k1\ k2\^2\ s1\^3\ s2 - 27\ k1\ k2\^2\ s1\ s2\^2 - 9\ k2\^3\ s1\^2\ s2\^2 + 12\ k1\^3\ s3 + 72\ k1\ k2\ s3 + 36\ k1\^2\ k2\ s1\ s3 + 36\ k2\^2\ s1\ s3 + 18\ k1\ k2\^2\ s1\^2\ s3 + 4\ k2\^3\ s1\^3\ s3 + 18\ k1\ k2\^2\ s2\ s3 + 4\ k2\^3\ s3\^2)$\ Z[0] + 1\/12\ $( 36\ k1 - 6\ k1\^3\ s1\^2 - 36\ k1\ k2\ s1\^2 - 12\ k1\^2\ k2\ s1\^3 - 12\ k2\^2\ s1\^3 - 3\ k1\ k2\^2\ s1\^4 + 6\ k1\^3\ s2 + 36\ k1\ k2\ s2 - 18\ k1\ k2\^2\ s1\^2\ s2 - 4\ k2\^3\ s1\^3\ s2 + 9\ k1\ k2\^2\ s2\^2 + 12\ k1\^2\ k2\ s3 + 12\ k2\^2\ s3 + 12\ k1\ k2\^2\ s1\ s3 + 4\ k2\^3\ s2\ s3)$\ Z[1] + 1\/12\ $(36\ k1\^2 + 36\ k2 + 12\ k1\^3\ s1 + 72\ k1\ k2\ s1 + 18\ k1\^2\ k2\ s1\^2 + 18\ k2\^2\ s1\^2 + 6\ k1\ k2\^2\ s1\^3 + k2\^3\ s1\^4 + 18\ k1\^2\ k2\ s2 + 18\ k2\^2\ s2 + 18\ k1\ k2\^2\ s1\ s2 + 3\ k2\^3\ s2\^2 + 12\ k1\ k2\^2\ s3 + 8\ k2\^3\ s1\ s3)$\ Z[2]}\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[TextData[{ StyleBox["Finding the inverse of ", FontSize->14], StyleBox["matPoly", FontFamily->"Courier", FontSize->14] }], "Subsubsection", ShowGroupOpenCloseIcon->True, FontSize->12], Cell["\<\ Take a linear combination of the powers of the given matrix, and \ determine the coefficients by requiring that it is the inverse of the matrix \ polynomial matPoly:\ \>", "Text", FontSize->14], Cell[CellGroupData[{ Cell[BoxData[ $testPoly = Sum[a[i] Z[i], {i, 0, 2}]$], "Input"], Cell[BoxData[ $a[0]\ Z[0] + a[1]\ Z[1] + a[2]\ Z[2]$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $zer0 = reWrite[testPoly\[Wedge]matPoly - Z[0]]$], "Input"], Cell[BoxData[ $1\/6\ \((\(-6$ + 6\ a[0] + k2\ s1\^3\ a[1] - 3\ k2\ s1\ s2\ a[1] + 2\ k2\ s3\ a[1] + k1\ s1\^3\ a[2] + k2\ s1\^4\ a[2] - 3\ k1\ s1\ s2\ a[2] - 3\ k2\ s1\^2\ s2\ a[2] + 2\ k1\ s3\ a[2] + 2\ k2\ s1\ s3\ a[2])\)\ Z[0] + 1\/6\ $(6\ k1\ a[0] + 6\ a[1] - 3\ k2\ s1\^2\ a[1] + 3\ k2\ s2\ a[1] - 3\ k1\ s1\^2\ a[2] - 2\ k2\ s1\^3\ a[2] + 3\ k1\ s2\ a[2] + 2\ k2\ s3\ a[2])$\ Z[1] + 1\/2\ $(2\ k2\ a[0] + 2\ k1\ a[1] + 2\ k2\ s1\ a[1] + 2\ a[2] + 2\ k1\ s1\ a[2] + k2\ s1\^2\ a[2] + k2\ s2\ a[2])$\ Z[2]\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $eqs = {zer0 /. Z[0] -> 1, zer0 /. Z[1] -> 1, zer0 /. Z[2] -> 1} /. Z[_] -> 0$], "Input"], Cell[BoxData[ ${1\/6\ \((\(-6$ + 6\ a[0] + k2\ s1\^3\ a[1] - 3\ k2\ s1\ s2\ a[1] + 2\ k2\ s3\ a[1] + k1\ s1\^3\ a[2] + k2\ s1\^4\ a[2] - 3\ k1\ s1\ s2\ a[2] - 3\ k2\ s1\^2\ s2\ a[2] + 2\ k1\ s3\ a[2] + 2\ k2\ s1\ s3\ a[2])\), 1\/6\ $(6\ k1\ a[0] + 6\ a[1] - 3\ k2\ s1\^2\ a[1] + 3\ k2\ s2\ a[1] - 3\ k1\ s1\^2\ a[2] - 2\ k2\ s1\^3\ a[2] + 3\ k1\ s2\ a[2] + 2\ k2\ s3\ a[2])$, 1\/2\ $(2\ k2\ a[0] + 2\ k1\ a[1] + 2\ k2\ s1\ a[1] + 2\ a[2] + 2\ k1\ s1\ a[2] + k2\ s1\^2\ a[2] + k2\ s2\ a[2])$}\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $invPolyRul = \(Solve[eqs == 0, {a[0], a[1], a[2]}]$[$[1]$]\)], "Input"], Cell[BoxData[ ${a[0] \[Rule] \(-\(\((\((2 + 2\ k1\ s1 + k2\ s1\^2 + k2\ s2)$\ $(\(-\(1\/2$\)\ k1\ $(2\ k1 + 2\ k2\ s1)$ + 1\/6\ k2\ $(6 - 3\ k2\ s1\^2 + 3\ k2\ s2)$)\))\)/ $(2\ \(( \(-\((\(-\(1\/2$\)\ k1\ $( 2 + 2\ k1\ s1 + k2\ s1\^2 + k2\ s2)$ + 1\/6\ k2\ $( \(-3$\ k1\ s1\^2 - 2\ k2\ s1\^3 + 3\ k1\ s2 + 2\ k2\ s3)\))\)\)\ $(1\/2\ \((\(-2$\ k1 - 2\ k2\ s1)\) + 1\/6\ k2\ $( k2\ s1\^3 - 3\ k2\ s1\ s2 + 2\ k2\ s3)$)\) + $(\(-\(1\/2$\)\ k1\ $(2\ k1 + 2\ k2\ s1)$ + 1\/6\ k2\ $(6 - 3\ k2\ s1\^2 + 3\ k2\ s2)$)\)\ $(1\/2\ \((\(-2$ - 2\ k1\ s1 - k2\ s1\^2 - k2\ s2)\) + 1\/6\ k2\ $( k1\ s1\^3 + k2\ s1\^4 - 3\ k1\ s1\ s2 - 3\ k2\ s1\^2\ s2 + 2\ k1\ s3 + 2\ k2\ s1\ s3) $)\))\))\)\)\) + $(\((2\ k1 + 2\ k2\ s1)$\ $(\(-\(1\/2$\)\ k1\ $(2 + 2\ k1\ s1 + k2\ s1\^2 + k2\ s2) $ + 1\/6\ k2\ $( \(-3$\ k1\ s1\^2 - 2\ k2\ s1\^3 + 3\ k1\ s2 + 2\ k2\ s3)\))\))\)/ $(2\ \(( \(-\((\(-\(1\/2$\)\ k1\ $( 2 + 2\ k1\ s1 + k2\ s1\^2 + k2\ s2)$ + 1\/6\ k2\ $( \(-3$\ k1\ s1\^2 - 2\ k2\ s1\^3 + 3\ k1\ s2 + 2\ k2\ s3)\))\)\)\ $(1\/2\ \((\(-2$\ k1 - 2\ k2\ s1)\) + 1\/6\ k2\ $(k2\ s1\^3 - 3\ k2\ s1\ s2 + 2\ k2\ s3) $)\) + $(\(-\(1\/2$\)\ k1\ $(2\ k1 + 2\ k2\ s1)$ + 1\/6\ k2\ $(6 - 3\ k2\ s1\^2 + 3\ k2\ s2)$)\)\ $(1\/2\ \((\(-2$ - 2\ k1\ s1 - k2\ s1\^2 - k2\ s2)\) + 1\/6\ k2\ $( k1\ s1\^3 + k2\ s1\^4 - 3\ k1\ s1\ s2 - 3\ k2\ s1\^2\ s2 + 2\ k1\ s3 + 2\ k2\ s1\ s3)$) \))\))\), a[1] \[Rule] $-\(\((k2\ \(( \(-\(1\/2$\)\ k1\ $(2 + 2\ k1\ s1 + k2\ s1\^2 + k2\ s2)$ + 1\/6\ k2\ $( \(-3$\ k1\ s1\^2 - 2\ k2\ s1\^3 + 3\ k1\ s2 + 2\ k2\ s3) \))\))\)/ $(\(-\((\(-\(1\/2$\)\ k1\ $(2 + 2\ k1\ s1 + k2\ s1\^2 + k2\ s2) $ + 1\/6\ k2\ $( \(-3$\ k1\ s1\^2 - 2\ k2\ s1\^3 + 3\ k1\ s2 + 2\ k2\ s3)\))\)\)\ $(1\/2\ \((\(-2$\ k1 - 2\ k2\ s1)\) + 1\/6\ k2\ $(k2\ s1\^3 - 3\ k2\ s1\ s2 + 2\ k2\ s3)$) \) + $( \(-\(1\/2$\)\ k1\ $(2\ k1 + 2\ k2\ s1)$ + 1\/6\ k2\ $(6 - 3\ k2\ s1\^2 + 3\ k2\ s2)$)\)\ $(1\/2\ \((\(-2$ - 2\ k1\ s1 - k2\ s1\^2 - k2\ s2)\) + 1\/6\ k2\ $( k1\ s1\^3 + k2\ s1\^4 - 3\ k1\ s1\ s2 - 3\ k2\ s1\^2\ s2 + 2\ k1\ s3 + 2\ k2\ s1\ s3)$)\)) \)\)\), a[2] \[Rule] $(k2\ \(( \(-\(1\/2$\)\ k1\ $(2\ k1 + 2\ k2\ s1)$ + 1\/6\ k2\ $(6 - 3\ k2\ s1\^2 + 3\ k2\ s2)$)\))\)/ $(\(-\((\(-\(1\/2$\)\ k1\ $(2 + 2\ k1\ s1 + k2\ s1\^2 + k2\ s2) $ + 1\/6\ k2\ $( \(-3$\ k1\ s1\^2 - 2\ k2\ s1\^3 + 3\ k1\ s2 + 2\ k2\ s3)\))\)\)\ $(1\/2\ \((\(-2$\ k1 - 2\ k2\ s1)\) + 1\/6\ k2\ $(k2\ s1\^3 - 3\ k2\ s1\ s2 + 2\ k2\ s3)$) \) + $( \(-\(1\/2$\)\ k1\ $(2\ k1 + 2\ k2\ s1)$ + 1\/6\ k2\ $(6 - 3\ k2\ s1\^2 + 3\ k2\ s2)$)\)\ $(1\/2\ \((\(-2$ - 2\ k1\ s1 - k2\ s1\^2 - k2\ s2)\) + 1\/6\ k2\ $( k1\ s1\^3 + k2\ s1\^4 - 3\ k1\ s1\ s2 - 3\ k2\ s1\^2\ s2 + 2\ k1\ s3 + 2\ k2\ s1\ s3)$)\))\)} \)], "Output"] }, Closed]], Cell[CellGroupData[{ Cell[BoxData[ $invPolyRul = reWrite[invPolyRul]$], "Input"], Cell[BoxData[ ${a[0] \[Rule] \((3\ \(( 12 + 12\ k1\ s1 + 6\ k1\^2\ s1\^2 + 4\ k1\ k2\ s1\^3 + k2\^2\ s1\^4 - 6\ k1\^2\ s2 + 12\ k2\ s2 + 3\ k2\^2\ s2\^2 - 4\ k1\ k2\ s3 - 4\ k2\^2\ s1\ s3)$)\)/ $(36 + 36\ k1\ s1 + 18\ k1\^2\ s1\^2 + 6\ k1\^3\ s1\^3 + 6\ k1\^2\ k2\ s1\^4 - 3\ k2\^2\ s1\^4 + 3\ k1\ k2\^2\ s1\^5 + k2\^3\ s1\^6 - 18\ k1\^2\ s2 + 36\ k2\ s2 - 18\ k1\^3\ s1\ s2 + 36\ k1\ k2\ s1\ s2 - 18\ k1\^2\ k2\ s1\^2\ s2 + 18\ k2\^2\ s1\^2\ s2 - 12\ k1\ k2\^2\ s1\^3\ s2 - 6\ k2\^3\ s1\^4\ s2 + 9\ k2\^2\ s2\^2 + 9\ k1\ k2\^2\ s1\ s2\^2 + 9\ k2\^3\ s1\^2\ s2\^2 + 12\ k1\^3\ s3 - 36\ k1\ k2\ s3 + 12\ k1\^2\ k2\ s1\ s3 - 24\ k2\^2\ s1\ s3 + 6\ k1\ k2\^2\ s1\^2\ s3 + 4\ k2\^3\ s1\^3\ s3 - 6\ k1\ k2\^2\ s2\ s3 - 12\ k2\^3\ s1\ s2\ s3 + 4\ k2\^3\ s3\^2)$, a[1] \[Rule] $-\(\((12\ \((3\ k1 + 3\ k1\^2\ s1 + 3\ k1\ k2\ s1\^2 + k2\^2\ s1\^3 - k2\^2\ s3)$)\)/ $(36 + 36\ k1\ s1 + 18\ k1\^2\ s1\^2 + 6\ k1\^3\ s1\^3 + 6\ k1\^2\ k2\ s1\^4 - 3\ k2\^2\ s1\^4 + 3\ k1\ k2\^2\ s1\^5 + k2\^3\ s1\^6 - 18\ k1\^2\ s2 + 36\ k2\ s2 - 18\ k1\^3\ s1\ s2 + 36\ k1\ k2\ s1\ s2 - 18\ k1\^2\ k2\ s1\^2\ s2 + 18\ k2\^2\ s1\^2\ s2 - 12\ k1\ k2\^2\ s1\^3\ s2 - 6\ k2\^3\ s1\^4\ s2 + 9\ k2\^2\ s2\^2 + 9\ k1\ k2\^2\ s1\ s2\^2 + 9\ k2\^3\ s1\^2\ s2\^2 + 12\ k1\^3\ s3 - 36\ k1\ k2\ s3 + 12\ k1\^2\ k2\ s1\ s3 - 24\ k2\^2\ s1\ s3 + 6\ k1\ k2\^2\ s1\^2\ s3 + 4\ k2\^3\ s1\^3\ s3 - 6\ k1\ k2\^2\ s2\ s3 - 12\ k2\^3\ s1\ s2\ s3 + 4\ k2\^3\ s3\^2)$\)\), a[2] \[Rule] $(18\ \((2\ k1\^2 - 2\ k2 + 2\ k1\ k2\ s1 + k2\^2\ s1\^2 - k2\^2\ s2) $)\)/$( 36 + 36\ k1\ s1 + 18\ k1\^2\ s1\^2 + 6\ k1\^3\ s1\^3 + 6\ k1\^2\ k2\ s1\^4 - 3\ k2\^2\ s1\^4 + 3\ k1\ k2\^2\ s1\^5 + k2\^3\ s1\^6 - 18\ k1\^2\ s2 + 36\ k2\ s2 - 18\ k1\^3\ s1\ s2 + 36\ k1\ k2\ s1\ s2 - 18\ k1\^2\ k2\ s1\^2\ s2 + 18\ k2\^2\ s1\^2\ s2 - 12\ k1\ k2\^2\ s1\^3\ s2 - 6\ k2\^3\ s1\^4\ s2 + 9\ k2\^2\ s2\^2 + 9\ k1\ k2\^2\ s1\ s2\^2 + 9\ k2\^3\ s1\^2\ s2\^2 + 12\ k1\^3\ s3 - 36\ k1\ k2\ s3 + 12\ k1\^2\ k2\ s1\ s3 - 24\ k2\^2\ s1\ s3 + 6\ k1\ k2\^2\ s1\^2\ s3 + 4\ k2\^3\ s1\^3\ s3 - 6\ k1\ k2\^2\ s2\ s3 - 12\ k2\^3\ s1\ s2\ s3 + 4\ k2\^3\ s3\^2)$}\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $invPoly = reWrite[testPoly /. invPolyRul]$], "Input"], Cell[BoxData[ $\((3\ \((12 + 12\ k1\ s1 + 6\ k1\^2\ s1\^2 + 4\ k1\ k2\ s1\^3 + k2\^2\ s1\^4 - 6\ k1\^2\ s2 + 12\ k2\ s2 + 3\ k2\^2\ s2\^2 - 4\ k1\ k2\ s3 - 4\ k2\^2\ s1\ s3)$\ Z[0])\)/ $(36 + 36\ k1\ s1 + 18\ k1\^2\ s1\^2 + 6\ k1\^3\ s1\^3 + 6\ k1\^2\ k2\ s1\^4 - 3\ k2\^2\ s1\^4 + 3\ k1\ k2\^2\ s1\^5 + k2\^3\ s1\^6 - 18\ k1\^2\ s2 + 36\ k2\ s2 - 18\ k1\^3\ s1\ s2 + 36\ k1\ k2\ s1\ s2 - 18\ k1\^2\ k2\ s1\^2\ s2 + 18\ k2\^2\ s1\^2\ s2 - 12\ k1\ k2\^2\ s1\^3\ s2 - 6\ k2\^3\ s1\^4\ s2 + 9\ k2\^2\ s2\^2 + 9\ k1\ k2\^2\ s1\ s2\^2 + 9\ k2\^3\ s1\^2\ s2\^2 + 12\ k1\^3\ s3 - 36\ k1\ k2\ s3 + 12\ k1\^2\ k2\ s1\ s3 - 24\ k2\^2\ s1\ s3 + 6\ k1\ k2\^2\ s1\^2\ s3 + 4\ k2\^3\ s1\^3\ s3 - 6\ k1\ k2\^2\ s2\ s3 - 12\ k2\^3\ s1\ s2\ s3 + 4\ k2\^3\ s3\^2) $ - $(12\ \((3\ k1 + 3\ k1\^2\ s1 + 3\ k1\ k2\ s1\^2 + k2\^2\ s1\^3 - k2\^2\ s3)$\ Z[1])\)/ $(36 + 36\ k1\ s1 + 18\ k1\^2\ s1\^2 + 6\ k1\^3\ s1\^3 + 6\ k1\^2\ k2\ s1\^4 - 3\ k2\^2\ s1\^4 + 3\ k1\ k2\^2\ s1\^5 + k2\^3\ s1\^6 - 18\ k1\^2\ s2 + 36\ k2\ s2 - 18\ k1\^3\ s1\ s2 + 36\ k1\ k2\ s1\ s2 - 18\ k1\^2\ k2\ s1\^2\ s2 + 18\ k2\^2\ s1\^2\ s2 - 12\ k1\ k2\^2\ s1\^3\ s2 - 6\ k2\^3\ s1\^4\ s2 + 9\ k2\^2\ s2\^2 + 9\ k1\ k2\^2\ s1\ s2\^2 + 9\ k2\^3\ s1\^2\ s2\^2 + 12\ k1\^3\ s3 - 36\ k1\ k2\ s3 + 12\ k1\^2\ k2\ s1\ s3 - 24\ k2\^2\ s1\ s3 + 6\ k1\ k2\^2\ s1\^2\ s3 + 4\ k2\^3\ s1\^3\ s3 - 6\ k1\ k2\^2\ s2\ s3 - 12\ k2\^3\ s1\ s2\ s3 + 4\ k2\^3\ s3\^2) $ + $(18\ \((2\ k1\^2 - 2\ k2 + 2\ k1\ k2\ s1 + k2\^2\ s1\^2 - k2\^2\ s2) $\ Z[2])\)/ $(36 + 36\ k1\ s1 + 18\ k1\^2\ s1\^2 + 6\ k1\^3\ s1\^3 + 6\ k1\^2\ k2\ s1\^4 - 3\ k2\^2\ s1\^4 + 3\ k1\ k2\^2\ s1\^5 + k2\^3\ s1\^6 - 18\ k1\^2\ s2 + 36\ k2\ s2 - 18\ k1\^3\ s1\ s2 + 36\ k1\ k2\ s1\ s2 - 18\ k1\^2\ k2\ s1\^2\ s2 + 18\ k2\^2\ s1\^2\ s2 - 12\ k1\ k2\^2\ s1\^3\ s2 - 6\ k2\^3\ s1\^4\ s2 + 9\ k2\^2\ s2\^2 + 9\ k1\ k2\^2\ s1\ s2\^2 + 9\ k2\^3\ s1\^2\ s2\^2 + 12\ k1\^3\ s3 - 36\ k1\ k2\ s3 + 12\ k1\^2\ k2\ s1\ s3 - 24\ k2\^2\ s1\ s3 + 6\ k1\ k2\^2\ s1\^2\ s3 + 4\ k2\^3\ s1\^3\ s3 - 6\ k1\ k2\^2\ s2\ s3 - 12\ k2\^3\ s1\ s2\ s3 + 4\ k2\^3\ s3\^2) $\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{$reWrite[matPoly\[Wedge]invPoly]$, RowBox[{"(*", RowBox[{"*", " ", StyleBox["check", FontColor->RGBColor[0, 0, 1]], StyleBox[" ", FontColor->RGBColor[0, 0, 1]], StyleBox["inverse", FontColor->RGBColor[0, 0, 1]]}], " ", "**)"}]}]], "Input"], Cell[BoxData[ $Z[0]$], "Output"] }, Open ]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[" 3.3 SU(2) Trace Calculations", "Subsection", ShowGroupOpenCloseIcon->True, FontSize->18], Cell[BoxData[ $\(Off[General::"\", General::"\"]; $\)], "Input"], Cell["\<\ Introduce notation and define properties of the Pauli \ matrices:\ \>", "Text", FontSize->14], Cell[CellGroupData[{ Cell[BoxData[ $DeclareMatrixForms[{0, \[Sigma][_], \[Sigma]t[_]}]$], "Input"], Cell[BoxData[ $"OK"$], "Print"] }, Open ]], Cell[BoxData[ $\(tr[\[Sigma][a_]] = 0; $\)], "Input"], Cell[BoxData[ $\(matDimension = 2; $\)], "Input"], Cell[BoxData[ $delta[a_, b_] := If[a === b, 1, 0]; \n epsilon[a_, b_, c_] := Signature[{a, b, c}]; $], "Input"], Cell[BoxData[ $\[Sigma][a_]\[Wedge]\[Sigma][b_] := delta[a, b] + I\ Sum[epsilon[a, b, c] \[Sigma][c], {c, 3}]$], "Input"], Cell["Define A, B to be two SU(2) algebra vectors:", "Text", FontSize->14], Cell[CellGroupData[{ Cell[BoxData[ $A = Sum[a[i] \[Sigma][i], {i, 3}]$], "Input"], Cell[BoxData[ $a[1]\ \[Sigma][1] + a[2]\ \[Sigma][2] + a[3]\ \[Sigma][3]$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $B = Sum[b[i] \[Sigma][i], {i, 3}]$], "Input"], Cell[BoxData[ $b[1]\ \[Sigma][1] + b[2]\ \[Sigma][2] + b[3]\ \[Sigma][3]$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $reWrite[A\[Wedge]B]$], "Input"], Cell[BoxData[ $a[1]\ b[1] + a[2]\ b[2] + a[3]\ b[3] - I\ \((a[3]\ b[2] - a[2]\ b[3])$\ \[Sigma][1] + I\ $(a[3]\ b[1] - a[1]\ b[3])$\ \[Sigma][2] - I\ $(a[2]\ b[1] - a[1]\ b[2])$\ \[Sigma][3]\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $reWrite[tr[A\[Wedge]B]]$], "Input"], Cell[BoxData[ $2\ \((a[1]\ b[1] + a[2]\ b[2] + a[3]\ b[3])$\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $reWrite[tr[A\[Wedge]A\[Wedge]B]]$], "Input"], Cell[BoxData[ $0$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $reWrite[tr[A\[Wedge]A\[Wedge]B\[Wedge]B]]$], "Input"], Cell[BoxData[ $2\ \((a[1]\^2 + a[2]\^2 + a[3]\^2)$\ $(b[1]\^2 + b[2]\^2 + b[3]\^2)$\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $reWrite[tr[A\[Wedge]B\[Wedge]A\[Wedge]B]]$], "Input"], Cell[BoxData[ $2\ \(( a[1]\^2\ b[1]\^2 - a[2]\^2\ b[1]\^2 - a[3]\^2\ b[1]\^2 + 4\ a[1]\ a[2]\ b[1]\ b[2] - a[1]\^2\ b[2]\^2 + a[2]\^2\ b[2]\^2 - a[3]\^2\ b[2]\^2 + 4\ a[1]\ a[3]\ b[1]\ b[3] + 4\ a[2]\ a[3]\ b[2]\ b[3] - a[1]\^2\ b[3]\^2 - a[2]\^2\ b[3]\^2 + a[3]\^2\ b[3]\^2)$\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $reWrite[tr[A\[Wedge]A\[Wedge]B\[Wedge]B\[Wedge]A\[Wedge]B]] // Timing $], "Input"], Cell[BoxData[ ${1.13333333333333641`\ Second, 2\ \((a[1]\^2 + a[2]\^2 + a[3]\^2)$\ $(a[1]\ b[1] + a[2]\ b[2] + a[3]\ b[3])$\ $(b[1]\^2 + b[2]\^2 + b[3]\^2)$}\)], "Output"] }, Open ]], Cell[BoxData[ $Clear[matDimension, A, B]; On[General::"\", General::"\"]; $], "Input"] }, Closed]], Cell[CellGroupData[{ Cell[" 3.4 Non-commutative Algebra: Applying Commutators", "Subsection", ShowGroupOpenCloseIcon->True, FontSize->18], Cell[TextData[{ "\tA common type of calculation involves evaluation of polynomial \ expressions in non-commuting variables. For such calculations one introduces \ symbolic matrices for these variables and gives appropriate ", StyleBox["Wedge", FontWeight->"Bold"], " rules. We will illustrate this with a pair of canonically conjugate \ quantum mechanical variables P, Q, satisfying [Q, P]=I h. As in Example 3.2 \ we will use the notation ", StyleBox["P[n]", FontFamily->"Courier"], " for ", StyleBox["P^n", FontFamily->"Courier"], ". " }], "Text", TextAlignment->Left, TextJustification->0, FontSize->14], Cell[BoxData[ $\(Off[General::"\", General::"\"]; $\)], "Input"], Cell[CellGroupData[{ Cell[BoxData[ $DeclareMatrixForms[{0, P[_], Pt[_]}, {0, Q[_], Qt[_]}]$], "Input"], Cell[BoxData[ $"OK"$], "Print"] }, Open ]], Cell[BoxData[ $P[0] = 1; Q[0] = 1; $], "Input"], Cell[BoxData[ $Wedge[P[m_], P[n_]] := P[m + n]; Wedge[Q[m_], Q[n_]] := Q[m + n]; $], "Input"], Cell[BoxData[ $Wedge[Q[m_], P[n_]] := Wedge[Q[m - 1], Wedge[P[1], Q[1]] + I\ h, P[n - 1]]$], "Input"], Cell[TextData[{ "\tThe last definition implements the commutator; it will be applied \ repeatedly to put P^n before Q^m. \n(To put Q's before P's use: ", StyleBox["Wedge[P[m_],Q[n_]]:=Wedge[P[m-1],Wedge[Q[1],P[1]]-I h,Q[n-1]]", FontWeight->"Bold"], ")." }], "Text", TextAlignment->Left, TextJustification->0, FontSize->14], Cell[CellGroupData[{ Cell[BoxData[ $Wedge[P[2], Q[2]]$], "Input"], Cell[BoxData[ $P[2]\[Wedge]Q[2]$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $Wedge[Q[2], P[2]]$], "Input"], Cell[BoxData[ $2\ I\ h\ P[1]\[Wedge]Q[1] + 2\ I\ h\ \((I\ h + P[1]\[Wedge]Q[1])$ + P[2]\[Wedge]Q[2]\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $reWrite[%]$], "Input"], Cell[BoxData[ $\(-2$\ h\^2 + 4\ I\ h\ P[1]\[Wedge]Q[1] + P[2]\[Wedge]Q[2]\)], "Output"] }, Open ]], Cell["\<\ \tWe will now define 3 polynomials in P,Q with arbitrary \ coefficients:\ \>", "Text", TextAlignment->Left, TextJustification->0, FontSize->14], Cell[CellGroupData[{ Cell[BoxData[ $poly1 = Sum[a[m, n] P[m]\[Wedge]Q[n], {m, 0, 3}, {n, 0, 3}]$], "Input"], Cell[BoxData[ $a[0, 0] + a[1, 0]\ P[1] + a[2, 0]\ P[2] + a[3, 0]\ P[3] + a[0, 1]\ Q[1] + a[0, 2]\ Q[2] + a[0, 3]\ Q[3] + a[1, 1]\ P[1]\[Wedge]Q[1] + a[1, 2]\ P[1]\[Wedge]Q[2] + a[1, 3]\ P[1]\[Wedge]Q[3] + a[2, 1]\ P[2]\[Wedge]Q[1] + a[2, 2]\ P[2]\[Wedge]Q[2] + a[2, 3]\ P[2]\[Wedge]Q[3] + a[3, 1]\ P[3]\[Wedge]Q[1] + a[3, 2]\ P[3]\[Wedge]Q[2] + a[3, 3]\ P[3]\[Wedge]Q[3]$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $poly2 = Sum[b[m, n] P[m]\[Wedge]Q[n], {m, 0, 3}, {n, 0, 3}]$], "Input"], Cell[BoxData[ $b[0, 0] + b[1, 0]\ P[1] + b[2, 0]\ P[2] + b[3, 0]\ P[3] + b[0, 1]\ Q[1] + b[0, 2]\ Q[2] + b[0, 3]\ Q[3] + b[1, 1]\ P[1]\[Wedge]Q[1] + b[1, 2]\ P[1]\[Wedge]Q[2] + b[1, 3]\ P[1]\[Wedge]Q[3] + b[2, 1]\ P[2]\[Wedge]Q[1] + b[2, 2]\ P[2]\[Wedge]Q[2] + b[2, 3]\ P[2]\[Wedge]Q[3] + b[3, 1]\ P[3]\[Wedge]Q[1] + b[3, 2]\ P[3]\[Wedge]Q[2] + b[3, 3]\ P[3]\[Wedge]Q[3]$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $poly3 = Sum[c[m, n] P[m]\[Wedge]Q[n], {m, 0, 3}, {n, 0, 3}]$], "Input"], Cell[BoxData[ $c[0, 0] + c[1, 0]\ P[1] + c[2, 0]\ P[2] + c[3, 0]\ P[3] + c[0, 1]\ Q[1] + c[0, 2]\ Q[2] + c[0, 3]\ Q[3] + c[1, 1]\ P[1]\[Wedge]Q[1] + c[1, 2]\ P[1]\[Wedge]Q[2] + c[1, 3]\ P[1]\[Wedge]Q[3] + c[2, 1]\ P[2]\[Wedge]Q[1] + c[2, 2]\ P[2]\[Wedge]Q[2] + c[2, 3]\ P[2]\[Wedge]Q[3] + c[3, 1]\ P[3]\[Wedge]Q[1] + c[3, 2]\ P[3]\[Wedge]Q[2] + c[3, 3]\ P[3]\[Wedge]Q[3]$], "Output"] }, Open ]], Cell[TextData[{ "\tOne can then compute powers or commutators of these polynomials (", StyleBox["these calculations take long!", FontColor->RGBColor[1, 0, 0]], "):" }], "Text", TextAlignment->Left, TextJustification->0, FontSize->14], Cell[CellGroupData[{ Cell[BoxData[ $reWrite[poly1\[Wedge]poly1]$], "Input"], Cell[BoxData[ $a[0, 0]\^2 + I\ h\ a[0, 1]\ a[1, 0] - 2\ h\^2\ a[0, 2]\ a[2, 0] - 6\ I\ h\^3\ a[0, 3]\ a[3, 0] + \((2\ a[0, 0]\ a[1, 0] + I\ h\ a[1, 0]\ a[1, 1] + 2\ I\ h\ a[0, 1]\ a[2, 0] - 2\ h\^2\ a[1, 2]\ a[2, 0] - 6\ h\^2\ a[0, 2]\ a[3, 0] - 6\ I\ h\^3\ a[1, 3]\ a[3, 0])$\ P[1] + $( a[1, 0]\^2 + 2\ a[0, 0]\ a[2, 0] + 2\ I\ h\ a[1, 1]\ a[2, 0] + I\ h\ a[1, 0]\ a[2, 1] - 2\ h\^2\ a[2, 0]\ a[2, 2] + 3\ I\ h\ a[0, 1]\ a[3, 0] - 6\ h\^2\ a[1, 2]\ a[3, 0] - 6\ I\ h\^3\ a[2, 3]\ a[3, 0])$\ P[2] + $(2\ a[1, 0]\ a[2, 0] + 2\ I\ h\ a[2, 0]\ a[2, 1] + 2\ a[0, 0]\ a[3, 0] + 3\ I\ h\ a[1, 1]\ a[3, 0] - 6\ h\^2\ a[2, 2]\ a[3, 0] + I\ h\ a[1, 0]\ a[3, 1] - 2\ h\^2\ a[2, 0]\ a[3, 2] - 6\ I\ h\^3\ a[3, 0]\ a[3, 3])$\ P[3] + $( a[2, 0]\^2 + 2\ a[1, 0]\ a[3, 0] + 3\ I\ h\ a[2, 1]\ a[3, 0] + 2\ I\ h\ a[2, 0]\ a[3, 1] - 6\ h\^2\ a[3, 0]\ a[3, 2])$\ P[4] + a[3, 0]\ $(2\ a[2, 0] + 3\ I\ h\ a[3, 1])$\ P[5] + a[3, 0]\^2\ P[6] + $(2\ a[0, 0]\ a[0, 1] + 2\ I\ h\ a[0, 2]\ a[1, 0] + I\ h\ a[0, 1]\ a[1, 1] - 6\ h\^2\ a[0, 3]\ a[2, 0] - 2\ h\^2\ a[0, 2]\ a[2, 1] - 6\ I\ h\^3\ a[0, 3]\ a[3, 1])$\ Q[1] + $( a[0, 1]\^2 + 2\ a[0, 0]\ a[0, 2] + 3\ I\ h\ a[0, 3]\ a[1, 0] + 2\ I\ h\ a[0, 2]\ a[1, 1] + I\ h\ a[0, 1]\ a[1, 2] - 6\ h\^2\ a[0, 3]\ a[2, 1] - 2\ h\^2\ a[0, 2]\ a[2, 2] - 6\ I\ h\^3\ a[0, 3]\ a[3, 2])$\ Q[2] + $(2\ a[0, 1]\ a[0, 2] + 2\ a[0, 0]\ a[0, 3] + 3\ I\ h\ a[0, 3]\ a[1, 1] + 2\ I\ h\ a[0, 2]\ a[1, 2] + I\ h\ a[0, 1]\ a[1, 3] - 6\ h\^2\ a[0, 3]\ a[2, 2] - 2\ h\^2\ a[0, 2]\ a[2, 3] - 6\ I\ h\^3\ a[0, 3]\ a[3, 3])$\ Q[3] + $( a[0, 2]\^2 + 2\ a[0, 1]\ a[0, 3] + 3\ I\ h\ a[0, 3]\ a[1, 2] + 2\ I\ h\ a[0, 2]\ a[1, 3] - 6\ h\^2\ a[0, 3]\ a[2, 3])$\ Q[4] + a[0, 3]\ $(2\ a[0, 2] + 3\ I\ h\ a[1, 3])$\ Q[5] + a[0, 3]\^2\ Q[6] + $(2\ a[0, 1]\ a[1, 0] + 2\ a[0, 0]\ a[1, 1] + I\ h\ a[1, 1]\^2 + 2\ I\ h\ a[1, 0]\ a[1, 2] + 4\ I\ h\ a[0, 2]\ a[2, 0] - 6\ h\^2\ a[1, 3]\ a[2, 0] + 2\ I\ h\ a[0, 1]\ a[2, 1] - 2\ h\^2\ a[1, 2]\ a[2, 1] - 18\ h\^2\ a[0, 3]\ a[3, 0] - 6\ h\^2\ a[0, 2]\ a[3, 1] - 6\ I\ h\^3\ a[1, 3]\ a[3, 1])$\ P[1]\[Wedge]Q[1] + $(2\ a[0, 2]\ a[1, 0] + 2\ a[0, 1]\ a[1, 1] + 2\ a[0, 0]\ a[1, 2] + 3\ I\ h\ a[1, 1]\ a[1, 2] + 3\ I\ h\ a[1, 0]\ a[1, 3] + 6\ I\ h\ a[0, 3]\ a[2, 0] + 4\ I\ h\ a[0, 2]\ a[2, 1] - 6\ h\^2\ a[1, 3]\ a[2, 1] + 2\ I\ h\ a[0, 1]\ a[2, 2] - 2\ h\^2\ a[1, 2]\ a[2, 2] - 18\ h\^2\ a[0, 3]\ a[3, 1] - 6\ h\^2\ a[0, 2]\ a[3, 2] - 6\ I\ h\^3\ a[1, 3]\ a[3, 2])$\ P[1]\[Wedge]Q[2] + 2\ $(a[0, 3]\ a[1, 0] + a[0, 2]\ a[1, 1] + a[0, 1]\ a[1, 2] + I\ h\ a[1, 2]\^2 + a[0, 0]\ a[1, 3] + 2\ I\ h\ a[1, 1]\ a[1, 3] + 3\ I\ h\ a[0, 3]\ a[2, 1] + 2\ I\ h\ a[0, 2]\ a[2, 2] - 3\ h\^2\ a[1, 3]\ a[2, 2] + I\ h\ a[0, 1]\ a[2, 3] - h\^2\ a[1, 2]\ a[2, 3] - 9\ h\^2\ a[0, 3]\ a[3, 2] - 3\ h\^2\ a[0, 2]\ a[3, 3] - 3\ I\ h\^3\ a[1, 3]\ a[3, 3])$\ P[1]\[Wedge]Q[3] + $(2\ a[0, 3]\ a[1, 1] + 2\ a[0, 2]\ a[1, 2] + 2\ a[0, 1]\ a[1, 3] + 5\ I\ h\ a[1, 2]\ a[1, 3] + 6\ I\ h\ a[0, 3]\ a[2, 2] + 4\ I\ h\ a[0, 2]\ a[2, 3] - 6\ h\^2\ a[1, 3]\ a[2, 3] - 18\ h\^2\ a[0, 3]\ a[3, 3])$\ P[1]\[Wedge]Q[4] + $(2\ a[0, 3]\ a[1, 2] + 2\ a[0, 2]\ a[1, 3] + 3\ I\ h\ a[1, 3]\^2 + 6\ I\ h\ a[0, 3]\ a[2, 3])$\ P[1]\[Wedge]Q[5] + 2\ a[0, 3]\ a[1, 3]\ P[1]\[Wedge]Q[6] + $(2\ a[1, 0]\ a[1, 1] + 2\ a[0, 1]\ a[2, 0] + 4\ I\ h\ a[1, 2]\ a[2, 0] + 2\ a[0, 0]\ a[2, 1] + 3\ I\ h\ a[1, 1]\ a[2, 1] + 2\ I\ h\ a[1, 0]\ a[2, 2] - 2\ h\^2\ a[2, 1]\ a[2, 2] - 6\ h\^2\ a[2, 0]\ a[2, 3] + 6\ I\ h\ a[0, 2]\ a[3, 0] - 18\ h\^2\ a[1, 3]\ a[3, 0] + 3\ I\ h\ a[0, 1]\ a[3, 1] - 6\ h\^2\ a[1, 2]\ a[3, 1] - 6\ I\ h\^3\ a[2, 3]\ a[3, 1])$\ P[2]\[Wedge]Q[1] + $(a[1, 1]\^2 + 2\ a[1, 0]\ a[1, 2] + 2\ a[0, 2]\ a[2, 0] + 6\ I\ h\ a[1, 3]\ a[2, 0] + 2\ a[0, 1]\ a[2, 1] + 5\ I\ h\ a[1, 2]\ a[2, 1] + 2\ a[0, 0]\ a[2, 2] + 4\ I\ h\ a[1, 1]\ a[2, 2] - 2\ h\^2\ a[2, 2]\^2 + 3\ I\ h\ a[1, 0]\ a[2, 3] - 6\ h\^2\ a[2, 1]\ a[2, 3] + 9\ I\ h\ a[0, 3]\ a[3, 0] + 6\ I\ h\ a[0, 2]\ a[3, 1] - 18\ h\^2\ a[1, 3]\ a[3, 1] + 3\ I\ h\ a[0, 1]\ a[3, 2] - 6\ h\^2\ a[1, 2]\ a[3, 2] - 6\ I\ h\^3\ a[2, 3]\ a[3, 2])$\ P[2]\[Wedge]Q[2] + $(2\ a[1, 1]\ a[1, 2] + 2\ a[1, 0]\ a[1, 3] + 2\ a[0, 3]\ a[2, 0] + 2\ a[0, 2]\ a[2, 1] + 7\ I\ h\ a[1, 3]\ a[2, 1] + 2\ a[0, 1]\ a[2, 2] + 6\ I\ h\ a[1, 2]\ a[2, 2] + 2\ a[0, 0]\ a[2, 3] + 5\ I\ h\ a[1, 1]\ a[2, 3] - 8\ h\^2\ a[2, 2]\ a[2, 3] + 9\ I\ h\ a[0, 3]\ a[3, 1] + 6\ I\ h\ a[0, 2]\ a[3, 2] - 18\ h\^2\ a[1, 3]\ a[3, 2] + 3\ I\ h\ a[0, 1]\ a[3, 3] - 6\ h\^2\ a[1, 2]\ a[3, 3] - 6\ I\ h\^3\ a[2, 3]\ a[3, 3])$\ P[2]\[Wedge]Q[3] + $(a[1, 2]\^2 + 2\ a[1, 1]\ a[1, 3] + 2\ a[0, 3]\ a[2, 1] + 2\ a[0, 2]\ a[2, 2] + 8\ I\ h\ a[1, 3]\ a[2, 2] + 2\ a[0, 1]\ a[2, 3] + 7\ I\ h\ a[1, 2]\ a[2, 3] - 6\ h\^2\ a[2, 3]\^2 + 9\ I\ h\ a[0, 3]\ a[3, 2] + 6\ I\ h\ a[0, 2]\ a[3, 3] - 18\ h\^2\ a[1, 3]\ a[3, 3])$\ P[2]\[Wedge]Q[4] + $(2\ a[1, 2]\ a[1, 3] + 2\ a[0, 3]\ a[2, 2] + 2\ a[0, 2]\ a[2, 3] + 9\ I\ h\ a[1, 3]\ a[2, 3] + 9\ I\ h\ a[0, 3]\ a[3, 3])$\ P[2]\[Wedge]Q[5] + $(a[1, 3]\^2 + 2\ a[0, 3]\ a[2, 3])$\ P[2]\[Wedge]Q[6] + 2\ $(a[1, 1]\ a[2, 0] + a[1, 0]\ a[2, 1] + I\ h\ a[2, 1]\^2 + 2\ I\ h\ a[2, 0]\ a[2, 2] + a[0, 1]\ a[3, 0] + 3\ I\ h\ a[1, 2]\ a[3, 0] - 9\ h\^2\ a[2, 3]\ a[3, 0] + a[0, 0]\ a[3, 1] + 2\ I\ h\ a[1, 1]\ a[3, 1] - 3\ h\^2\ a[2, 2]\ a[3, 1] + I\ h\ a[1, 0]\ a[3, 2] - h\^2\ a[2, 1]\ a[3, 2] - 3\ h\^2\ a[2, 0]\ a[3, 3] - 3\ I\ h\^3\ a[3, 1]\ a[3, 3])$\ P[3]\[Wedge]Q[1] + $(2\ a[1, 2]\ a[2, 0] + 2\ a[1, 1]\ a[2, 1] + 2\ a[1, 0]\ a[2, 2] + 6\ I\ h\ a[2, 1]\ a[2, 2] + 6\ I\ h\ a[2, 0]\ a[2, 3] + 2\ a[0, 2]\ a[3, 0] + 9\ I\ h\ a[1, 3]\ a[3, 0] + 2\ a[0, 1]\ a[3, 1] + 7\ I\ h\ a[1, 2]\ a[3, 1] - 18\ h\^2\ a[2, 3]\ a[3, 1] + 2\ a[0, 0]\ a[3, 2] + 5\ I\ h\ a[1, 1]\ a[3, 2] - 8\ h\^2\ a[2, 2]\ a[3, 2] + 3\ I\ h\ a[1, 0]\ a[3, 3] - 6\ h\^2\ a[2, 1]\ a[3, 3] - 6\ I\ h\^3\ a[3, 2]\ a[3, 3])$\ P[3]\[Wedge]Q[2] + 2\ $(a[1, 3]\ a[2, 0] + a[1, 2]\ a[2, 1] + a[1, 1]\ a[2, 2] + 2\ I\ h\ a[2, 2]\^2 + a[1, 0]\ a[2, 3] + 4\ I\ h\ a[2, 1]\ a[2, 3] + a[0, 3]\ a[3, 0] + a[0, 2]\ a[3, 1] + 5\ I\ h\ a[1, 3]\ a[3, 1] + a[0, 1]\ a[3, 2] + 4\ I\ h\ a[1, 2]\ a[3, 2] - 10\ h\^2\ a[2, 3]\ a[3, 2] + a[0, 0]\ a[3, 3] + 3\ I\ h\ a[1, 1]\ a[3, 3] - 6\ h\^2\ a[2, 2]\ a[3, 3] - 3\ I\ h\^3\ a[3, 3]\^2)$\ P[3]\[Wedge]Q[3] + $(2\ a[1, 3]\ a[2, 1] + 2\ a[1, 2]\ a[2, 2] + 2\ a[1, 1]\ a[2, 3] + 10\ I\ h\ a[2, 2]\ a[2, 3] + 2\ a[0, 3]\ a[3, 1] + 2\ a[0, 2]\ a[3, 2] + 11\ I\ h\ a[1, 3]\ a[3, 2] + 2\ a[0, 1]\ a[3, 3] + 9\ I\ h\ a[1, 2]\ a[3, 3] - 24\ h\^2\ a[2, 3]\ a[3, 3])$\ P[3]\[Wedge]Q[4] + 2\ $(a[1, 3]\ a[2, 2] + a[1, 2]\ a[2, 3] + 3\ I\ h\ a[2, 3]\^2 + a[0, 3]\ a[3, 2] + a[0, 2]\ a[3, 3] + 6\ I\ h\ a[1, 3]\ a[3, 3]) $\ P[3]\[Wedge]Q[5] + 2\ $(a[1, 3]\ a[2, 3] + a[0, 3]\ a[3, 3])$\ P[3]\[Wedge]Q[6] + $(2\ a[2, 0]\ a[2, 1] + 2\ a[1, 1]\ a[3, 0] + 6\ I\ h\ a[2, 2]\ a[3, 0] + 2\ a[1, 0]\ a[3, 1] + 5\ I\ h\ a[2, 1]\ a[3, 1] + 4\ I\ h\ a[2, 0]\ a[3, 2] - 6\ h\^2\ a[3, 1]\ a[3, 2] - 18\ h\^2\ a[3, 0]\ a[3, 3])$\ P[4]\[Wedge]Q[1] + $(a[2, 1]\^2 + 2\ a[2, 0]\ a[2, 2] + 2\ a[1, 2]\ a[3, 0] + 9\ I\ h\ a[2, 3]\ a[3, 0] + 2\ a[1, 1]\ a[3, 1] + 8\ I\ h\ a[2, 2]\ a[3, 1] + 2\ a[1, 0]\ a[3, 2] + 7\ I\ h\ a[2, 1]\ a[3, 2] - 6\ h\^2\ a[3, 2]\^2 + 6\ I\ h\ a[2, 0]\ a[3, 3] - 18\ h\^2\ a[3, 1]\ a[3, 3])$\ P[4]\[Wedge]Q[2] + $(2\ a[2, 1]\ a[2, 2] + 2\ a[2, 0]\ a[2, 3] + 2\ a[1, 3]\ a[3, 0] + 2\ a[1, 2]\ a[3, 1] + 11\ I\ h\ a[2, 3]\ a[3, 1] + 2\ a[1, 1]\ a[3, 2] + 10\ I\ h\ a[2, 2]\ a[3, 2] + 2\ a[1, 0]\ a[3, 3] + 9\ I\ h\ a[2, 1]\ a[3, 3] - 24\ h\^2\ a[3, 2]\ a[3, 3])$\ P[4]\[Wedge]Q[3] + $(a[2, 2]\^2 + 2\ a[2, 1]\ a[2, 3] + 2\ a[1, 3]\ a[3, 1] + 2\ a[1, 2]\ a[3, 2] + 13\ I\ h\ a[2, 3]\ a[3, 2] + 2\ a[1, 1]\ a[3, 3] + 12\ I\ h\ a[2, 2]\ a[3, 3] - 18\ h\^2\ a[3, 3]\^2)$\ P[4]\[Wedge]Q[4] + $(2\ a[2, 2]\ a[2, 3] + 2\ a[1, 3]\ a[3, 2] + 2\ a[1, 2]\ a[3, 3] + 15\ I\ h\ a[2, 3]\ a[3, 3])$\ P[4]\[Wedge]Q[5] + $(a[2, 3]\^2 + 2\ a[1, 3]\ a[3, 3])$\ P[4]\[Wedge]Q[6] + $(2\ a[2, 1]\ a[3, 0] + 2\ a[2, 0]\ a[3, 1] + 3\ I\ h\ a[3, 1]\^2 + 6\ I\ h\ a[3, 0]\ a[3, 2])$\ P[5]\[Wedge]Q[1] + $(2\ a[2, 2]\ a[3, 0] + 2\ a[2, 1]\ a[3, 1] + 2\ a[2, 0]\ a[3, 2] + 9\ I\ h\ a[3, 1]\ a[3, 2] + 9\ I\ h\ a[3, 0]\ a[3, 3])$\ P[5]\[Wedge]Q[2] + 2\ $(a[2, 3]\ a[3, 0] + a[2, 2]\ a[3, 1] + a[2, 1]\ a[3, 2] + 3\ I\ h\ a[3, 2]\^2 + a[2, 0]\ a[3, 3] + 6\ I\ h\ a[3, 1]\ a[3, 3])$\ P[5]\[Wedge]Q[3] + $(2\ a[2, 3]\ a[3, 1] + 2\ a[2, 2]\ a[3, 2] + 2\ a[2, 1]\ a[3, 3] + 15\ I\ h\ a[3, 2]\ a[3, 3])$\ P[5]\[Wedge]Q[4] + $(2\ a[2, 3]\ a[3, 2] + 2\ a[2, 2]\ a[3, 3] + 9\ I\ h\ a[3, 3]\^2)$\ P[5]\[Wedge]Q[5] + 2\ a[2, 3]\ a[3, 3]\ P[5]\[Wedge]Q[6] + 2\ a[3, 0]\ a[3, 1]\ P[6]\[Wedge]Q[1] + $(a[3, 1]\^2 + 2\ a[3, 0]\ a[3, 2])$\ P[6]\[Wedge]Q[2] + 2\ $(a[3, 1]\ a[3, 2] + a[3, 0]\ a[3, 3])$\ P[6]\[Wedge]Q[3] + $(a[3, 2]\^2 + 2\ a[3, 1]\ a[3, 3])$\ P[6]\[Wedge]Q[4] + 2\ a[3, 2]\ a[3, 3]\ P[6]\[Wedge]Q[5] + a[3, 3]\^2\ P[6]\[Wedge]Q[6]\)], "Output"] }, Closed]], Cell[BoxData[ $comm[x_, y_] := reWrite[x\[Wedge]y - y\[Wedge]x]$], "Input"], Cell[CellGroupData[{ Cell[BoxData[ $comm[poly1, poly2]$], "Input"], Cell[BoxData[ $h\ \(( \(-I$\ a[1, 0]\ b[0, 1] + 2\ h\ a[2, 0]\ b[0, 2] + 6\ I\ h\^2\ a[3, 0]\ b[0, 3] + I\ a[0, 1]\ b[1, 0] - 2\ h\ a[0, 2]\ b[2, 0] - 6\ I\ h\^2\ a[0, 3]\ b[3, 0])\) + h\ $(\(-2$\ I\ a[2, 0]\ b[0, 1] + 6\ h\ a[3, 0]\ b[0, 2] + I\ a[1, 1]\ b[1, 0] - I\ a[1, 0]\ b[1, 1] + 2\ h\ a[2, 0]\ b[1, 2] + 6\ I\ h\^2\ a[3, 0]\ b[1, 3] + 2\ I\ a[0, 1]\ b[2, 0] - 2\ h\ a[1, 2]\ b[2, 0] - 6\ h\ a[0, 2]\ b[3, 0] - 6\ I\ h\^2\ a[1, 3]\ b[3, 0])\)\ P[1] + h\ $(\(-3$\ I\ a[3, 0]\ b[0, 1] + I\ a[2, 1]\ b[1, 0] - 2\ I\ a[2, 0]\ b[1, 1] + 6\ h\ a[3, 0]\ b[1, 2] + 2\ I\ a[1, 1]\ b[2, 0] - 2\ h\ a[2, 2]\ b[2, 0] - I\ a[1, 0]\ b[2, 1] + 2\ h\ a[2, 0]\ b[2, 2] + 6\ I\ h\^2\ a[3, 0]\ b[2, 3] + 3\ I\ a[0, 1]\ b[3, 0] - 6\ h\ a[1, 2]\ b[3, 0] - 6\ I\ h\^2\ a[2, 3]\ b[3, 0])\)\ P[2] + h\ $(I\ a[3, 1]\ b[1, 0] - 3\ I\ a[3, 0]\ b[1, 1] + 2\ I\ a[2, 1]\ b[2, 0] - 2\ h\ a[3, 2]\ b[2, 0] - 2\ I\ a[2, 0]\ b[2, 1] + 6\ h\ a[3, 0]\ b[2, 2] + 3\ I\ a[1, 1]\ b[3, 0] - 6\ h\ a[2, 2]\ b[3, 0] - 6\ I\ h\^2\ a[3, 3]\ b[3, 0] - I\ a[1, 0]\ b[3, 1] + 2\ h\ a[2, 0]\ b[3, 2] + 6\ I\ h\^2\ a[3, 0]\ b[3, 3])$\ P[3] + h\ $(2\ I\ a[3, 1]\ b[2, 0] - 3\ I\ a[3, 0]\ b[2, 1] + 3\ I\ a[2, 1]\ b[3, 0] - 6\ h\ a[3, 2]\ b[3, 0] - 2\ I\ a[2, 0]\ b[3, 1] + 6\ h\ a[3, 0]\ b[3, 2])$\ P[4] + 3\ I\ h\ $(a[3, 1]\ b[3, 0] - a[3, 0]\ b[3, 1])$\ P[5] + h\ $(\(-I$\ a[1, 1]\ b[0, 1] - 2\ I\ a[1, 0]\ b[0, 2] + 2\ h\ a[2, 1]\ b[0, 2] + 6\ h\ a[2, 0]\ b[0, 3] + 6\ I\ h\^2\ a[3, 1]\ b[0, 3] + 2\ I\ a[0, 2]\ b[1, 0] + I\ a[0, 1]\ b[1, 1] - 6\ h\ a[0, 3]\ b[2, 0] - 2\ h\ a[0, 2]\ b[2, 1] - 6\ I\ h\^2\ a[0, 3]\ b[3, 1])\)\ Q[1] + h\ $(\(-I$\ a[1, 2]\ b[0, 1] - 2\ I\ a[1, 1]\ b[0, 2] + 2\ h\ a[2, 2]\ b[0, 2] - 3\ I\ a[1, 0]\ b[0, 3] + 6\ h\ a[2, 1]\ b[0, 3] + 6\ I\ h\^2\ a[3, 2]\ b[0, 3] + 3\ I\ a[0, 3]\ b[1, 0] + 2\ I\ a[0, 2]\ b[1, 1] + I\ a[0, 1]\ b[1, 2] - 6\ h\ a[0, 3]\ b[2, 1] - 2\ h\ a[0, 2]\ b[2, 2] - 6\ I\ h\^2\ a[0, 3]\ b[3, 2])\)\ Q[2] + h\ $(\(-I$\ a[1, 3]\ b[0, 1] - 2\ I\ a[1, 2]\ b[0, 2] + 2\ h\ a[2, 3]\ b[0, 2] - 3\ I\ a[1, 1]\ b[0, 3] + 6\ h\ a[2, 2]\ b[0, 3] + 6\ I\ h\^2\ a[3, 3]\ b[0, 3] + 3\ I\ a[0, 3]\ b[1, 1] + 2\ I\ a[0, 2]\ b[1, 2] + I\ a[0, 1]\ b[1, 3] - 6\ h\ a[0, 3]\ b[2, 2] - 2\ h\ a[0, 2]\ b[2, 3] - 6\ I\ h\^2\ a[0, 3]\ b[3, 3])\)\ Q[3] + h\ $(\(-2$\ I\ a[1, 3]\ b[0, 2] - 3\ I\ a[1, 2]\ b[0, 3] + 6\ h\ a[2, 3]\ b[0, 3] + 3\ I\ a[0, 3]\ b[1, 2] + 2\ I\ a[0, 2]\ b[1, 3] - 6\ h\ a[0, 3]\ b[2, 3])\)\ Q[4] - 3\ I\ h\ $(a[1, 3]\ b[0, 3] - a[0, 3]\ b[1, 3])$\ Q[5] + 2\ h\ $(\(-I$\ a[2, 1]\ b[0, 1] - 2\ I\ a[2, 0]\ b[0, 2] + 3\ h\ a[3, 1]\ b[0, 2] + 9\ h\ a[3, 0]\ b[0, 3] + I\ a[1, 2]\ b[1, 0] - I\ a[1, 0]\ b[1, 2] + h\ a[2, 1]\ b[1, 2] + 3\ h\ a[2, 0]\ b[1, 3] + 3\ I\ h\^2\ a[3, 1]\ b[1, 3] + 2\ I\ a[0, 2]\ b[2, 0] - 3\ h\ a[1, 3]\ b[2, 0] + I\ a[0, 1]\ b[2, 1] - h\ a[1, 2]\ b[2, 1] - 9\ h\ a[0, 3]\ b[3, 0] - 3\ h\ a[0, 2]\ b[3, 1] - 3\ I\ h\^2\ a[1, 3]\ b[3, 1])\)\ P[1]\[Wedge]Q[1] + h\ $(\(-2$\ I\ a[2, 2]\ b[0, 1] - 4\ I\ a[2, 1]\ b[0, 2] + 6\ h\ a[3, 2]\ b[0, 2] - 6\ I\ a[2, 0]\ b[0, 3] + 18\ h\ a[3, 1]\ b[0, 3] + 3\ I\ a[1, 3]\ b[1, 0] + I\ a[1, 2]\ b[1, 1] - I\ a[1, 1]\ b[1, 2] + 2\ h\ a[2, 2]\ b[1, 2] - 3\ I\ a[1, 0]\ b[1, 3] + 6\ h\ a[2, 1]\ b[1, 3] + 6\ I\ h\^2\ a[3, 2]\ b[1, 3] + 6\ I\ a[0, 3]\ b[2, 0] + 4\ I\ a[0, 2]\ b[2, 1] - 6\ h\ a[1, 3]\ b[2, 1] + 2\ I\ a[0, 1]\ b[2, 2] - 2\ h\ a[1, 2]\ b[2, 2] - 18\ h\ a[0, 3]\ b[3, 1] - 6\ h\ a[0, 2]\ b[3, 2] - 6\ I\ h\^2\ a[1, 3]\ b[3, 2])\)\ P[1]\[Wedge]Q[2] + 2\ h\ $(\(-I$\ a[2, 3]\ b[0, 1] - 2\ I\ a[2, 2]\ b[0, 2] + 3\ h\ a[3, 3]\ b[0, 2] - 3\ I\ a[2, 1]\ b[0, 3] + 9\ h\ a[3, 2]\ b[0, 3] + I\ a[1, 3]\ b[1, 1] + h\ a[2, 3]\ b[1, 2] - I\ a[1, 1]\ b[1, 3] + 3\ h\ a[2, 2]\ b[1, 3] + 3\ I\ h\^2\ a[3, 3]\ b[1, 3] + 3\ I\ a[0, 3]\ b[2, 1] + 2\ I\ a[0, 2]\ b[2, 2] - 3\ h\ a[1, 3]\ b[2, 2] + I\ a[0, 1]\ b[2, 3] - h\ a[1, 2]\ b[2, 3] - 9\ h\ a[0, 3]\ b[3, 2] - 3\ h\ a[0, 2]\ b[3, 3] - 3\ I\ h\^2\ a[1, 3]\ b[3, 3])\)\ P[1]\[Wedge]Q[3] + h\ $(\(-4$\ I\ a[2, 3]\ b[0, 2] - 6\ I\ a[2, 2]\ b[0, 3] + 18\ h\ a[3, 3]\ b[0, 3] + I\ a[1, 3]\ b[1, 2] - I\ a[1, 2]\ b[1, 3] + 6\ h\ a[2, 3]\ b[1, 3] + 6\ I\ a[0, 3]\ b[2, 2] + 4\ I\ a[0, 2]\ b[2, 3] - 6\ h\ a[1, 3]\ b[2, 3] - 18\ h\ a[0, 3]\ b[3, 3])\)\ P[1]\[Wedge]Q[4] - 6\ I\ h\ $(a[2, 3]\ b[0, 3] - a[0, 3]\ b[2, 3])$\ P[1]\[Wedge]Q[5] + h\ $(\(-3$\ I\ a[3, 1]\ b[0, 1] - 6\ I\ a[3, 0]\ b[0, 2] + 2\ I\ a[2, 2]\ b[1, 0] - I\ a[2, 1]\ b[1, 1] - 4\ I\ a[2, 0]\ b[1, 2] + 6\ h\ a[3, 1]\ b[1, 2] + 18\ h\ a[3, 0]\ b[1, 3] + 4\ I\ a[1, 2]\ b[2, 0] - 6\ h\ a[2, 3]\ b[2, 0] + I\ a[1, 1]\ b[2, 1] - 2\ h\ a[2, 2]\ b[2, 1] - 2\ I\ a[1, 0]\ b[2, 2] + 2\ h\ a[2, 1]\ b[2, 2] + 6\ h\ a[2, 0]\ b[2, 3] + 6\ I\ h\^2\ a[3, 1]\ b[2, 3] + 6\ I\ a[0, 2]\ b[3, 0] - 18\ h\ a[1, 3]\ b[3, 0] + 3\ I\ a[0, 1]\ b[3, 1] - 6\ h\ a[1, 2]\ b[3, 1] - 6\ I\ h\^2\ a[2, 3]\ b[3, 1])\)\ P[2]\[Wedge]Q[1] + 3\ h\ $(\(-I$\ a[3, 2]\ b[0, 1] - 2\ I\ a[3, 1]\ b[0, 2] - 3\ I\ a[3, 0]\ b[0, 3] + I\ a[2, 3]\ b[1, 0] - I\ a[2, 1]\ b[1, 2] + 2\ h\ a[3, 2]\ b[1, 2] - 2\ I\ a[2, 0]\ b[1, 3] + 6\ h\ a[3, 1]\ b[1, 3] + 2\ I\ a[1, 3]\ b[2, 0] + I\ a[1, 2]\ b[2, 1] - 2\ h\ a[2, 3]\ b[2, 1] - I\ a[1, 0]\ b[2, 3] + 2\ h\ a[2, 1]\ b[2, 3] + 2\ I\ h\^2\ a[3, 2]\ b[2, 3] + 3\ I\ a[0, 3]\ b[3, 0] + 2\ I\ a[0, 2]\ b[3, 1] - 6\ h\ a[1, 3]\ b[3, 1] + I\ a[0, 1]\ b[3, 2] - 2\ h\ a[1, 2]\ b[3, 2] - 2\ I\ h\^2\ a[2, 3]\ b[3, 2])\)\ P[2]\[Wedge]Q[2] + h\ $(\(-3$\ I\ a[3, 3]\ b[0, 1] - 6\ I\ a[3, 2]\ b[0, 2] - 9\ I\ a[3, 1]\ b[0, 3] + I\ a[2, 3]\ b[1, 1] - 2\ I\ a[2, 2]\ b[1, 2] + 6\ h\ a[3, 3]\ b[1, 2] - 5\ I\ a[2, 1]\ b[1, 3] + 18\ h\ a[3, 2]\ b[1, 3] + 5\ I\ a[1, 3]\ b[2, 1] + 2\ I\ a[1, 2]\ b[2, 2] - 4\ h\ a[2, 3]\ b[2, 2] - I\ a[1, 1]\ b[2, 3] + 4\ h\ a[2, 2]\ b[2, 3] + 6\ I\ h\^2\ a[3, 3]\ b[2, 3] + 9\ I\ a[0, 3]\ b[3, 1] + 6\ I\ a[0, 2]\ b[3, 2] - 18\ h\ a[1, 3]\ b[3, 2] + 3\ I\ a[0, 1]\ b[3, 3] - 6\ h\ a[1, 2]\ b[3, 3] - 6\ I\ h\^2\ a[2, 3]\ b[3, 3])\)\ P[2]\[Wedge]Q[3] + h\ $(\(-6$\ I\ a[3, 3]\ b[0, 2] - 9\ I\ a[3, 2]\ b[0, 3] - I\ a[2, 3]\ b[1, 2] - 4\ I\ a[2, 2]\ b[1, 3] + 18\ h\ a[3, 3]\ b[1, 3] + 4\ I\ a[1, 3]\ b[2, 2] + I\ a[1, 2]\ b[2, 3] + 9\ I\ a[0, 3]\ b[3, 2] + 6\ I\ a[0, 2]\ b[3, 3] - 18\ h\ a[1, 3]\ b[3, 3])\)\ P[2]\[Wedge]Q[4] - 3\ I\ h\ $( 3\ a[3, 3]\ b[0, 3] + a[2, 3]\ b[1, 3] - a[1, 3]\ b[2, 3] - 3\ a[0, 3]\ b[3, 3])$\ P[2]\[Wedge]Q[5] + 2\ h\ $(I\ a[3, 2]\ b[1, 0] - I\ a[3, 1]\ b[1, 1] - 3\ I\ a[3, 0]\ b[1, 2] + 2\ I\ a[2, 2]\ b[2, 0] - 3\ h\ a[3, 3]\ b[2, 0] - h\ a[3, 2]\ b[2, 1] - 2\ I\ a[2, 0]\ b[2, 2] + 3\ h\ a[3, 1]\ b[2, 2] + 9\ h\ a[3, 0]\ b[2, 3] + 3\ I\ a[1, 2]\ b[3, 0] - 9\ h\ a[2, 3]\ b[3, 0] + I\ a[1, 1]\ b[3, 1] - 3\ h\ a[2, 2]\ b[3, 1] - 3\ I\ h\^2\ a[3, 3]\ b[3, 1] - I\ a[1, 0]\ b[3, 2] + h\ a[2, 1]\ b[3, 2] + 3\ h\ a[2, 0]\ b[3, 3] + 3\ I\ h\^2\ a[3, 1]\ b[3, 3])$\ P[3]\[Wedge]Q[1] + h\ $(3\ I\ a[3, 3]\ b[1, 0] - I\ a[3, 2]\ b[1, 1] - 5\ I\ a[3, 1]\ b[1, 2] - 9\ I\ a[3, 0]\ b[1, 3] + 6\ I\ a[2, 3]\ b[2, 0] + 2\ I\ a[2, 2]\ b[2, 1] - 6\ h\ a[3, 3]\ b[2, 1] - 2\ I\ a[2, 1]\ b[2, 2] + 4\ h\ a[3, 2]\ b[2, 2] - 6\ I\ a[2, 0]\ b[2, 3] + 18\ h\ a[3, 1]\ b[2, 3] + 9\ I\ a[1, 3]\ b[3, 0] + 5\ I\ a[1, 2]\ b[3, 1] - 18\ h\ a[2, 3]\ b[3, 1] + I\ a[1, 1]\ b[3, 2] - 4\ h\ a[2, 2]\ b[3, 2] - 6\ I\ h\^2\ a[3, 3]\ b[3, 2] - 3\ I\ a[1, 0]\ b[3, 3] + 6\ h\ a[2, 1]\ b[3, 3] + 6\ I\ h\^2\ a[3, 2]\ b[3, 3])$\ P[3]\[Wedge]Q[2] + 4\ h\ $(\(-I$\ a[3, 2]\ b[1, 2] - 2\ I\ a[3, 1]\ b[1, 3] + I\ a[2, 3]\ b[2, 1] - I\ a[2, 1]\ b[2, 3] + 4\ h\ a[3, 2]\ b[2, 3] + 2\ I\ a[1, 3]\ b[3, 1] + I\ a[1, 2]\ b[3, 2] - 4\ h\ a[2, 3]\ b[3, 2])\)\ P[3]\[Wedge]Q[3] + h\ $( \(-3$\ I\ a[3, 3]\ b[1, 2] - 7\ I\ a[3, 2]\ b[1, 3] + 2\ I\ a[2, 3]\ b[2, 2] - 2\ I\ a[2, 2]\ b[2, 3] + 12\ h\ a[3, 3]\ b[2, 3] + 7\ I\ a[1, 3]\ b[3, 2] + 3\ I\ a[1, 2]\ b[3, 3] - 12\ h\ a[2, 3]\ b[3, 3])\)\ P[3]\[Wedge]Q[4] - 6\ I\ h\ $(a[3, 3]\ b[1, 3] - a[1, 3]\ b[3, 3])$\ P[3]\[Wedge]Q[5] - h\ $(\(-4$\ I\ a[3, 2]\ b[2, 0] + I\ a[3, 1]\ b[2, 1] + 6\ I\ a[3, 0]\ b[2, 2] - 6\ I\ a[2, 2]\ b[3, 0] + 18\ h\ a[3, 3]\ b[3, 0] - I\ a[2, 1]\ b[3, 1] + 6\ h\ a[3, 2]\ b[3, 1] + 4\ I\ a[2, 0]\ b[3, 2] - 6\ h\ a[3, 1]\ b[3, 2] - 18\ h\ a[3, 0]\ b[3, 3])\)\ P[4]\[Wedge]Q[1] - h\ $(\(-6$\ I\ a[3, 3]\ b[2, 0] - I\ a[3, 2]\ b[2, 1] + 4\ I\ a[3, 1]\ b[2, 2] + 9\ I\ a[3, 0]\ b[2, 3] - 9\ I\ a[2, 3]\ b[3, 0] - 4\ I\ a[2, 2]\ b[3, 1] + 18\ h\ a[3, 3]\ b[3, 1] + I\ a[2, 1]\ b[3, 2] + 6\ I\ a[2, 0]\ b[3, 3] - 18\ h\ a[3, 1]\ b[3, 3])\)\ P[4]\[Wedge]Q[2] - h\ $(\(-3$\ I\ a[3, 3]\ b[2, 1] + 2\ I\ a[3, 2]\ b[2, 2] + 7\ I\ a[3, 1]\ b[2, 3] - 7\ I\ a[2, 3]\ b[3, 1] - 2\ I\ a[2, 2]\ b[3, 2] + 12\ h\ a[3, 3]\ b[3, 2] + 3\ I\ a[2, 1]\ b[3, 3] - 12\ h\ a[3, 2]\ b[3, 3])\)\ P[4]\[Wedge]Q[3] - 5\ I\ h\ $(a[3, 2]\ b[2, 3] - a[2, 3]\ b[3, 2])$\ P[4]\[Wedge]Q[4] - 3\ I\ h\ $(a[3, 3]\ b[2, 3] - a[2, 3]\ b[3, 3])$\ P[4]\[Wedge]Q[5] + 6\ I\ h\ $(a[3, 2]\ b[3, 0] - a[3, 0]\ b[3, 2])$\ P[5]\[Wedge]Q[1] + 3\ I\ h\ $( 3\ a[3, 3]\ b[3, 0] + a[3, 2]\ b[3, 1] - a[3, 1]\ b[3, 2] - 3\ a[3, 0]\ b[3, 3])$\ P[5]\[Wedge]Q[2] + 6\ I\ h\ $(a[3, 3]\ b[3, 1] - a[3, 1]\ b[3, 3])$\ P[5]\[Wedge]Q[3] + 3\ I\ h\ $(a[3, 3]\ b[3, 2] - a[3, 2]\ b[3, 3])$\ P[5]\[Wedge]Q[4]\)], "Output"] }, Closed]], Cell[CellGroupData[{ Cell[BoxData[ $Collect[%, h, reWrite]$], "Input"], Cell[BoxData[ $h\^3\ \(( 6\ I\ \((a[3, 0]\ b[0, 3] - a[0, 3]\ b[3, 0])$ + 6\ I\ $(a[3, 0]\ b[1, 3] - a[1, 3]\ b[3, 0])$\ P[1] + 6\ I\ $(a[3, 0]\ b[2, 3] - a[2, 3]\ b[3, 0])$\ P[2] - 6\ I\ $(a[3, 3]\ b[3, 0] - a[3, 0]\ b[3, 3])$\ P[3] + 6\ I\ $(a[3, 1]\ b[0, 3] - a[0, 3]\ b[3, 1])$\ Q[1] + 6\ I\ $(a[3, 2]\ b[0, 3] - a[0, 3]\ b[3, 2])$\ Q[2] + 6\ I\ $(a[3, 3]\ b[0, 3] - a[0, 3]\ b[3, 3])$\ Q[3] + 6\ I\ $(a[3, 1]\ b[1, 3] - a[1, 3]\ b[3, 1])$\ P[1]\[Wedge]Q[1] + 6\ I\ $(a[3, 2]\ b[1, 3] - a[1, 3]\ b[3, 2])$\ P[1]\[Wedge]Q[2] + 6\ I\ $(a[3, 3]\ b[1, 3] - a[1, 3]\ b[3, 3])$\ P[1]\[Wedge]Q[3] + 6\ I\ $(a[3, 1]\ b[2, 3] - a[2, 3]\ b[3, 1])$\ P[2]\[Wedge]Q[1] + 6\ I\ $(a[3, 2]\ b[2, 3] - a[2, 3]\ b[3, 2])$\ P[2]\[Wedge]Q[2] + 6\ I\ $(a[3, 3]\ b[2, 3] - a[2, 3]\ b[3, 3])$\ P[2]\[Wedge]Q[3] - 6\ I\ $(a[3, 3]\ b[3, 1] - a[3, 1]\ b[3, 3])$\ P[3]\[Wedge]Q[1] - 6\ I\ $(a[3, 3]\ b[3, 2] - a[3, 2]\ b[3, 3])$\ P[3]\[Wedge]Q[2]) \) + h\^2\ $( 2\ \((a[2, 0]\ b[0, 2] - a[0, 2]\ b[2, 0])$ + 2\ $(3\ a[3, 0]\ b[0, 2] + a[2, 0]\ b[1, 2] - a[1, 2]\ b[2, 0] - 3\ a[0, 2]\ b[3, 0])$\ P[1] + 2\ $(3\ a[3, 0]\ b[1, 2] - a[2, 2]\ b[2, 0] + a[2, 0]\ b[2, 2] - 3\ a[1, 2]\ b[3, 0])$\ P[2] - 2\ $(a[3, 2]\ b[2, 0] - 3\ a[3, 0]\ b[2, 2] + 3\ a[2, 2]\ b[3, 0] - a[2, 0]\ b[3, 2])$\ P[3] - 6\ $(a[3, 2]\ b[3, 0] - a[3, 0]\ b[3, 2])$\ P[4] + 2\ $(a[2, 1]\ b[0, 2] + 3\ a[2, 0]\ b[0, 3] - 3\ a[0, 3]\ b[2, 0] - a[0, 2]\ b[2, 1])$\ Q[1] + 2\ $(a[2, 2]\ b[0, 2] + 3\ a[2, 1]\ b[0, 3] - 3\ a[0, 3]\ b[2, 1] - a[0, 2]\ b[2, 2])$\ Q[2] + 2\ $(a[2, 3]\ b[0, 2] + 3\ a[2, 2]\ b[0, 3] - 3\ a[0, 3]\ b[2, 2] - a[0, 2]\ b[2, 3])$\ Q[3] + 6\ $(a[2, 3]\ b[0, 3] - a[0, 3]\ b[2, 3])$\ Q[4] + 2\ $(3\ a[3, 1]\ b[0, 2] + 9\ a[3, 0]\ b[0, 3] + a[2, 1]\ b[1, 2] + 3\ a[2, 0]\ b[1, 3] - 3\ a[1, 3]\ b[2, 0] - a[1, 2]\ b[2, 1] - 9\ a[0, 3]\ b[3, 0] - 3\ a[0, 2]\ b[3, 1])$\ P[1]\[Wedge]Q[1] + 2\ $(3\ a[3, 2]\ b[0, 2] + 9\ a[3, 1]\ b[0, 3] + a[2, 2]\ b[1, 2] + 3\ a[2, 1]\ b[1, 3] - 3\ a[1, 3]\ b[2, 1] - a[1, 2]\ b[2, 2] - 9\ a[0, 3]\ b[3, 1] - 3\ a[0, 2]\ b[3, 2])$\ P[1]\[Wedge]Q[2] + 2\ $(3\ a[3, 3]\ b[0, 2] + 9\ a[3, 2]\ b[0, 3] + a[2, 3]\ b[1, 2] + 3\ a[2, 2]\ b[1, 3] - 3\ a[1, 3]\ b[2, 2] - a[1, 2]\ b[2, 3] - 9\ a[0, 3]\ b[3, 2] - 3\ a[0, 2]\ b[3, 3])$\ P[1]\[Wedge]Q[3] + 6\ $(3\ a[3, 3]\ b[0, 3] + a[2, 3]\ b[1, 3] - a[1, 3]\ b[2, 3] - 3\ a[0, 3]\ b[3, 3])$\ P[1]\[Wedge]Q[4] + 2\ $(3\ a[3, 1]\ b[1, 2] + 9\ a[3, 0]\ b[1, 3] - 3\ a[2, 3]\ b[2, 0] - a[2, 2]\ b[2, 1] + a[2, 1]\ b[2, 2] + 3\ a[2, 0]\ b[2, 3] - 9\ a[1, 3]\ b[3, 0] - 3\ a[1, 2]\ b[3, 1])$\ P[2]\[Wedge]Q[1] + 6\ $(a[3, 2]\ b[1, 2] + 3\ a[3, 1]\ b[1, 3] - a[2, 3]\ b[2, 1] + a[2, 1]\ b[2, 3] - 3\ a[1, 3]\ b[3, 1] - a[1, 2]\ b[3, 2])$\ P[2]\[Wedge]Q[2] + 2\ $(3\ a[3, 3]\ b[1, 2] + 9\ a[3, 2]\ b[1, 3] - 2\ a[2, 3]\ b[2, 2] + 2\ a[2, 2]\ b[2, 3] - 9\ a[1, 3]\ b[3, 2] - 3\ a[1, 2]\ b[3, 3])$\ P[2]\[Wedge]Q[3] + 18\ $(a[3, 3]\ b[1, 3] - a[1, 3]\ b[3, 3])$\ P[2]\[Wedge]Q[4] - 2\ $(3\ a[3, 3]\ b[2, 0] + a[3, 2]\ b[2, 1] - 3\ a[3, 1]\ b[2, 2] - 9\ a[3, 0]\ b[2, 3] + 9\ a[2, 3]\ b[3, 0] + 3\ a[2, 2]\ b[3, 1] - a[2, 1]\ b[3, 2] - 3\ a[2, 0]\ b[3, 3])$\ P[3]\[Wedge]Q[1] - 2\ $(3\ a[3, 3]\ b[2, 1] - 2\ a[3, 2]\ b[2, 2] - 9\ a[3, 1]\ b[2, 3] + 9\ a[2, 3]\ b[3, 1] + 2\ a[2, 2]\ b[3, 2] - 3\ a[2, 1]\ b[3, 3])$\ P[3]\[Wedge]Q[2] + 16\ $(a[3, 2]\ b[2, 3] - a[2, 3]\ b[3, 2])$\ P[3]\[Wedge]Q[3] + 12\ $(a[3, 3]\ b[2, 3] - a[2, 3]\ b[3, 3])$\ P[3]\[Wedge]Q[4] - 6\ $(3\ a[3, 3]\ b[3, 0] + a[3, 2]\ b[3, 1] - a[3, 1]\ b[3, 2] - 3\ a[3, 0]\ b[3, 3])$\ P[4]\[Wedge]Q[1] - 18\ $(a[3, 3]\ b[3, 1] - a[3, 1]\ b[3, 3])$\ P[4]\[Wedge]Q[2] - 12\ $(a[3, 3]\ b[3, 2] - a[3, 2]\ b[3, 3])$\ P[4]\[Wedge]Q[3]) \) + h\ $( \(-I$\ $(a[1, 0]\ b[0, 1] - a[0, 1]\ b[1, 0])$ - I\ $( 2\ a[2, 0]\ b[0, 1] - a[1, 1]\ b[1, 0] + a[1, 0]\ b[1, 1] - 2\ a[0, 1]\ b[2, 0])$\ P[1] - I\ $(3\ a[3, 0]\ b[0, 1] - a[2, 1]\ b[1, 0] + 2\ a[2, 0]\ b[1, 1] - 2\ a[1, 1]\ b[2, 0] + a[1, 0]\ b[2, 1] - 3\ a[0, 1]\ b[3, 0])$\ P[2] + I\ $(a[3, 1]\ b[1, 0] - 3\ a[3, 0]\ b[1, 1] + 2\ a[2, 1]\ b[2, 0] - 2\ a[2, 0]\ b[2, 1] + 3\ a[1, 1]\ b[3, 0] - a[1, 0]\ b[3, 1])$\ P[3] + I\ $(2\ a[3, 1]\ b[2, 0] - 3\ a[3, 0]\ b[2, 1] + 3\ a[2, 1]\ b[3, 0] - 2\ a[2, 0]\ b[3, 1])$\ P[4] + 3\ I\ $(a[3, 1]\ b[3, 0] - a[3, 0]\ b[3, 1])$\ P[5] - I\ $(a[1, 1]\ b[0, 1] + 2\ a[1, 0]\ b[0, 2] - 2\ a[0, 2]\ b[1, 0] - a[0, 1]\ b[1, 1])$\ Q[1] - I\ $(a[1, 2]\ b[0, 1] + 2\ a[1, 1]\ b[0, 2] + 3\ a[1, 0]\ b[0, 3] - 3\ a[0, 3]\ b[1, 0] - 2\ a[0, 2]\ b[1, 1] - a[0, 1]\ b[1, 2])$\ Q[2] - I\ $(a[1, 3]\ b[0, 1] + 2\ a[1, 2]\ b[0, 2] + 3\ a[1, 1]\ b[0, 3] - 3\ a[0, 3]\ b[1, 1] - 2\ a[0, 2]\ b[1, 2] - a[0, 1]\ b[1, 3])$\ Q[3] - I\ $(2\ a[1, 3]\ b[0, 2] + 3\ a[1, 2]\ b[0, 3] - 3\ a[0, 3]\ b[1, 2] - 2\ a[0, 2]\ b[1, 3])$\ Q[4] - 3\ I\ $(a[1, 3]\ b[0, 3] - a[0, 3]\ b[1, 3])$\ Q[5] - 2\ I\ $( a[2, 1]\ b[0, 1] + 2\ a[2, 0]\ b[0, 2] - a[1, 2]\ b[1, 0] + a[1, 0]\ b[1, 2] - 2\ a[0, 2]\ b[2, 0] - a[0, 1]\ b[2, 1])$\ P[1]\[Wedge]Q[1] - I\ $(2\ a[2, 2]\ b[0, 1] + 4\ a[2, 1]\ b[0, 2] + 6\ a[2, 0]\ b[0, 3] - 3\ a[1, 3]\ b[1, 0] - a[1, 2]\ b[1, 1] + a[1, 1]\ b[1, 2] + 3\ a[1, 0]\ b[1, 3] - 6\ a[0, 3]\ b[2, 0] - 4\ a[0, 2]\ b[2, 1] - 2\ a[0, 1]\ b[2, 2])$\ P[1]\[Wedge]Q[2] - 2\ I\ $( a[2, 3]\ b[0, 1] + 2\ a[2, 2]\ b[0, 2] + 3\ a[2, 1]\ b[0, 3] - a[1, 3]\ b[1, 1] + a[1, 1]\ b[1, 3] - 3\ a[0, 3]\ b[2, 1] - 2\ a[0, 2]\ b[2, 2] - a[0, 1]\ b[2, 3])$\ P[1]\[Wedge]Q[3] - I\ $(4\ a[2, 3]\ b[0, 2] + 6\ a[2, 2]\ b[0, 3] - a[1, 3]\ b[1, 2] + a[1, 2]\ b[1, 3] - 6\ a[0, 3]\ b[2, 2] - 4\ a[0, 2]\ b[2, 3])$\ P[1]\[Wedge]Q[4] - 6\ I\ $(a[2, 3]\ b[0, 3] - a[0, 3]\ b[2, 3])$\ P[1]\[Wedge]Q[5] - I\ $( 3\ a[3, 1]\ b[0, 1] + 6\ a[3, 0]\ b[0, 2] - 2\ a[2, 2]\ b[1, 0] + a[2, 1]\ b[1, 1] + 4\ a[2, 0]\ b[1, 2] - 4\ a[1, 2]\ b[2, 0] - a[1, 1]\ b[2, 1] + 2\ a[1, 0]\ b[2, 2] - 6\ a[0, 2]\ b[3, 0] - 3\ a[0, 1]\ b[3, 1])$\ P[2]\[Wedge]Q[1] - 3\ I\ $( a[3, 2]\ b[0, 1] + 2\ a[3, 1]\ b[0, 2] + 3\ a[3, 0]\ b[0, 3] - a[2, 3]\ b[1, 0] + a[2, 1]\ b[1, 2] + 2\ a[2, 0]\ b[1, 3] - 2\ a[1, 3]\ b[2, 0] - a[1, 2]\ b[2, 1] + a[1, 0]\ b[2, 3] - 3\ a[0, 3]\ b[3, 0] - 2\ a[0, 2]\ b[3, 1] - a[0, 1]\ b[3, 2]) $\ P[2]\[Wedge]Q[2] - I\ $(3\ a[3, 3]\ b[0, 1] + 6\ a[3, 2]\ b[0, 2] + 9\ a[3, 1]\ b[0, 3] - a[2, 3]\ b[1, 1] + 2\ a[2, 2]\ b[1, 2] + 5\ a[2, 1]\ b[1, 3] - 5\ a[1, 3]\ b[2, 1] - 2\ a[1, 2]\ b[2, 2] + a[1, 1]\ b[2, 3] - 9\ a[0, 3]\ b[3, 1] - 6\ a[0, 2]\ b[3, 2] - 3\ a[0, 1]\ b[3, 3])$\ P[2]\[Wedge]Q[3] - I\ $(6\ a[3, 3]\ b[0, 2] + 9\ a[3, 2]\ b[0, 3] + a[2, 3]\ b[1, 2] + 4\ a[2, 2]\ b[1, 3] - 4\ a[1, 3]\ b[2, 2] - a[1, 2]\ b[2, 3] - 9\ a[0, 3]\ b[3, 2] - 6\ a[0, 2]\ b[3, 3]) $\ P[2]\[Wedge]Q[4] - 3\ I\ $( 3\ a[3, 3]\ b[0, 3] + a[2, 3]\ b[1, 3] - a[1, 3]\ b[2, 3] - 3\ a[0, 3]\ b[3, 3])$\ P[2]\[Wedge]Q[5] + 2\ I\ $( a[3, 2]\ b[1, 0] - a[3, 1]\ b[1, 1] - 3\ a[3, 0]\ b[1, 2] + 2\ a[2, 2]\ b[2, 0] - 2\ a[2, 0]\ b[2, 2] + 3\ a[1, 2]\ b[3, 0] + a[1, 1]\ b[3, 1] - a[1, 0]\ b[3, 2])$\ P[3]\[Wedge]Q[1] + I\ $(3\ a[3, 3]\ b[1, 0] - a[3, 2]\ b[1, 1] - 5\ a[3, 1]\ b[1, 2] - 9\ a[3, 0]\ b[1, 3] + 6\ a[2, 3]\ b[2, 0] + 2\ a[2, 2]\ b[2, 1] - 2\ a[2, 1]\ b[2, 2] - 6\ a[2, 0]\ b[2, 3] + 9\ a[1, 3]\ b[3, 0] + 5\ a[1, 2]\ b[3, 1] + a[1, 1]\ b[3, 2] - 3\ a[1, 0]\ b[3, 3])$\ P[3]\[Wedge]Q[2] - 4\ I\ $( a[3, 2]\ b[1, 2] + 2\ a[3, 1]\ b[1, 3] - a[2, 3]\ b[2, 1] + a[2, 1]\ b[2, 3] - 2\ a[1, 3]\ b[3, 1] - a[1, 2]\ b[3, 2])$\ P[3]\[Wedge]Q[3] - I\ $(3\ a[3, 3]\ b[1, 2] + 7\ a[3, 2]\ b[1, 3] - 2\ a[2, 3]\ b[2, 2] + 2\ a[2, 2]\ b[2, 3] - 7\ a[1, 3]\ b[3, 2] - 3\ a[1, 2]\ b[3, 3])$\ P[3]\[Wedge]Q[4] - 6\ I\ $(a[3, 3]\ b[1, 3] - a[1, 3]\ b[3, 3])$\ P[3]\[Wedge]Q[5] + I\ $(4\ a[3, 2]\ b[2, 0] - a[3, 1]\ b[2, 1] - 6\ a[3, 0]\ b[2, 2] + 6\ a[2, 2]\ b[3, 0] + a[2, 1]\ b[3, 1] - 4\ a[2, 0]\ b[3, 2])$\ P[4]\[Wedge]Q[1] + I\ $(6\ a[3, 3]\ b[2, 0] + a[3, 2]\ b[2, 1] - 4\ a[3, 1]\ b[2, 2] - 9\ a[3, 0]\ b[2, 3] + 9\ a[2, 3]\ b[3, 0] + 4\ a[2, 2]\ b[3, 1] - a[2, 1]\ b[3, 2] - 6\ a[2, 0]\ b[3, 3])$\ P[4]\[Wedge]Q[2] + I\ $(3\ a[3, 3]\ b[2, 1] - 2\ a[3, 2]\ b[2, 2] - 7\ a[3, 1]\ b[2, 3] + 7\ a[2, 3]\ b[3, 1] + 2\ a[2, 2]\ b[3, 2] - 3\ a[2, 1]\ b[3, 3])$\ P[4]\[Wedge]Q[3] - 5\ I\ $(a[3, 2]\ b[2, 3] - a[2, 3]\ b[3, 2])$\ P[4]\[Wedge]Q[4] - 3\ I\ $(a[3, 3]\ b[2, 3] - a[2, 3]\ b[3, 3])$\ P[4]\[Wedge]Q[5] + 6\ I\ $(a[3, 2]\ b[3, 0] - a[3, 0]\ b[3, 2])$\ P[5]\[Wedge]Q[1] + 3\ I\ $( 3\ a[3, 3]\ b[3, 0] + a[3, 2]\ b[3, 1] - a[3, 1]\ b[3, 2] - 3\ a[3, 0]\ b[3, 3])$\ P[5]\[Wedge]Q[2] + 6\ I\ $(a[3, 3]\ b[3, 1] - a[3, 1]\ b[3, 3])$\ P[5]\[Wedge]Q[3] + 3\ I\ $(a[3, 3]\ b[3, 2] - a[3, 2]\ b[3, 3])$\ P[5]\[Wedge]Q[4]) \)\)], "Output"] }, Closed]], Cell[BoxData[ $JacobiID[x_, y_, z_] := reWrite[comm[x, comm[y, z]] + comm[y, comm[z, x]] + comm[z, comm[x, y]]] $], "Input"], Cell[CellGroupData[{ Cell[BoxData[ $JacobiID[poly1, poly2, poly3] // Timing$], "Input"], Cell[BoxData[ ${263.783333333333303`\ Second, 0}$], "Output"] }, Open ]], Cell["\<\ \tOne can speed up the calculation by giving extra rules for \ commuting higher powers of P, Q:\ \>", "Text", TextAlignment->Left, TextJustification->0, FontSize->14], Cell[CellGroupData[{ Cell[BoxData[ $Q2P2 = reWrite[Wedge[Q[2], P[2]]]$], "Input"], Cell[BoxData[ $\(-2$\ h\^2 + 4\ I\ h\ P[1]\[Wedge]Q[1] + P[2]\[Wedge]Q[2]\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $Q3P3 = reWrite[Wedge[Q[3], P[3]]]$], "Input"], Cell[BoxData[ $\(-6$\ I\ h\^3 - 18\ h\^2\ P[1]\[Wedge]Q[1] + 9\ I\ h\ P[2]\[Wedge]Q[2] + P[3]\[Wedge]Q[3]\)], "Output"] }, Open ]], Cell[BoxData[ $Q2P3 = reWrite[Wedge[Q[2], P[3]]]; Q3P2 = reWrite[Wedge[Q[3], P[2]]]; $], "Input"], Cell[BoxData[ $Wedge[Q[m_], P[n_]] := Wedge[Q[m - 3], Q3P3, P[n - 3]] /; m > 2 && n > 2$], "Input"], Cell[BoxData[ $Wedge[Q[m_], P[n_]] := Wedge[Q[m - 3], Q3P2, P[n - 2]] /; m > 2 && n > 1$], "Input"], Cell[BoxData[ $Wedge[Q[m_], P[n_]] := Wedge[Q[m - 2], Q2P3, P[n - 3]] /; m > 1 && n > 2$], "Input"], Cell[BoxData[ $Wedge[Q[m_], P[n_]] := Wedge[Q[m - 2], Q2P2, P[n - 2]] /; m > 1 && n > 1$], "Input"], Cell[CellGroupData[{ Cell[BoxData[ $JacobiID[poly1, poly2, poly3] // Timing$], "Input"], Cell[BoxData[ ${191.799999999999997`\ Second, 0}$], "Output"] }, Open ]], Cell[BoxData[ $\(On[General::"\", General::"\"]; $\)], "Input"] }, Closed]], Cell[CellGroupData[{ Cell[" 3.5 Introducing Custom Notation: Symbolic Inverse", "Subsection", ShowGroupOpenCloseIcon->True, FontSize->18], Cell[TextData[{ StyleBox["\tSometimes one may want to use a shorthand notation of the form \ ", "Text", FontFamily->"Times", FontWeight->"Plain"], StyleBox["K[A]", "Text", FontFamily->"Courier", FontWeight->"Plain"], StyleBox[" for a symbolic operation with matrices (or other variables) that \ should not be interpreted as a function by the exterior differential operator \ ", "Text", FontFamily->"Times", FontWeight->"Plain"], StyleBox["d", "Text", FontFamily->"Courier", FontWeight->"Bold"], StyleBox["; i.e., one wants to ", "Text", FontFamily->"Times", FontWeight->"Plain"], StyleBox["avoid", "Text", FontFamily->"Times", FontWeight->"Plain"], StyleBox[" the following", "Text", FontFamily->"Times", FontWeight->"Plain"], ":" }], "Text", TextAlignment->Left, TextJustification->0, FontSize->14], Cell[CellGroupData[{ Cell[BoxData[ $d[{Inverse[S], K[A, B]}]$], "Input"], Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{$d[S]$, " ", RowBox[{ SuperscriptBox["Inverse", "\[Prime]", MultilineFunction->None], "[", "S", "]"}]}], ",", RowBox[{ RowBox[{$d[B]$, " ", RowBox[{ SuperscriptBox["K", TagBox[$(0, 1)$, Derivative], MultilineFunction->None], "[", $A, B$, "]"}]}], "+", RowBox[{$d[A]$, " ", RowBox[{ SuperscriptBox["K", TagBox[$(1, 0)$, Derivative], MultilineFunction->None], "[", $A, B$, "]"}]}]}]}], "}"}]], "Output"] }, Open ]], Cell[TextData[{ "\[FilledSmallCircle]", StyleBox["\tThe command ", "Text", FontFamily->"Times", FontWeight->"Plain"], StyleBox["NoDif", FontFamily->"Courier", FontWeight->"Bold"], StyleBox["[heads__]", FontFamily->"Courier"], StyleBox[" (\"No Differentiation\") takes as arguments the \"Heads\" of \ the expressions of the form ", "Text", FontFamily->"Times", FontWeight->"Plain"], StyleBox["K[A]", "Text", FontFamily->"Courier", FontWeight->"Plain"], StyleBox[" that must not be differentiated and blocks the action ", "Text", FontFamily->"Times", FontWeight->"Plain"], StyleBox["d", "Text", FontFamily->"Times", FontWeight->"Bold"], StyleBox[":", "Text", FontFamily->"Times", FontWeight->"Plain"] }], "Text", TextAlignment->Left, TextJustification->0, FontSize->14], Cell[CellGroupData[{ Cell[BoxData[ $NoDif[Inverse, K]$], "Input"], Cell[BoxData[ $"OK"$], "Print"] }, Open ]], Cell[TextData[{ "Now ", StyleBox["d", FontFamily->"Courier", FontWeight->"Bold"], " has no effect", StyleBox[":", "Text", FontFamily->"Times", FontWeight->"Plain"] }], "Text", TextAlignment->Left, TextJustification->0, FontSize->14], Cell[CellGroupData[{ Cell[BoxData[ $d[{Inverse[S], K[A, B]}]$], "Input"], Cell[BoxData[ ${d[Inverse[S]], d[K[A, B]]}$], "Output"] }, Open ]], Cell[TextData[{ StyleBox["Next, one must enable EDC to decide if these expressions \ represent differential forms or matrices. ", "Text", FontFamily->"Times", FontWeight->"Plain"], "This is achieved by:\n\t(1) Setting the value of ", StyleBox["FormDegree[..]", FontFamily->"Courier"], " if > 0 and\n\t(2) Setting the values of ", StyleBox["BasicMatQ[..]", FontFamily->"Courier"], " / ", StyleBox["BasicScalFormQ[..]", FontFamily->"Courier"], " if True. (If BasicMatQ[x] gives True, then MatQ[x] gives True also.)" }], "Text", TextAlignment->Left, TextJustification->0, FontSize->14], Cell["For example,", "Text", TextAlignment->Left, TextJustification->0, FontSize->14], Cell[BoxData[ $BasicMatQ[Inverse[x_]] := BasicMatQ[x]; \n FormDegree[Inverse[x_]] := FormDegree[x]; \n FormDegree[K[x_, y_]] := FormDegree[x]; $], "Input"], Cell[CellGroupData[{ Cell[BoxData[ $MatQ[Inverse[A]]$], "Input"], Cell[BoxData[ $True$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $FormDegree[K[U, A]]$], "Input"], Cell[BoxData[ $1$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $FormDegree[Inverse[A]]$], "Input"], Cell[BoxData[ $0$], "Output"] }, Open ]], Cell[TextData[{ "\tOne can then give definitions for the action of ", StyleBox["d", FontWeight->"Bold"], " and ", StyleBox["Wedge", FontWeight->"Bold"], " on these expressions as well as other definitions. The following \ definitions enable the built-in function ", StyleBox["Inverse", FontFamily->"Courier", FontWeight->"Bold"], " to give the symbolic inverse of symbolic matrices (on matrix products \ only! These definitions have not been included in EDC as they cannot be \ extended to ", StyleBox["sums", FontSlant->"Italic"], " of symbolic matrices):" }], "Text", TextAlignment->Left, TextJustification->0, FontSize->14], Cell[BoxData[ $d[Inverse[x_]] := \(-\((Inverse[x]\[Wedge]d[x]\[Wedge]Inverse[x])$\) /; BasicMatQ[x] && FormDegree[x] === 0; \n x_\[Wedge]Inverse[x_] := 1 /; BasicMatQ[x] && FormDegree[x] === 0; Inverse[x_]\[Wedge]x_ := 1 /; BasicMatQ[x] && FormDegree[x] === 0; \)], "Input"], Cell[BoxData[ $Unprotect[Inverse]; Inverse[Inverse[x_]] = 1; Inverse[a_*x_] := 1/a*Inverse[x] /; FormDegree[a] === 0 && \(! MatQ[a]$; Inverse[Wedge[x__]] := Wedge@@$(Reverse[Inverse/@{x}])$ /; Union[BasicMatQ/@{x}] === {True}; Protect[Inverse]; \)], "Input"], Cell[CellGroupData[{ Cell[BoxData[ $Inverse[A\[Wedge]B\[Wedge]C]$], "Input"], Cell[BoxData[ $Inverse[C]\[Wedge]Inverse[B]\[Wedge]Inverse[A]$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $Wedge[A\[Wedge]B\[Wedge]C, %]$], "Input"], Cell[BoxData[ $1$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $Wedge[C, %%, A]$], "Input"], Cell[BoxData[ $Inverse[B]$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $S\[Wedge]d[Inverse[S]]$], "Input"], Cell[BoxData[ $\(-\((d[S]\[Wedge]Inverse[S])$\)\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $d[Inverse[S]]\[Wedge]S$], "Input"], Cell[BoxData[ $\(-\((Inverse[S]\[Wedge]d[S])$\)\)], "Output"] }, Open ]], Cell[TextData[{ "Of course, for a single matrix, it is much simpler to use a new symbol ", StyleBox["DeclareMatrixForms[{0,invS,invS}]", FontFamily->"Courier"], " and then set ", StyleBox["d[invS]=-(invS", FontFamily->"Courier"], "\[Wedge]", StyleBox["d[S]", FontFamily->"Courier"], "\[Wedge]", StyleBox["invS);invS", FontFamily->"Courier"], "\[Wedge]", StyleBox["S=1;S", FontFamily->"Courier"], "\[Wedge]", StyleBox["invS=1;", FontFamily->"Courier"], "!" }], "Text", TextAlignment->Left, TextJustification->0, FontSize->14] }, Closed]], Cell[CellGroupData[{ Cell[" 3.6 Symmetries of general 2nd order ODE", "Subsection", ShowGroupOpenCloseIcon->True, FontSize->18], Cell["\<\ \tWe first reevaluate the initialization code matrixEDC.m to clear \ previous symbol definitions, as we will use some of the same symbols with a \ different meaning.\ \>", "Text", FontSize->14], Cell[BoxData[ $<< matrixEDC.m$], "Input"], Cell[TextData[{ "\tWe then define the function ", StyleBox["FuncRepRules", FontWeight->"Bold"], " (which is defined in ", ButtonBox["RGTC", ButtonData:>{ URL[ "http://www.inp.demokritos.gr/~sbonano/RGTC/"], None}, ButtonStyle->"Hyperlink"], ") that we will need for function replacement:" }], "Text", FontSize->14], Cell[CellGroupData[{ Cell[BoxData[ $\(FuncRepRules[z_[y__], g_, ord_: 2] := \(FuncRepRules[z[y], g, ord] = Block[{tmp$ = {z[y] \[Rule] g}, indL = indexList[Length[{y}], ord]}, Do[tmp$ = {tmp$, \(\(Derivative[Sequence@@indL[\([i]$]]\)[z]\)[y] \[Rule] Expand[FaSi[ D[g, Sequence@@Transpose[{{y}, indL[$[i]$]}]]]]}, {i, Length[indL]}]; Flatten[tmp$]]\); \)\)], "Input"], Cell[BoxData[ $\(indexList[varNo_, ord_] := Block[{tmp$, indL}, tmp$ = NestList[RotateRight, Join[{1}, Table[0, {varNo - 1}]], varNo - 1]; If[ord > 1, Do[indL = tmp$; Do[tmp$ = Join[tmp$, Map[Plus[indL[\([i]$], #]&, indL]], {i, varNo}], {ord - 1}]]; Union[tmp$]]\n\)\)], "Input"] }, Closed]], Cell["", "Text"], Cell[TextData[{ "\tThe general 2nd order ODE ", Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{ SuperscriptBox["u", "\[Prime]\[Prime]", MultilineFunction->None], "[", "x", "]"}], "-", RowBox[{"f", "[", RowBox[{"x", ",", "u", ",", RowBox[{ SuperscriptBox["u", "\[Prime]", MultilineFunction->None], "[", "x", "]"}]}], "]"}]}], "\[Equal]", "0"}]]], " is equivalent to the Exterior Differential System (EDS) generated by the \ pair of 1-forms:" }], "Text", FontSize->14], Cell[CellGroupData[{ Cell[BoxData[ $EDS = {d[u] - p\ d[x], d[p] - f[x, u, p] d[x]}$], "Input"], Cell[BoxData[ ${d[u] - p\ d[x], d[p] - d[x]\ f[x, u, p]}$], "Output"] }, Open ]], Cell["\<\ \tThe pair of 1-forms EDS generate a closed differential \ ideal:\ \>", "Text", FontSize->14], Cell[CellGroupData[{ Cell[BoxData[ $mat22 = Array[m, {2, 2}]$], "Input"], Cell[BoxData[ ${{m[1, 1], m[1, 2]}, {m[2, 1], m[2, 2]}}$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $reWrite[d[EDS] + mat22.EDS\[Wedge]d[x]]$], "Input"], Cell[BoxData[ RowBox[{"{", RowBox[{ $\((\(-1$ + m[1, 2])\)\ d[p]\[Wedge]d[x] + m[1, 1]\ d[u]\[Wedge]d[x]\), ",", RowBox[{ RowBox[{$d[p]\[Wedge]d[x]$, " ", RowBox[{"(", RowBox[{$m[2, 2]$, "-", RowBox[{ SuperscriptBox["f", TagBox[$(0, 0, 1)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], ")"}]}], "+", RowBox[{$d[u]\[Wedge]d[x]$, " ", RowBox[{"(", RowBox[{$m[2, 1]$, "-", RowBox[{ SuperscriptBox["f", TagBox[$(0, 1, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], ")"}]}]}]}], "}"}]], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"reWrite", "[", RowBox[{$d[EDS]$, "+", RowBox[{ RowBox[{ RowBox[{"{", RowBox[{${0, 1}$, ",", RowBox[{"{", RowBox[{ RowBox[{ SuperscriptBox["f", TagBox[$(0, 1, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}], ",", RowBox[{ SuperscriptBox["f", TagBox[$(0, 0, 1)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "}"}]}], "}"}], ".", "EDS"}], "\[Wedge]", $d[x]$}]}], "]"}]], "Input"], Cell[BoxData[ ${0, 0}$], "Output"] }, Open ]], Cell["", "Text"], Cell["\<\ \tA symmetry of the system is generated by a vector field with \ respect to which the Lie derivative of the EDS vanishes (modulo the EDS). \ This implies that:\ \>", "Text", FontSize->14], Cell[BoxData[ $\(vectorField = {X[x, u, p], \ U[x, u, p], P[x, u, p]}; $\)], "Input"], Cell[CellGroupData[{ Cell[BoxData[ $matEQS = reWrite[LieDcartan[vectorField, EDS, {x, u, p}] - mat22.EDS]$], "Input"], Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{ RowBox[{$d[p]$, " ", RowBox[{"(", RowBox[{$-m[1, 2]$, "+", RowBox[{ SuperscriptBox["U", TagBox[$(0, 0, 1)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}], "-", RowBox[{"p", " ", RowBox[{ SuperscriptBox["X", TagBox[$(0, 0, 1)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}]}], ")"}]}], "+", RowBox[{$d[u]$, " ", RowBox[{"(", RowBox[{$-m[1, 1]$, "+", RowBox[{ SuperscriptBox["U", TagBox[$(0, 1, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}], "-", RowBox[{"p", " ", RowBox[{ SuperscriptBox["X", TagBox[$(0, 1, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}]}], ")"}]}], "+", RowBox[{$d[x]$, " ", RowBox[{"(", RowBox[{ $p\ m[1, 1]$, "+", $f[x, u, p]\ m[1, 2]$, "-", $P[x, u, p]$, "+", RowBox[{ SuperscriptBox["U", TagBox[$(1, 0, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}], "-", RowBox[{"p", " ", RowBox[{ SuperscriptBox["X", TagBox[$(1, 0, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}]}], ")"}]}]}], ",", RowBox[{ RowBox[{$d[p]$, " ", RowBox[{"(", RowBox[{$-m[2, 2]$, "+", RowBox[{ SuperscriptBox["P", TagBox[$(0, 0, 1)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}], "-", RowBox[{$f[x, u, p]$, " ", RowBox[{ SuperscriptBox["X", TagBox[$(0, 0, 1)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}]}], ")"}]}], "+", RowBox[{$d[u]$, " ", RowBox[{"(", RowBox[{$-m[2, 1]$, "+", RowBox[{ SuperscriptBox["P", TagBox[$(0, 1, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}], "-", RowBox[{$f[x, u, p]$, " ", RowBox[{ SuperscriptBox["X", TagBox[$(0, 1, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}]}], ")"}]}], "+", RowBox[{$d[x]$, " ", RowBox[{"(", RowBox[{$p\ m[2, 1]$, "+", $f[x, u, p]\ m[2, 2]$, "-", RowBox[{$P[x, u, p]$, " ", RowBox[{ SuperscriptBox["f", TagBox[$(0, 0, 1)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "-", RowBox[{$U[x, u, p]$, " ", RowBox[{ SuperscriptBox["f", TagBox[$(0, 1, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "-", RowBox[{$X[x, u, p]$, " ", RowBox[{ SuperscriptBox["f", TagBox[$(1, 0, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "+", RowBox[{ SuperscriptBox["P", TagBox[$(1, 0, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}], "-", RowBox[{$f[x, u, p]$, " ", RowBox[{ SuperscriptBox["X", TagBox[$(1, 0, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}]}], ")"}]}]}]}], "}"}]], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $GenCoef[matEQS, {d[p], d[u]}]$], "Input"], Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{"{", RowBox[{ RowBox[{$-m[1, 2]$, "+", RowBox[{ SuperscriptBox["U", TagBox[$(0, 0, 1)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}], "-", RowBox[{"p", " ", RowBox[{ SuperscriptBox["X", TagBox[$(0, 0, 1)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}]}], ",", RowBox[{$-m[1, 1]$, "+", RowBox[{ SuperscriptBox["U", TagBox[$(0, 1, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}], "-", RowBox[{"p", " ", RowBox[{ SuperscriptBox["X", TagBox[$(0, 1, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}]}]}], "}"}], ",", RowBox[{"{", RowBox[{ RowBox[{$-m[2, 2]$, "+", RowBox[{ SuperscriptBox["P", TagBox[$(0, 0, 1)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}], "-", RowBox[{$f[x, u, p]$, " ", RowBox[{ SuperscriptBox["X", TagBox[$(0, 0, 1)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}]}], ",", RowBox[{$-m[2, 1]$, "+", RowBox[{ SuperscriptBox["P", TagBox[$(0, 1, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}], "-", RowBox[{$f[x, u, p]$, " ", RowBox[{ SuperscriptBox["X", TagBox[$(0, 1, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}]}]}], "}"}]}], "}"}]], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $matSOL = \(Solve[% \[Equal] 0, Flatten[mat22]]$[$[1]$]\)], "Input"], Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{$m[1, 1]$, "\[Rule]", RowBox[{ RowBox[{ SuperscriptBox["U", TagBox[$(0, 1, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}], "-", RowBox[{"p", " ", RowBox[{ SuperscriptBox["X", TagBox[$(0, 1, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}]}]}], ",", RowBox[{$m[1, 2]$, "\[Rule]", RowBox[{ RowBox[{ SuperscriptBox["U", TagBox[$(0, 0, 1)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}], "-", RowBox[{"p", " ", RowBox[{ SuperscriptBox["X", TagBox[$(0, 0, 1)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}]}]}], ",", RowBox[{$m[2, 1]$, "\[Rule]", RowBox[{ RowBox[{ SuperscriptBox["P", TagBox[$(0, 1, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}], "-", RowBox[{$f[x, u, p]$, " ", RowBox[{ SuperscriptBox["X", TagBox[$(0, 1, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}]}]}], ",", RowBox[{$m[2, 2]$, "\[Rule]", RowBox[{ RowBox[{ SuperscriptBox["P", TagBox[$(0, 0, 1)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}], "-", RowBox[{$f[x, u, p]$, " ", RowBox[{ SuperscriptBox["X", TagBox[$(0, 0, 1)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}]}]}]}], "}"}]], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $EDSeqs = reWrite[matEQS /. matSOL]$], "Input"], Cell[BoxData[ RowBox[{"{", RowBox[{ RowBox[{$d[x]$, " ", RowBox[{"(", RowBox[{$-P[x, u, p]$, "+", RowBox[{$f[x, u, p]$, " ", RowBox[{ SuperscriptBox["U", TagBox[$(0, 0, 1)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "-", RowBox[{"p", " ", $f[x, u, p]$, " ", RowBox[{ SuperscriptBox["X", TagBox[$(0, 0, 1)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "+", RowBox[{"p", " ", RowBox[{ SuperscriptBox["U", TagBox[$(0, 1, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "-", RowBox[{$p\^2$, " ", RowBox[{ SuperscriptBox["X", TagBox[$(0, 1, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "+", RowBox[{ SuperscriptBox["U", TagBox[$(1, 0, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}], "-", RowBox[{"p", " ", RowBox[{ SuperscriptBox["X", TagBox[$(1, 0, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}]}], ")"}]}], ",", RowBox[{$d[x]$, " ", RowBox[{"(", RowBox[{ RowBox[{$-P[x, u, p]$, " ", RowBox[{ SuperscriptBox["f", TagBox[$(0, 0, 1)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "+", RowBox[{$f[x, u, p]$, " ", RowBox[{ SuperscriptBox["P", TagBox[$(0, 0, 1)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "-", RowBox[{$f[x, u, p]\^2$, " ", RowBox[{ SuperscriptBox["X", TagBox[$(0, 0, 1)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "-", RowBox[{$U[x, u, p]$, " ", RowBox[{ SuperscriptBox["f", TagBox[$(0, 1, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "+", RowBox[{"p", " ", RowBox[{ SuperscriptBox["P", TagBox[$(0, 1, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "-", RowBox[{"p", " ", $f[x, u, p]$, " ", RowBox[{ SuperscriptBox["X", TagBox[$(0, 1, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "-", RowBox[{$X[x, u, p]$, " ", RowBox[{ SuperscriptBox["f", TagBox[$(1, 0, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "+", RowBox[{ SuperscriptBox["P", TagBox[$(1, 0, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}], "-", RowBox[{$f[x, u, p]$, " ", RowBox[{ SuperscriptBox["X", TagBox[$(1, 0, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}]}], ")"}]}]}], "}"}]], "Output"] }, Open ]], Cell[TextData[{ "\tA solution is obtained if the ", StyleBox["vectorField", FontWeight->"Bold"], " is assumed to be proportional to the total derivative w.r.t. x, i.e., \ U[x,u,p]=p X[x,u,p] and P[x,u,p]=f[x,u,p] X[x,u,p]:" }], "Text", FontSize->14], Cell[CellGroupData[{ Cell[BoxData[ $reWrite[ \(EDSeqs /. FuncRepRules[U[x, u, p], p\ X[x, u, p]]$ /. FuncRepRules[P[x, u, p], f[x, u, p]\ X[x, u, p]]]\)], "Input"], Cell[BoxData[ ${0, 0}$], "Output"] }, Open ]], Cell["", "Text"], Cell["\<\ \tThe function P[x,u,p] does not appear differentiated in the first \ of EDSeqs, so it can be expressed in terms of the other functions:\ \>", "Text", FontSize->14], Cell[CellGroupData[{ Cell[BoxData[ $Psol = \(Solve[EDSeqs[\([1]$] \[Equal] 0, P[x, u, p]]\)[$[1]$]\)], "Input"], Cell[BoxData[ RowBox[{"{", RowBox[{$P[x, u, p]$, "\[Rule]", RowBox[{ RowBox[{$f[x, u, p]$, " ", RowBox[{ SuperscriptBox["U", TagBox[$(0, 0, 1)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "-", RowBox[{"p", " ", $f[x, u, p]$, " ", RowBox[{ SuperscriptBox["X", TagBox[$(0, 0, 1)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "+", RowBox[{"p", " ", RowBox[{ SuperscriptBox["U", TagBox[$(0, 1, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "-", RowBox[{$p\^2$, " ", RowBox[{ SuperscriptBox["X", TagBox[$(0, 1, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "+", RowBox[{ SuperscriptBox["U", TagBox[$(1, 0, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}], "-", RowBox[{"p", " ", RowBox[{ SuperscriptBox["X", TagBox[$(1, 0, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}]}]}], "}"}]], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $lastEQ = \(indepTerms[ reWrite[EDSeqs /. FuncRepRules[P[x, u, p], Psol[\([1, 2]$]]] /. d[x] \[Rule] 1]\)[$[1]$]\)], "Input"], Cell[BoxData[ RowBox[{ RowBox[{$-2$, " ", $f[x, u, p]\^2$, " ", RowBox[{ SuperscriptBox["X", TagBox[$(0, 0, 1)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "+", RowBox[{$f[x, u, p]\^2$, " ", RowBox[{ SuperscriptBox["U", TagBox[$(0, 0, 2)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "-", RowBox[{"p", " ", $f[x, u, p]\^2$, " ", RowBox[{ SuperscriptBox["X", TagBox[$(0, 0, 2)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "-", RowBox[{$U[x, u, p]$, " ", RowBox[{ SuperscriptBox["f", TagBox[$(0, 1, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "+", RowBox[{"p", " ", RowBox[{ SuperscriptBox["U", TagBox[$(0, 0, 1)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}], " ", RowBox[{ SuperscriptBox["f", TagBox[$(0, 1, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "-", RowBox[{$p\^2$, " ", RowBox[{ SuperscriptBox["X", TagBox[$(0, 0, 1)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}], " ", RowBox[{ SuperscriptBox["f", TagBox[$(0, 1, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "+", RowBox[{$f[x, u, p]$, " ", RowBox[{ SuperscriptBox["U", TagBox[$(0, 1, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "-", RowBox[{"p", " ", RowBox[{ SuperscriptBox["f", TagBox[$(0, 0, 1)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}], " ", RowBox[{ SuperscriptBox["U", TagBox[$(0, 1, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "-", RowBox[{"3", " ", "p", " ", $f[x, u, p]$, " ", RowBox[{ SuperscriptBox["X", TagBox[$(0, 1, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "+", RowBox[{$p\^2$, " ", RowBox[{ SuperscriptBox["f", TagBox[$(0, 0, 1)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}], " ", RowBox[{ SuperscriptBox["X", TagBox[$(0, 1, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "+", RowBox[{"2", " ", "p", " ", $f[x, u, p]$, " ", RowBox[{ SuperscriptBox["U", TagBox[$(0, 1, 1)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "-", RowBox[{"2", " ", $p\^2$, " ", $f[x, u, p]$, " ", RowBox[{ SuperscriptBox["X", TagBox[$(0, 1, 1)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "+", RowBox[{$p\^2$, " ", RowBox[{ SuperscriptBox["U", TagBox[$(0, 2, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "-", RowBox[{$p\^3$, " ", RowBox[{ SuperscriptBox["X", TagBox[$(0, 2, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "-", RowBox[{$X[x, u, p]$, " ", RowBox[{ SuperscriptBox["f", TagBox[$(1, 0, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "+", RowBox[{ RowBox[{ SuperscriptBox["U", TagBox[$(0, 0, 1)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}], " ", RowBox[{ SuperscriptBox["f", TagBox[$(1, 0, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "-", RowBox[{"p", " ", RowBox[{ SuperscriptBox["X", TagBox[$(0, 0, 1)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}], " ", RowBox[{ SuperscriptBox["f", TagBox[$(1, 0, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "-", RowBox[{ RowBox[{ SuperscriptBox["f", TagBox[$(0, 0, 1)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}], " ", RowBox[{ SuperscriptBox["U", TagBox[$(1, 0, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "-", RowBox[{"2", " ", $f[x, u, p]$, " ", RowBox[{ SuperscriptBox["X", TagBox[$(1, 0, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "+", RowBox[{"p", " ", RowBox[{ SuperscriptBox["f", TagBox[$(0, 0, 1)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}], " ", RowBox[{ SuperscriptBox["X", TagBox[$(1, 0, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "+", RowBox[{"2", " ", $f[x, u, p]$, " ", RowBox[{ SuperscriptBox["U", TagBox[$(1, 0, 1)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "-", RowBox[{"2", " ", "p", " ", $f[x, u, p]$, " ", RowBox[{ SuperscriptBox["X", TagBox[$(1, 0, 1)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "+", RowBox[{"2", " ", "p", " ", RowBox[{ SuperscriptBox["U", TagBox[$(1, 1, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "-", RowBox[{"2", " ", $p\^2$, " ", RowBox[{ SuperscriptBox["X", TagBox[$(1, 1, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}], "+", RowBox[{ SuperscriptBox["U", TagBox[$(2, 0, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}], "-", RowBox[{"p", " ", RowBox[{ SuperscriptBox["X", TagBox[$(2, 0, 0)$, Derivative], MultilineFunction->None], "[", $x, u, p$, "]"}]}]}]], "Output"] }, Open ]], Cell["\<\ \tThis last equation depends on 3 arbitrarty functions (X[x,u,p], \ U[x,u,p], f[x,u,p]). A particular solution, depending on an arbitrary \ function of one variable (g[p]), is X[x,u,p]=1, U[x,u,p]=1, and \ f[x,u,p]=(x-u)g[p] :\ \>", "Text", FontSize->14], Cell[CellGroupData[{ Cell[BoxData[ $Factor[ \(\(lastEQ /. FuncRepRules[X[x, u, p], 1]$ /. FuncRepRules[U[x, u, p], 1]\) /. FuncRepRules[f[x, u, p], $(x - u)$ g[p]]]\)], "Input"], Cell[BoxData[ $0$], "Output"] }, Open ]], Cell["\<\ \tIt can be verified that, for these choices of X[x,u,p], U[x,u,p], \ and f[x,u,p], the function P[x,u,p] vanishes. Clearly there are many more \ solutions.\ \>", "Text", FontSize->14], Cell["", "Text"] }, Closed]], Cell[TextData[{ "\tEDC is also used in the ", StyleBox["Riemannian Geometry & Tensor Calculus", FontWeight->"Bold"], " package ", ButtonBox["RGTC", ButtonData:>{ URL[ "http://www.inp.demokritos.gr/~sbonano/RGTC/"], None}, ButtonStyle->"Hyperlink"], " (Sections 5 and 6). There is also an extension of EDC, called ", ButtonBox["superEDC", ButtonData:>{ FrontEnd`FileName[ {$RootDirectory, "http "}, " // www.inp.demokritos.gr/~sbonano/superEDC/", CharacterEncoding -> "MacintoshRoman"], None}, ButtonStyle->"Hyperlink"], ", that allows calculations with graded (Grassmann) variables. " }], "Text", FontSize->16] }, Closed]], Cell[BoxData[""], "Input"], Cell[CellGroupData[{ Cell[TextData[StyleBox[" 4 Usage Tips", FontWeight->"Bold"]], "Section", ShowGroupOpenCloseIcon->True, FontSize->24, FontColor->RGBColor[0, 0, 1]], Cell[CellGroupData[{ Cell[" 4.1 Explicit vector calculations", "Subsection", ShowGroupOpenCloseIcon->True, FontSize->18], Cell[TextData[{ StyleBox["\t", FontWeight->"Bold"], StyleBox["Wedge", FontFamily->"Courier", FontWeight->"Bold"], StyleBox[ " gives the correct result when multiplying explicit matrices (two-dim \ arrays) with vectors (one-dim arrays), but operations with symbolic vectors \ are not supported. For example:", FontWeight->"Plain"] }], "Text", ShowGroupOpenCloseIcon->True, TextAlignment->Left, TextJustification->0, FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $Mat = Array[a, {3, 3}]$], "Input"], Cell[BoxData[ ${{a[1, 1], a[1, 2], a[1, 3]}, {a[2, 1], a[2, 2], a[2, 3]}, {a[3, 1], a[3, 2], a[3, 3]}}$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $Vec = Array[v, {3}]$], "Input"], Cell[BoxData[ ${v[1], v[2], v[3]}$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $DeclareForms[1, v[_]]$], "Input"], Cell[BoxData[ $"OK"$], "Print"] }, Open ]], Cell[TextData[{ "(i.e., ", StyleBox["Vec", FontFamily->"Courier"], " is an 1-form vector)" }], "Text", FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Mat", StyleBox["\[Wedge]", "Output\[Times]"], "Vec"}]], "Input"], Cell[BoxData[ ${a[1, 1]\ v[1] + a[1, 2]\ v[2] + a[1, 3]\ v[3], a[2, 1]\ v[1] + a[2, 2]\ v[2] + a[2, 3]\ v[3], a[3, 1]\ v[1] + a[3, 2]\ v[2] + a[3, 3]\ v[3]}$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Vec", StyleBox["\[Wedge]", "Output\[Times]"], "Mat"}]], "Input"], Cell[BoxData[ ${a[1, 1]\ v[1] + a[2, 1]\ v[2] + a[3, 1]\ v[3], a[1, 2]\ v[1] + a[2, 2]\ v[2] + a[3, 2]\ v[3], a[1, 3]\ v[1] + a[2, 3]\ v[2] + a[3, 3]\ v[3]}$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"reWrite", "[", RowBox[{"Vec", StyleBox["\[Wedge]", "Output\[Times]"], "Mat", StyleBox["\[Wedge]", "Output\[Times]"], "Vec"}], "]"}]], "Input"], Cell[BoxData[ $\((a[1, 2] - a[2, 1])$\ v[1]\[Wedge]v[2] + $(a[1, 3] - a[3, 1])$\ v[1]\[Wedge]v[3] + $(a[2, 3] - a[3, 2])$\ v[2]\[Wedge]v[3]\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Vec", StyleBox["\[Wedge]", "Output\[Times]"], $d[Vec]$}]], "Input"], Cell[BoxData[ $v[1]\[Wedge]d[v[1]] + v[2]\[Wedge]d[v[2]] + v[3]\[Wedge]d[v[3]]$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"Vec", StyleBox["\[Wedge]", "Output\[Times]"], "Mat", StyleBox["\[Wedge]", "Output\[Times]"], $d[Vec]$}]], "Input"], Cell[BoxData[ $a[1, 1]\ v[1]\[Wedge]d[v[1]] + a[1, 2]\ v[1]\[Wedge]d[v[2]] + a[1, 3]\ v[1]\[Wedge]d[v[3]] + a[2, 1]\ v[2]\[Wedge]d[v[1]] + a[2, 2]\ v[2]\[Wedge]d[v[2]] + a[2, 3]\ v[2]\[Wedge]d[v[3]] + a[3, 1]\ v[3]\[Wedge]d[v[1]] + a[3, 2]\ v[3]\[Wedge]d[v[2]] + a[3, 3]\ v[3]\[Wedge]d[v[3]]$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{$d[x]$, StyleBox["\[Wedge]", "Output\[Times]"], "Vec"}]], "Input"], Cell[BoxData[ ${d[x]\[Wedge]v[1], d[x]\[Wedge]v[2], d[x]\[Wedge]v[3]}$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{$d[Mat]$, StyleBox["\[Wedge]", "Output\[Times]"], "Vec"}]], "Input"], Cell[BoxData[ ${d[a[1, 1]]\[Wedge]v[1] + d[a[1, 2]]\[Wedge]v[2] + d[a[1, 3]]\[Wedge]v[3], d[a[2, 1]]\[Wedge]v[1] + d[a[2, 2]]\[Wedge]v[2] + d[a[2, 3]]\[Wedge]v[3], d[a[3, 1]]\[Wedge]v[1] + d[a[3, 2]]\[Wedge]v[2] + d[a[3, 3]]\[Wedge]v[3]}$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"reWrite", "[", RowBox[{"Vec", StyleBox["\[Wedge]", "Output\[Times]"], "%"}], "]"}]], "Input"], Cell[BoxData[ $\(-\((d[a[1, 2]]\[Wedge]v[1]\[Wedge]v[2])$\) - d[a[1, 3]]\[Wedge]v[1]\[Wedge]v[3] + d[a[2, 1]]\[Wedge]v[1]\[Wedge]v[2] - d[a[2, 3]]\[Wedge]v[2]\[Wedge]v[3] + d[a[3, 1]]\[Wedge]v[1]\[Wedge]v[3] + d[a[3, 2]]\[Wedge]v[2]\[Wedge]v[3]\)], "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[" 4.2 Using lists of symbolic matrices", "Subsection", ShowGroupOpenCloseIcon->True, FontSize->18], Cell[TextData[{ "\tOccasionally, one may want to do calculations with ", StyleBox["lists", FontSlant->"Italic"], " of symbolic matrices. For example, consider a 2x2 matrix (or vector) in \ block-form:" }], "Text", FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $DeclareMatrixForms[{0, M[_], Mt[_]}]$], "Input"], Cell[BoxData[ $"OK"$], "Print"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $blockMat = {{M[11], M[12]}, {M[21], M[22]}}$], "Input"], Cell[BoxData[ ${{M[11], M[12]}, {M[21], M[22]}}$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $blockVec = {M[1], M[2]}$], "Input"], Cell[BoxData[ ${M[1], M[2]}$], "Output"] }, Open ]], Cell[TextData[{ StyleBox["Wedge", FontWeight->"Bold"], " ", StyleBox["does not", FontSlant->"Italic"], " multiply such lists with a single symbolic matrix, but it ", StyleBox["does", FontSlant->"Italic"], " multiply them together:" }], "Text", FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $Wedge[M[1], blockVec]$], "Input"], Cell[BoxData[ $M[1]\[Wedge]{M[1], M[2]}$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $Wedge[blockMat, M[1]]$], "Input"], Cell[BoxData[ ${{M[11], M[12]}, {M[21], M[22]}}\[Wedge]M[1]$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $Wedge[blockMat, blockVec]$], "Input"], Cell[BoxData[ ${M[11]\[Wedge]M[1] + M[12]\[Wedge]M[2], M[21]\[Wedge]M[1] + M[22]\[Wedge]M[2]}$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $Wedge[blockMat, blockMat]$], "Input"], Cell[BoxData[ ${{M[11]\[Wedge]M[11] + M[12]\[Wedge]M[21], M[11]\[Wedge]M[12] + M[12]\[Wedge]M[22]}, { M[21]\[Wedge]M[11] + M[22]\[Wedge]M[21], M[21]\[Wedge]M[12] + M[22]\[Wedge]M[22]}}$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $Wedge[blockVec, blockMat]$], "Input"], Cell[BoxData[ ${M[1]\[Wedge]M[11] + M[2]\[Wedge]M[21], M[1]\[Wedge]M[12] + M[2]\[Wedge]M[22]}$], "Output"] }, Open ]], Cell["\<\ The reason for this strange behavior is compatibility of \ dimensions: if the M[i] are n x n matrices, then a single matrix M[1] cannot \ multiply a 2n x 2n matrix (blockMat) or a 2n vector (blockVec). But 2n-dim \ matrices and vectors can be multiplied together.\ \>", "Text", FontSize->16], Cell[TextData[{ "\tHowever, if one's symbolic matrices have a different meaning and \ components will never be used, one can force ", StyleBox["Wedge", FontWeight->"Bold"], " to perform such multiplications. This is achieved by evaluating the \ following ", StyleBox["Wedge", FontWeight->"Bold"], " definitions:" }], "Text", FontSize->16], Cell[BoxData[ $Wedge[x_, y_List] := Map[Wedge[x, #]&, y]$], "Input"], Cell[BoxData[ $Wedge[x_List, y_] := Map[Wedge[#, y]&, x]$], "Input"], Cell["Now:", "Text", FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $Wedge[M[1], blockVec]$], "Input"], Cell[BoxData[ ${M[1]\[Wedge]M[1], M[1]\[Wedge]M[2]}$], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $Wedge[blockMat, M[1]]$], "Input"], Cell[BoxData[ ${{M[11]\[Wedge]M[1], M[12]\[Wedge]M[1]}, {M[21]\[Wedge]M[1], M[22]\[Wedge]M[1]}}$], "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[" 4.3 Calculations with Series Expansions", "Subsection", ShowGroupOpenCloseIcon->True, FontSize->18], Cell[TextData[{ "\tWhen working with series expansions containing explicit differential \ forms, one must keep in mind that the notation ", StyleBox["d[x]", FontFamily->"Courier"], " for the differential of the expansion symbol (coordinate) cannot be used \ because ", StyleBox["Series", FontFamily->"Courier"], " will consider ", StyleBox["d[x]", FontFamily->"Courier"], " a function of ", StyleBox["x", FontFamily->"Courier"], " and formally expand it (using ", StyleBox["d[0]=0", FontFamily->"Courier"], "):" }], "Text", FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $Series[d[x]/\((1 - x)$, {x, 0, 3}]\)], "Input"], Cell[BoxData[ InterpretationBox[ RowBox[{ RowBox[{ RowBox[{ SuperscriptBox["d", "\[Prime]", MultilineFunction->None], "[", "0", "]"}], " ", "x"}], "+", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{ SuperscriptBox["d", "\[Prime]", MultilineFunction->None], "[", "0", "]"}], "+", FractionBox[ RowBox[{ SuperscriptBox["d", "\[DoublePrime]", MultilineFunction->None], "[", "0", "]"}], "2"]}], ")"}], " ", $x\^2$}], "+", RowBox[{ RowBox[{"(", RowBox[{ RowBox[{ SuperscriptBox["d", "\[Prime]", MultilineFunction->None], "[", "0", "]"}], "+", FractionBox[ RowBox[{ SuperscriptBox["d", "\[DoublePrime]", MultilineFunction->None], "[", "0", "]"}], "2"], "+", RowBox[{$1\/6$, " ", RowBox[{ SuperscriptBox["d", TagBox[$(3)$, Derivative], MultilineFunction->None], "[", "0", "]"}]}]}], ")"}], " ", $x\^3$}], "+", InterpretationBox[$O[x]\^4$, SeriesData[ x, 0, {}, 1, 4, 1]]}], SeriesData[ x, 0, { Derivative[ 1][ d][ 0], Plus[ Derivative[ 1][ d][ 0], Times[ Rational[ 1, 2], Derivative[ 2][ d][ 0]]], Plus[ Derivative[ 1][ d][ 0], Times[ Rational[ 1, 2], Derivative[ 2][ d][ 0]], Times[ Rational[ 1, 6], Derivative[ 3][ d][ 0]]]}, 1, 4, 1]]], "Output"] }, Open ]], Cell[TextData[{ "\tOne must therefore use ", StyleBox["DeclareForms", FontFamily->"Courier"], " to introduce a new symbol for the differential of the expansion variable \ (and appropriately define its exterior derivative). For example, the \ following definitions introduce the symbol ", StyleBox["dx", FontWeight->"Bold"], " to be used in place of ", StyleBox["d[x]", FontWeight->"Bold"], ":" }], "Text", FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $DeclareForms[1, dx]; \nd[x] = dx; d[dx] = 0; $], "Input"], Cell[BoxData[ $"OK"$], "Print"] }, Open ]], Cell[TextData[{ "Then one can do calculations with series (one can still input ", StyleBox["d[x]", FontFamily->"Courier"], "):" }], "Text", FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $ser1 = Series[d[x]/\((1 - x)$, {x, 0, 3}]\)], "Input"], Cell[BoxData[ InterpretationBox[ RowBox[{ "dx", "+", $dx\ x$, "+", $dx\ x\^2$, "+", $dx\ x\^3$, "+", InterpretationBox[$O[x]\^4$, SeriesData[ x, 0, {}, 0, 4, 1]]}], SeriesData[ x, 0, {dx, dx, dx, dx}, 0, 4, 1]]], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $d[ser1]$], "Input"], Cell[BoxData[ InterpretationBox[$O[x]\^3$, SeriesData[ x, 0, {}, 3, 3, 1]]], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"ser1", StyleBox["\[Wedge]", FontFamily->"Courier"], "ser1"}]], "Input"], Cell[BoxData[ InterpretationBox[$O[x]\^4$, SeriesData[ x, 0, {}, 4, 4, 1]]], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ $d[y^2\ ser1]$], "Input"], Cell[BoxData[ InterpretationBox[ RowBox[{ $-\(2\ \((y\ dx\[Wedge]d[y])$\)\), "-", $2\ \((y\ dx\[Wedge]d[y])$\ x\), "-", $2\ \((y\ dx\[Wedge]d[y])$\ x\^2\), "+", InterpretationBox[$O[x]\^3$, SeriesData[ x, 0, {}, 0, 3, 1]]}], SeriesData[ x, 0, { Times[ -2, y, Wedge[ dx, d[ y]]], Times[ -2, y, Wedge[ dx, d[ y]]], Times[ -2, y, Wedge[ dx, d[ y]]]}, 0, 3, 1]]], "Output"] }, Open ]], Cell["\<\ \tSeries has been modified to automatically expand (to the \ appropriate order) series coefficients that depend on x:\ \>", "Text", FontSize->16], Cell[CellGroupData[{ Cell[BoxData[ $% /. y -> Sqrt[1 - x] u$], "Input"], Cell[BoxData[ InterpretationBox[ RowBox[{$-\(2\ \((u\ dx\[Wedge]d[u])$\)\), "+", InterpretationBox[$O[x]\^3$, SeriesData[ x, 0, {}, 0, 3, 1]]}], SeriesData[ x, 0, { Times[ -2, u, Wedge[ dx, d[ u]]]}, 0, 3, 1]]], "Output"] }, Open ]], Cell[BoxData[ $d[x] =. $], "Input"] }, Closed]], Cell[BoxData[""], "Input"] }, Closed]] }, FrontEndVersion->"Macintosh 3.0", ScreenRectangle->{{0, 1024}, {0, 748}}, WindowToolbars->{}, CellGrouping->Manual, WindowSize->{956, 721}, WindowMargins->{{22, Automatic}, {Automatic, -2}}, Magnification->1.25, StyleDefinitions -> "Default.nb", MacintoshSystemPageSetup->"\<\ 00<0001804P000000`d26_oQon@3:`8g0dL5N`?P0080001804P000000]P2:001 0000I00000400`<30?l00BL?00400@0000000000000006P801T1T00000000000 00000000004000000000000000000000\>" ] (*********************************************************************** Cached data follows. If you edit this Notebook file directly, not using Mathematica, you must remove the line containing CacheID at the top of the file. The cache data will then be recreated when you save this file from within Mathematica. ***********************************************************************) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[1731, 51, 330, 12, 202, "Text"], Cell[2064, 65, 151, 5, 39, "Text"], Cell[2218, 72, 1036, 36, 185, "Text"] }, Closed]], Cell[3269, 111, 25, 3, 50, "Text"], Cell[CellGroupData[{ Cell[3319, 118, 153, 4, 72, "Section"], Cell[3475, 124, 480, 18, 65, "Text"], Cell[3958, 144, 346, 10, 89, "Text"], Cell[4307, 156, 666, 14, 137, "Text"], Cell[4976, 172, 928, 20, 161, "Text"], Cell[5907, 194, 349, 8, 89, "Text"], Cell[6259, 204, 1061, 31, 161, "Text"], Cell[7323, 237, 1025, 23, 185, "Text"], Cell[8351, 262, 670, 16, 93, "Text"] }, Closed]], Cell[9036, 281, 26, 0, 28, "Input"], Cell[9065, 283, 881, 33, 89, "Text"], Cell[9949, 318, 38, 1, 33, "Input"], Cell[9990, 321, 106, 3, 41, "Text"], Cell[10099, 326, 47, 1, 33, "Input"], Cell[CellGroupData[{ Cell[10171, 331, 44, 1, 33, "Input"], Cell[10218, 334, 37, 1, 33, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[10292, 340, 169, 4, 72, "Section"], Cell[CellGroupData[{ Cell[10486, 348, 122, 2, 60, "Subsection"], Cell[10611, 352, 202, 6, 41, "Text"], Cell[10816, 360, 80, 1, 33, "Input"], Cell[10899, 363, 98, 2, 33, "Input"], Cell[11000, 367, 572, 21, 65, "Text"], Cell[CellGroupData[{ Cell[11597, 392, 52, 1, 33, "Input"], Cell[11652, 395, 241, 4, 70, "Output"] }, Open ]], Cell[11908, 402, 307, 11, 41, "Text"], Cell[CellGroupData[{ Cell[12240, 417, 109, 3, 33, "Input"], Cell[12352, 422, 241, 4, 70, "Output"] }, Open ]], Cell[12608, 429, 355, 12, 65, "Text"], Cell[CellGroupData[{ Cell[12988, 445, 45, 1, 33, "Input"], Cell[13036, 448, 218, 3, 70, "Output"] }, Open ]], Cell[13269, 454, 393, 15, 41, "Text"], Cell[CellGroupData[{ Cell[13687, 473, 92, 1, 33, "Input"], Cell[13782, 476, 1668, 44, 70, "Output"] }, Open ]], Cell[15465, 523, 154, 6, 41, "Text"], Cell[15622, 531, 63, 1, 33, "Input"], Cell[CellGroupData[{ Cell[15710, 536, 38, 1, 33, "Input"], Cell[15751, 539, 129, 2, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[15917, 546, 49, 1, 33, "Input"], Cell[15969, 549, 111, 2, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[16117, 556, 84, 1, 33, "Input"], Cell[16204, 559, 35, 1, 70, "Output"] }, Open ]], Cell[16254, 563, 401, 17, 41, "Text"], Cell[16658, 582, 115, 3, 41, "Text"], Cell[CellGroupData[{ Cell[16798, 589, 147, 2, 33, "Input"], Cell[16948, 593, 141, 2, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[17126, 600, 46, 1, 33, "Input"], Cell[17175, 603, 251, 4, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[17463, 612, 38, 1, 33, "Input"], Cell[17504, 615, 272, 5, 70, "Output"] }, Open ]], Cell[17791, 623, 201, 8, 41, "Text"], Cell[CellGroupData[{ Cell[18017, 635, 55, 1, 33, "Input"], Cell[18075, 638, 256, 5, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[18368, 648, 58, 1, 33, "Input"], Cell[18429, 651, 940, 19, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[19406, 675, 43, 1, 33, "Input"], Cell[19452, 678, 111, 2, 70, "Output"] }, Open ]], Cell[19578, 683, 339, 11, 65, "Text"], Cell[CellGroupData[{ Cell[19942, 698, 55, 1, 33, "Input"], Cell[20000, 701, 122, 2, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[20159, 708, 55, 1, 33, "Input"], Cell[20217, 711, 231, 4, 70, "Output"] }, Open ]] }, Closed]], Cell[20475, 719, 16, 0, 31, "Text"], Cell[CellGroupData[{ Cell[20516, 723, 160, 5, 60, "Subsection"], Cell[20679, 730, 981, 37, 113, "Text"], Cell[CellGroupData[{ Cell[21685, 771, 177, 9, 54, "Subsubsection"], Cell[21865, 782, 1718, 58, 209, "Text"], Cell[23586, 842, 789, 29, 89, "Text"], Cell[CellGroupData[{ Cell[24400, 875, 116, 2, 33, "Input"], Cell[24519, 879, 37, 1, 28, "Print"] }, Open ]], Cell[CellGroupData[{ Cell[24593, 885, 47, 1, 33, "Input"], Cell[24643, 888, 59, 1, 33, "Output"] }, Open ]], Cell[24717, 892, 224, 8, 41, "Text"], Cell[CellGroupData[{ Cell[24966, 904, 54, 1, 33, "Input"], Cell[25023, 907, 79, 1, 33, "Output"] }, Open ]], Cell[25117, 911, 150, 6, 41, "Text"], Cell[CellGroupData[{ Cell[25292, 921, 50, 1, 33, "Input"], Cell[25345, 924, 82, 1, 33, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[25464, 930, 48, 1, 33, "Input"], Cell[25515, 933, 67, 1, 33, "Output"] }, Open ]], Cell[25597, 937, 142, 4, 41, "Text"], Cell[25742, 943, 122, 2, 33, "Input"], Cell[CellGroupData[{ Cell[25889, 949, 130, 2, 33, "Input"], Cell[26022, 953, 43, 1, 33, "Output"] }, Open ]], Cell[26080, 957, 1753, 72, 112, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[27870, 1034, 171, 7, 36, "Subsubsection"], Cell[28044, 1043, 1679, 55, 209, "Text"], Cell[29726, 1100, 847, 27, 113, "Text"], Cell[CellGroupData[{ Cell[30598, 1131, 361, 10, 33, "Input"], Cell[30962, 1143, 37, 1, 70, "Print"] }, Open ]], Cell[31014, 1147, 390, 11, 89, "Text"], Cell[CellGroupData[{ Cell[31429, 1162, 151, 4, 33, "Input"], Cell[31583, 1168, 55, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[31675, 1174, 37, 1, 33, "Input"], Cell[31715, 1177, 63, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[31815, 1183, 151, 4, 33, "Input"], Cell[31969, 1189, 45, 1, 70, "Output"] }, Open ]], Cell[32029, 1193, 217, 6, 65, "Text"], Cell[CellGroupData[{ Cell[32271, 1203, 171, 4, 33, "Input"], Cell[32445, 1209, 37, 1, 70, "Print"] }, Open ]], Cell[32497, 1213, 836, 35, 89, "Text"], Cell[CellGroupData[{ Cell[33358, 1252, 75, 1, 33, "Input"], Cell[33436, 1255, 78, 1, 70, "Output"] }, Open ]], Cell[33529, 1259, 250, 11, 41, "Text"], Cell[33782, 1272, 579, 20, 65, "Text"] }, Closed]] }, Closed]], Cell[34388, 1296, 16, 0, 31, "Text"], Cell[CellGroupData[{ Cell[34429, 1300, 115, 2, 60, "Subsection"], Cell[CellGroupData[{ Cell[34569, 1306, 116, 2, 54, "Subsubsection"], Cell[34688, 1310, 518, 18, 65, "Text"], Cell[CellGroupData[{ Cell[35231, 1332, 154, 4, 33, "Input"], Cell[35388, 1338, 35, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[35460, 1344, 152, 4, 33, "Input"], Cell[35615, 1350, 35, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[35687, 1356, 157, 4, 33, "Input"], Cell[35847, 1362, 35, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[35919, 1368, 47, 1, 33, "Input"], Cell[35969, 1371, 35, 1, 70, "Output"] }, Open ]], Cell[36019, 1375, 651, 20, 89, "Text"], Cell[CellGroupData[{ Cell[36695, 1399, 167, 2, 33, "Input"], Cell[36865, 1403, 450, 8, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[37352, 1416, 43, 1, 33, "Input"], Cell[37398, 1419, 98, 2, 70, "Output"] }, Open ]], Cell[37511, 1424, 895, 28, 113, "Text"], Cell[CellGroupData[{ Cell[38431, 1456, 146, 3, 52, "Subsubsection"], Cell[38580, 1461, 939, 44, 61, "Text"], Cell[CellGroupData[{ Cell[39544, 1509, 130, 3, 35, "Input"], Cell[39677, 1514, 1262, 29, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[40976, 1548, 44, 1, 33, "Input"], Cell[41023, 1551, 5108, 116, 70, "Output"] }, Open ]], Cell[46146, 1670, 565, 23, 61, "Text"], Cell[46714, 1695, 80, 1, 33, "Input"], Cell[46797, 1698, 139, 7, 39, "Text"], Cell[CellGroupData[{ Cell[46961, 1709, 44, 1, 33, "Input"], Cell[47008, 1712, 2312, 56, 70, "Output"] }, Open ]], Cell[49335, 1771, 113, 4, 39, "Text"], Cell[CellGroupData[{ Cell[49473, 1779, 46, 1, 33, "Input"], Cell[49522, 1782, 35, 1, 70, "Output"] }, Open ]], Cell[49572, 1786, 51, 1, 33, "Input"] }, Closed]], Cell[49638, 1790, 530, 20, 84, "Text"], Cell[50171, 1812, 574, 22, 65, "Text"], Cell[CellGroupData[{ Cell[50770, 1838, 135, 2, 33, "Input"], Cell[50908, 1842, 67, 1, 70, "Output"] }, Open ]], Cell[50990, 1846, 197, 8, 41, "Text"], Cell[CellGroupData[{ Cell[51212, 1858, 153, 3, 33, "Input"], Cell[51368, 1863, 65, 1, 70, "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[51482, 1870, 83, 2, 36, "Subsubsection"], Cell[51568, 1874, 464, 18, 65, "Text"], Cell[CellGroupData[{ Cell[52057, 1896, 35, 1, 33, "Input"], Cell[52095, 1899, 87, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[52219, 1905, 39, 1, 33, "Input"], Cell[52261, 1908, 175, 3, 70, "Output"] }, Open ]], Cell[52451, 1914, 356, 12, 65, "Text"], Cell[CellGroupData[{ Cell[52832, 1930, 127, 2, 33, "Input"], Cell[52962, 1934, 124, 2, 70, "Output"] }, Open ]], Cell[53101, 1939, 675, 24, 89, "Text"], Cell[CellGroupData[{ Cell[53801, 1967, 53, 1, 33, "Input"], Cell[53857, 1970, 54, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[53948, 1976, 55, 1, 33, "Input"], Cell[54006, 1979, 89, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[54132, 1985, 83, 1, 52, "Input"], Cell[54218, 1988, 75, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[54330, 1994, 39, 1, 33, "Input"], Cell[54372, 1997, 75, 1, 70, "Output"] }, Open ]], Cell[54462, 2001, 50, 1, 33, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[54549, 2007, 123, 2, 36, "Subsubsection"], Cell[CellGroupData[{ Cell[54697, 2013, 902, 28, 113, "Text"], Cell[55602, 2043, 138, 3, 33, "Input"], Cell[CellGroupData[{ Cell[55765, 2050, 52, 1, 33, "Input"], Cell[55820, 2053, 90, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[55947, 2059, 57, 1, 33, "Input"], Cell[56007, 2062, 93, 1, 70, "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[56149, 2069, 689, 27, 60, "Text"], Cell[56841, 2098, 143, 3, 33, "Input"], Cell[CellGroupData[{ Cell[57009, 2105, 47, 1, 33, "Input"], Cell[57059, 2108, 91, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[57187, 2114, 52, 1, 33, "Input"], Cell[57242, 2117, 97, 2, 70, "Output"] }, Open ]] }, Closed]], Cell[57366, 2123, 252, 9, 36, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[57655, 2137, 85, 2, 36, "Subsubsection"], Cell[57743, 2141, 105, 3, 41, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[57885, 2149, 101, 2, 36, "Subsubsection"], Cell[57989, 2153, 166, 6, 41, "Text"], Cell[CellGroupData[{ Cell[58180, 2163, 566, 18, 89, "Text"], Cell[CellGroupData[{ Cell[58771, 2185, 65, 1, 33, "Input"], Cell[58839, 2188, 54, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[58930, 2194, 67, 1, 33, "Input"], Cell[59000, 2197, 41, 1, 70, "Output"] }, Open ]], Cell[59056, 2201, 127, 3, 41, "Text"], Cell[CellGroupData[{ Cell[59208, 2208, 66, 1, 33, "Input"], Cell[59277, 2211, 60, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[59374, 2217, 40, 1, 33, "Input"], Cell[59417, 2220, 35, 1, 70, "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[59501, 2227, 719, 24, 84, "Text"], Cell[60223, 2253, 161, 6, 41, "Text"], Cell[CellGroupData[{ Cell[60409, 2263, 81, 1, 33, "Input"], Cell[60493, 2266, 52, 1, 70, "Output"] }, Open ]], Cell[60560, 2270, 252, 8, 41, "Text"], Cell[CellGroupData[{ Cell[60837, 2282, 116, 3, 33, "Input"], Cell[60956, 2287, 58, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[61051, 2293, 181, 4, 33, "Input"], Cell[61235, 2299, 78, 1, 70, "Output"] }, Open ]], Cell[61328, 2303, 266, 11, 41, "Text"], Cell[CellGroupData[{ Cell[61619, 2318, 40, 1, 33, "Input"], Cell[61662, 2321, 35, 1, 70, "Output"] }, Open ]], Cell[61712, 2325, 233, 8, 41, "Text"], Cell[CellGroupData[{ Cell[61970, 2337, 81, 1, 33, "Input"], Cell[62054, 2340, 72, 1, 70, "Output"] }, Open ]], Cell[62141, 2344, 182, 7, 41, "Text"], Cell[CellGroupData[{ Cell[62348, 2355, 129, 3, 33, "Input"], Cell[62480, 2360, 364, 6, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[62881, 2371, 46, 1, 33, "Input"], Cell[62930, 2374, 73, 1, 70, "Output"] }, Open ]], Cell[63018, 2378, 319, 11, 65, "Text"], Cell[CellGroupData[{ Cell[63362, 2393, 53, 1, 33, "Input"], Cell[63418, 2396, 306, 6, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[63761, 2407, 62, 1, 33, "Input"], Cell[63826, 2410, 159, 3, 70, "Output"] }, Open ]] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[64046, 2420, 87, 2, 36, "Subsubsection"], Cell[64136, 2424, 975, 40, 89, "Text"], Cell[CellGroupData[{ Cell[65136, 2468, 101, 2, 33, "Input"], Cell[65240, 2472, 409, 12, 35, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[65686, 2489, 59, 1, 33, "Input"], Cell[65748, 2492, 64, 1, 35, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[65849, 2498, 62, 1, 33, "Input"], Cell[65914, 2501, 51, 1, 35, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[66002, 2507, 55, 1, 33, "Input"], Cell[66060, 2510, 309, 8, 35, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[66406, 2523, 58, 1, 33, "Input"], Cell[66467, 2526, 245, 6, 35, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[66749, 2537, 88, 1, 33, "Input"], Cell[66840, 2540, 46, 1, 33, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[66923, 2546, 84, 1, 33, "Input"], Cell[67010, 2549, 62, 1, 33, "Output"] }, Open ]], Cell[67087, 2553, 346, 13, 65, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[67470, 2571, 89, 2, 36, "Subsubsection"], Cell[67562, 2575, 1414, 55, 137, "Text"], Cell[CellGroupData[{ Cell[69001, 2634, 203, 4, 33, "Input"], Cell[69207, 2640, 176, 3, 33, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[69420, 2648, 58, 1, 33, "Input"], Cell[69481, 2651, 121, 2, 33, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[69639, 2658, 58, 1, 33, "Input"], Cell[69700, 2661, 82, 1, 33, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[69819, 2667, 61, 1, 33, "Input"], Cell[69883, 2670, 41, 1, 33, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[69961, 2676, 58, 1, 33, "Input"], Cell[70022, 2679, 50, 1, 33, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[70109, 2685, 70, 1, 33, "Input"], Cell[70182, 2688, 58, 1, 33, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[70277, 2694, 70, 1, 33, "Input"], Cell[70350, 2697, 43, 1, 33, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[70430, 2703, 82, 1, 33, "Input"], Cell[70515, 2706, 39, 1, 33, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[70591, 2712, 84, 1, 33, "Input"], Cell[70678, 2715, 35, 1, 33, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[70750, 2721, 73, 1, 33, "Input"], Cell[70826, 2724, 35, 1, 33, "Output"] }, Open ]], Cell[70876, 2728, 450, 17, 65, "Text"], Cell[71329, 2747, 269, 8, 65, "Text"], Cell[CellGroupData[{ Cell[71623, 2759, 206, 4, 33, "Input"], Cell[71832, 2765, 177, 3, 33, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[72046, 2773, 55, 1, 33, "Input"], Cell[72104, 2776, 60, 1, 33, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[72201, 2782, 57, 1, 33, "Input"], Cell[72261, 2785, 76, 1, 33, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[72374, 2791, 67, 1, 33, "Input"], Cell[72444, 2794, 43, 1, 33, "Output"] }, Open ]], Cell[72502, 2798, 290, 11, 41, "Text"], Cell[CellGroupData[{ Cell[72817, 2813, 110, 2, 33, "Input"], Cell[72930, 2817, 54, 1, 33, "Output"] }, Open ]] }, Closed]] }, Closed]], Cell[73023, 2823, 16, 0, 31, "Text"], Cell[CellGroupData[{ Cell[73064, 2827, 117, 2, 60, "Subsection"], Cell[73184, 2831, 218, 5, 65, "Text"], Cell[CellGroupData[{ Cell[73427, 2840, 104, 2, 54, "Subsubsection"], Cell[73534, 2844, 518, 14, 89, "Text"], Cell[CellGroupData[{ Cell[74077, 2862, 195, 5, 33, "Input"], Cell[74275, 2869, 68, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[74380, 2875, 778, 24, 33, "Input"], Cell[75161, 2901, 213, 3, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[75411, 2909, 49, 1, 33, "Input"], Cell[75463, 2912, 35, 1, 70, "Output"] }, Open ]], Cell[75513, 2916, 184, 7, 41, "Text"], Cell[75700, 2925, 832, 36, 65, "Text"], Cell[76535, 2963, 600, 23, 65, "Text"], Cell[CellGroupData[{ Cell[77160, 2990, 121, 3, 35, "Input"], Cell[77284, 2995, 114, 2, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[77435, 3002, 44, 1, 33, "Input"], Cell[77482, 3005, 38, 1, 70, "Output"] }, Open ]], Cell[77535, 3009, 697, 29, 41, "Text"], Cell[CellGroupData[{ Cell[78257, 3042, 40, 1, 33, "Input"], Cell[78300, 3045, 38, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[78375, 3051, 44, 1, 33, "Input"], Cell[78422, 3054, 39, 1, 70, "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[78510, 3061, 109, 2, 36, "Subsubsection"], Cell[78622, 3065, 608, 17, 89, "Text"], Cell[79233, 3084, 1493, 48, 161, "Text"], Cell[CellGroupData[{ Cell[80751, 3136, 87, 1, 33, "Input"], Cell[80841, 3139, 37, 1, 70, "Print"] }, Open ]], Cell[80893, 3143, 365, 13, 65, "Text"], Cell[81261, 3158, 798, 20, 33, "Input"], Cell[CellGroupData[{ Cell[82084, 3182, 969, 27, 33, "Input"], Cell[83056, 3211, 231, 4, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[83324, 3220, 756, 22, 33, "Input"], Cell[84083, 3244, 193, 3, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[84313, 3252, 844, 24, 33, "Input"], Cell[85160, 3278, 126, 2, 70, "Output"] }, Open ]], Cell[85301, 3283, 1485, 52, 137, "Text"], Cell[86789, 3337, 360, 14, 41, "Text"], Cell[CellGroupData[{ Cell[87174, 3355, 389, 11, 33, "Input"], Cell[87566, 3368, 40, 1, 70, "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[87655, 3375, 93, 2, 36, "Subsubsection"], Cell[87751, 3379, 1941, 69, 233, "Text"], Cell[CellGroupData[{ Cell[89717, 3452, 441, 11, 71, "Input"], Cell[90161, 3465, 580, 9, 70, "Output"] }, Open ]], Cell[90756, 3477, 239, 7, 65, "Text"], Cell[90998, 3486, 129, 2, 52, "Input"], Cell[CellGroupData[{ Cell[91152, 3492, 55, 1, 33, "Input"], Cell[91210, 3495, 37, 1, 70, "Print"] }, Open ]], Cell[CellGroupData[{ Cell[91284, 3501, 45, 1, 33, "Input"], Cell[91332, 3504, 516, 8, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[91885, 3517, 250, 7, 33, "Input"], Cell[92138, 3526, 650, 16, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[92825, 3547, 38, 1, 33, "Input"], Cell[92866, 3550, 35, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[92938, 3556, 47, 1, 33, "Input"], Cell[92988, 3559, 35, 1, 70, "Output"] }, Open ]], Cell[93038, 3563, 467, 20, 41, "Text"], Cell[CellGroupData[{ Cell[93530, 3587, 86, 1, 33, "Input"], Cell[93619, 3590, 305, 7, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[93961, 3602, 38, 1, 33, "Input"], Cell[94002, 3605, 75, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[94114, 3611, 84, 1, 33, "Input"], Cell[94201, 3614, 79, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[94317, 3620, 38, 1, 33, "Input"], Cell[94358, 3623, 81, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[94476, 3629, 75, 1, 33, "Input"], Cell[94554, 3632, 1280, 25, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[95871, 3662, 40, 1, 33, "Input"], Cell[95914, 3665, 38, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[95989, 3671, 39, 1, 33, "Input"], Cell[96031, 3674, 255, 4, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[96323, 3683, 58, 1, 33, "Input"], Cell[96384, 3686, 234, 3, 70, "Output"] }, Open ]], Cell[96633, 3692, 49, 1, 33, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[96719, 3698, 95, 2, 36, "Subsubsection"], Cell[96817, 3702, 1135, 41, 137, "Text"], Cell[CellGroupData[{ Cell[97977, 3747, 45, 1, 33, "Input"], Cell[98025, 3750, 257, 5, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[98319, 3760, 45, 1, 33, "Input"], Cell[98367, 3763, 35, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[98439, 3769, 48, 1, 33, "Input"], Cell[98490, 3772, 342, 5, 70, "Output"] }, Open ]], Cell[98847, 3780, 345, 12, 41, "Text"], Cell[CellGroupData[{ Cell[99217, 3796, 111, 2, 33, "Input"], Cell[99331, 3800, 399, 7, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[99767, 3812, 48, 1, 33, "Input"], Cell[99818, 3815, 618, 10, 70, "Output"] }, Open ]], Cell[100451, 3828, 197, 9, 41, "Text"], Cell[CellGroupData[{ Cell[100673, 3841, 111, 2, 33, "Input"], Cell[100787, 3845, 89, 1, 70, "Output"] }, Open ]], Cell[100891, 3849, 313, 10, 41, "Text"], Cell[CellGroupData[{ Cell[101229, 3863, 67, 1, 33, "Input"], Cell[101299, 3866, 37, 1, 70, "Print"] }, Open ]], Cell[CellGroupData[{ Cell[101373, 3872, 45, 1, 33, "Input"], Cell[101421, 3875, 212, 4, 70, "Output"] }, Open ]], Cell[101648, 3882, 179, 5, 41, "Text"], Cell[CellGroupData[{ Cell[101852, 3891, 53, 1, 33, "Input"], Cell[101908, 3894, 156, 3, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[102101, 3902, 1021, 36, 89, "Text"], Cell[CellGroupData[{ Cell[103147, 3942, 89, 1, 33, "Input"], Cell[103239, 3945, 42, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[103318, 3951, 134, 3, 33, "Input"], Cell[103455, 3956, 222, 4, 70, "Output"] }, Open ]] }, Closed]], Cell[103704, 3964, 733, 25, 84, "Text"], Cell[CellGroupData[{ Cell[104462, 3993, 43, 1, 33, "Input"], Cell[104508, 3996, 68, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[104613, 4002, 46, 1, 33, "Input"], Cell[104662, 4005, 114, 2, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[104813, 4012, 46, 1, 33, "Input"], Cell[104862, 4015, 199, 3, 70, "Output"] }, Open ]], Cell[105076, 4021, 288, 10, 41, "Text"], Cell[105367, 4033, 168, 4, 52, "Input"], Cell[CellGroupData[{ Cell[105560, 4041, 58, 1, 33, "Input"], Cell[105621, 4044, 58, 1, 70, "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[105728, 4051, 97, 2, 36, "Subsubsection"], Cell[105828, 4055, 1292, 47, 137, "Text"], Cell[CellGroupData[{ Cell[107145, 4106, 58, 1, 33, "Input"], Cell[107206, 4109, 523, 8, 70, "Output"] }, Open ]], Cell[107744, 4120, 212, 5, 41, "Text"], Cell[CellGroupData[{ Cell[107981, 4129, 64, 1, 33, "Input"], Cell[108048, 4132, 103, 2, 70, "Output"] }, Open ]], Cell[108166, 4137, 218, 5, 41, "Text"], Cell[CellGroupData[{ Cell[108409, 4146, 64, 1, 33, "Input"], Cell[108476, 4149, 208, 3, 70, "Output"] }, Open ]], Cell[108699, 4155, 197, 5, 41, "Text"], Cell[CellGroupData[{ Cell[108921, 4164, 59, 1, 33, "Input"], Cell[108983, 4167, 103, 2, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[109123, 4174, 59, 1, 33, "Input"], Cell[109185, 4177, 208, 3, 70, "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[109442, 4186, 100, 2, 36, "Subsubsection"], Cell[109545, 4190, 93, 2, 41, "Text"], Cell[CellGroupData[{ Cell[109663, 4196, 55, 1, 33, "Input"], Cell[109721, 4199, 74, 1, 33, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[109832, 4205, 55, 1, 33, "Input"], Cell[109890, 4208, 130, 2, 33, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[110057, 4215, 55, 1, 33, "Input"], Cell[110115, 4218, 97, 2, 33, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[110249, 4225, 55, 1, 33, "Input"], Cell[110307, 4228, 92, 1, 33, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[110436, 4234, 65, 1, 33, "Input"], Cell[110504, 4237, 1009, 28, 115, "Output"] }, Open ]], Cell[111528, 4268, 595, 23, 89, "Text"], Cell[CellGroupData[{ Cell[112148, 4295, 74, 1, 33, "Input"], Cell[112225, 4298, 1233, 34, 225, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[113495, 4337, 46, 1, 33, "Input"], Cell[113544, 4340, 42, 1, 33, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[113623, 4346, 77, 1, 33, "Input"], Cell[113703, 4349, 42, 1, 33, "Output"] }, Open ]], Cell[113760, 4353, 653, 24, 89, "Text"], Cell[CellGroupData[{ Cell[114438, 4381, 64, 1, 33, "Input"], Cell[114505, 4384, 893, 22, 145, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[115435, 4411, 64, 1, 33, "Input"], Cell[115502, 4414, 893, 22, 145, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[116432, 4441, 69, 1, 33, "Input"], Cell[116504, 4444, 5801, 88, 311, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[122342, 4537, 46, 1, 33, "Input"], Cell[122391, 4540, 42, 1, 33, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[122470, 4546, 73, 1, 33, "Input"], Cell[122546, 4549, 42, 1, 33, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[122625, 4555, 69, 1, 33, "Input"], Cell[122697, 4558, 5801, 88, 311, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[128535, 4651, 100, 2, 33, "Input"], Cell[128638, 4655, 38, 1, 33, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[128713, 4661, 100, 2, 33, "Input"], Cell[128816, 4665, 38, 1, 33, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[128891, 4671, 129, 3, 33, "Input"], Cell[129023, 4676, 38, 1, 33, "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[129110, 4683, 99, 2, 36, "Subsubsection"], Cell[129212, 4687, 343, 8, 89, "Text"], Cell[129558, 4697, 92, 1, 52, "Input"], Cell[CellGroupData[{ Cell[129675, 4702, 588, 19, 89, "Text"], Cell[CellGroupData[{ Cell[130288, 4725, 53, 1, 33, "Input"], Cell[130344, 4728, 171, 3, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[130552, 4736, 53, 1, 33, "Input"], Cell[130608, 4739, 171, 3, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[130816, 4747, 53, 1, 33, "Input"], Cell[130872, 4750, 562, 9, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[131471, 4764, 61, 1, 33, "Input"], Cell[131535, 4767, 198, 3, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[131770, 4775, 61, 1, 33, "Input"], Cell[131834, 4778, 198, 3, 70, "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[132081, 4787, 1757, 71, 132, "Text"], Cell[CellGroupData[{ Cell[133863, 4862, 57, 1, 33, "Input"], Cell[133923, 4865, 8442, 153, 70, "Output"] }, Closed]], Cell[CellGroupData[{ Cell[142402, 5023, 46, 1, 28, "Input"], Cell[142451, 5026, 46, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[142534, 5032, 65, 1, 33, "Input"], Cell[142602, 5035, 2350, 39, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[144989, 5079, 46, 1, 33, "Input"], Cell[145038, 5082, 40, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[145115, 5088, 65, 1, 33, "Input"], Cell[145183, 5091, 2314, 39, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[147534, 5135, 73, 1, 33, "Input"], Cell[147610, 5138, 532, 7, 70, "Output"] }, Open ]], Cell[148157, 5148, 325, 14, 41, "Text"], Cell[CellGroupData[{ Cell[148507, 5166, 55, 1, 33, "Input"], Cell[148565, 5169, 37, 1, 70, "Print"] }, Open ]], Cell[CellGroupData[{ Cell[148639, 5175, 73, 1, 33, "Input"], Cell[148715, 5178, 35, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[148787, 5184, 65, 1, 33, "Input"], Cell[148855, 5187, 2183, 32, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[151075, 5224, 73, 1, 33, "Input"], Cell[151151, 5227, 2826, 42, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[154014, 5274, 46, 1, 33, "Input"], Cell[154063, 5277, 37, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[154137, 5283, 73, 1, 33, "Input"], Cell[154213, 5286, 8194, 112, 70, "Output"] }, Closed]], Cell[CellGroupData[{ Cell[162444, 5403, 46, 1, 28, "Input"], Cell[162493, 5406, 40, 1, 70, "Output"] }, Open ]] }, Closed]], Cell[162560, 5411, 410, 15, 60, "Text"], Cell[162973, 5428, 709, 22, 113, "Text"] }, Closed]] }, Closed]], Cell[163709, 5454, 16, 0, 31, "Text"], Cell[CellGroupData[{ Cell[163750, 5458, 104, 2, 60, "Subsection"], Cell[163857, 5462, 1392, 47, 161, "Text"], Cell[165252, 5511, 1140, 50, 137, "Text"], Cell[166395, 5563, 1076, 29, 185, "Text"], Cell[CellGroupData[{ Cell[167496, 5596, 272, 11, 41, "Text"], Cell[CellGroupData[{ Cell[167793, 5611, 66, 1, 33, "Input"], Cell[167862, 5614, 58, 1, 33, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[167957, 5620, 82, 1, 33, "Input"], Cell[168042, 5623, 71, 1, 33, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[168150, 5629, 199, 4, 33, "Input"], Cell[168352, 5635, 173, 3, 33, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[168562, 5643, 209, 4, 33, "Input"], Cell[168774, 5649, 177, 3, 33, "Output"] }, Open ]], Cell[168966, 5655, 16, 0, 36, "Text"], Cell[CellGroupData[{ Cell[169007, 5659, 67, 1, 33, "Input"], Cell[169077, 5662, 71, 1, 33, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[169185, 5668, 67, 1, 33, "Input"], Cell[169255, 5671, 230, 4, 52, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[169522, 5680, 67, 1, 33, "Input"], Cell[169592, 5683, 340, 6, 52, "Output"] }, Open ]], Cell[169947, 5692, 16, 0, 36, "Text"], Cell[169966, 5694, 174, 7, 39, "Text"], Cell[CellGroupData[{ Cell[170165, 5705, 70, 1, 33, "Input"], Cell[170238, 5708, 242, 4, 52, "Output"] }, Open ]], Cell[170495, 5715, 163, 6, 39, "Text"], Cell[CellGroupData[{ Cell[170683, 5725, 71, 1, 33, "Input"], Cell[170757, 5728, 37, 1, 28, "Print"] }, Open ]], Cell[CellGroupData[{ Cell[170831, 5734, 63, 1, 33, "Input"], Cell[170897, 5737, 82, 1, 33, "Output"] }, Open ]], Cell[170994, 5741, 16, 0, 36, "Text"], Cell[171013, 5743, 268, 8, 61, "Text"], Cell[CellGroupData[{ Cell[171306, 5755, 197, 4, 52, "Input"], Cell[171506, 5761, 387, 8, 71, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[171930, 5774, 81, 1, 33, "Input"], Cell[172014, 5777, 375, 6, 71, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[172426, 5788, 68, 1, 33, "Input"], Cell[172497, 5791, 432, 7, 90, "Output"] }, Open ]], Cell[172944, 5801, 16, 0, 36, "Text"], Cell[172963, 5803, 124, 3, 39, "Text"], Cell[CellGroupData[{ Cell[173112, 5810, 74, 1, 33, "Input"], Cell[173189, 5813, 37, 1, 28, "Print"] }, Open ]], Cell[CellGroupData[{ Cell[173263, 5819, 64, 1, 33, "Input"], Cell[173330, 5822, 268, 4, 33, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[173635, 5831, 59, 1, 33, "Input"], Cell[173697, 5834, 258, 4, 52, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[173992, 5843, 64, 1, 33, "Input"], Cell[174059, 5846, 272, 4, 33, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[174368, 5855, 59, 1, 33, "Input"], Cell[174430, 5858, 424, 6, 52, "Output"] }, Open ]], Cell[174869, 5867, 16, 0, 36, "Text"], Cell[174888, 5869, 200, 4, 61, "Text"], Cell[CellGroupData[{ Cell[175113, 5877, 121, 2, 33, "Input"], Cell[175237, 5881, 175, 5, 38, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[175449, 5891, 142, 3, 33, "Input"], Cell[175594, 5896, 38, 1, 33, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[175669, 5902, 142, 3, 33, "Input"], Cell[175814, 5907, 43, 1, 33, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[175894, 5913, 142, 3, 33, "Input"], Cell[176039, 5918, 35, 1, 33, "Output"] }, Open ]], Cell[176089, 5922, 16, 0, 36, "Text"], Cell[176108, 5924, 576, 14, 105, "Text"], Cell[176687, 5940, 50, 1, 33, "Input"], Cell[176740, 5943, 119, 3, 33, "Input"], Cell[CellGroupData[{ Cell[176884, 5950, 129, 3, 33, "Input"], Cell[177016, 5955, 211, 5, 63, "Output"], Cell[177230, 5962, 1404, 22, 242, "Output"] }, Open ]], Cell[178649, 5987, 207, 5, 61, "Text"], Cell[178859, 5994, 63, 1, 33, "Input"], Cell[178925, 5997, 72, 1, 33, "Input"], Cell[CellGroupData[{ Cell[179022, 6002, 129, 3, 33, "Input"], Cell[179154, 6007, 357, 6, 52, "Output"] }, Open ]], Cell[179526, 6016, 278, 11, 39, "Text"], Cell[179807, 6029, 63, 1, 33, "Input"], Cell[CellGroupData[{ Cell[179895, 6034, 156, 3, 33, "Input"], Cell[180054, 6039, 175, 5, 38, "Output"], Cell[180232, 6046, 175, 5, 38, "Output"], Cell[180410, 6053, 48, 1, 33, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[180495, 6059, 170, 3, 52, "Input"], Cell[180668, 6064, 2565, 67, 79, "Output"] }, Open ]], Cell[183248, 6134, 16, 0, 36, "Text"], Cell[183267, 6136, 551, 16, 83, "Text"], Cell[183821, 6154, 16, 0, 36, "Text"], Cell[183840, 6156, 283, 11, 61, "Text"], Cell[CellGroupData[{ Cell[184148, 6171, 119, 3, 33, "Input"], Cell[184270, 6176, 211, 5, 63, "Output"], Cell[184484, 6183, 211, 5, 63, "Output"], Cell[184698, 6190, 35, 1, 33, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[184770, 6196, 119, 3, 33, "Input"], Cell[184892, 6201, 211, 5, 63, "Output"], Cell[185106, 6208, 211, 5, 63, "Output"], Cell[185320, 6215, 35, 1, 33, "Output"] }, Open ]], Cell[185370, 6219, 279, 10, 39, "Text"], Cell[CellGroupData[{ Cell[185674, 6233, 58, 1, 33, "Input"], Cell[185735, 6236, 101, 2, 33, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[185873, 6243, 104, 2, 33, "Input"], Cell[185980, 6247, 35, 1, 33, "Output"] }, Open ]], Cell[186030, 6251, 61, 1, 33, "Input"] }, Closed]], Cell[186106, 6255, 16, 0, 31, "Text"] }, Closed]], Cell[186137, 6258, 16, 0, 31, "Text"], Cell[CellGroupData[{ Cell[186178, 6262, 90, 2, 60, "Subsection"], Cell[186271, 6266, 245, 7, 65, "Text"] }, Closed]], Cell[186531, 6276, 16, 0, 31, "Text"] }, Closed]], Cell[186562, 6279, 26, 0, 28, "Input"], Cell[CellGroupData[{ Cell[186613, 6283, 153, 4, 72, "Section"], Cell[186769, 6289, 718, 23, 89, "Text"], Cell[CellGroupData[{ Cell[187512, 6316, 100, 2, 60, "Subsection"], Cell[187615, 6320, 293, 7, 65, "Text"], Cell[CellGroupData[{ Cell[187933, 6331, 70, 1, 33, "Input"], Cell[188006, 6334, 37, 1, 70, "Print"] }, Open ]], Cell[188058, 6338, 63, 1, 33, "Input"], Cell[188124, 6341, 67, 1, 33, "Input"], Cell[188194, 6344, 66, 1, 33, "Input"], Cell[188263, 6347, 89, 1, 33, "Input"], Cell[188355, 6350, 106, 3, 41, "Text"], Cell[CellGroupData[{ Cell[188486, 6357, 82, 1, 52, "Input"], Cell[188571, 6360, 118, 2, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[188726, 6367, 37, 1, 33, "Input"], Cell[188766, 6370, 298, 4, 70, "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[189113, 6380, 101, 2, 39, "Subsection"], Cell[189217, 6384, 759, 26, 83, "Text"], Cell[CellGroupData[{ Cell[190001, 6414, 68, 1, 33, "Input"], Cell[190072, 6417, 37, 1, 28, "Print"] }, Open ]], Cell[190124, 6421, 69, 1, 33, "Input"], Cell[190196, 6424, 149, 6, 39, "Text"], Cell[CellGroupData[{ Cell[190370, 6434, 54, 1, 33, "Input"], Cell[190427, 6437, 216, 4, 73, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[190680, 6446, 67, 1, 33, "Input"], Cell[190750, 6449, 184, 3, 48, "Output"] }, Open ]], Cell[190949, 6455, 82, 1, 39, "Text"], Cell[191034, 6458, 78, 1, 33, "Input"], Cell[CellGroupData[{ Cell[191137, 6463, 39, 1, 33, "Input"], Cell[191179, 6466, 124, 2, 54, "Output"] }, Open ]], Cell[191318, 6471, 450, 16, 61, "Text"], Cell[191771, 6489, 57, 1, 33, "Input"], Cell[191831, 6492, 179, 9, 39, "Text"], Cell[CellGroupData[{ Cell[192035, 6505, 69, 1, 33, "Input"], Cell[192107, 6508, 131, 2, 48, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[192275, 6515, 1087, 30, 33, "Input"], Cell[193365, 6547, 36, 1, 33, "Output"] }, Open ]], Cell[193416, 6551, 143, 6, 39, "Text"], Cell[193562, 6559, 82, 1, 33, "Input"], Cell[193647, 6562, 129, 4, 39, "Text"], Cell[CellGroupData[{ Cell[193801, 6570, 48, 1, 33, "Input"], Cell[193852, 6573, 650, 12, 145, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[194539, 6590, 68, 1, 33, "Input"], Cell[194610, 6593, 1029, 18, 213, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[195676, 6616, 69, 1, 33, "Input"], Cell[195748, 6619, 60, 1, 33, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[195845, 6625, 89, 1, 33, "Input"], Cell[195937, 6628, 1413, 23, 279, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[197387, 6656, 209, 8, 52, "Subsubsection"], Cell[197599, 6666, 205, 5, 61, "Text"], Cell[CellGroupData[{ Cell[197829, 6675, 69, 1, 33, "Input"], Cell[197901, 6678, 70, 1, 33, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[198008, 6684, 79, 1, 33, "Input"], Cell[198090, 6687, 637, 11, 166, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[198764, 6703, 118, 2, 33, "Input"], Cell[198885, 6707, 616, 10, 166, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[199538, 6722, 97, 2, 33, "Input"], Cell[199638, 6726, 4534, 80, 801, "Output"] }, Closed]], Cell[CellGroupData[{ Cell[204209, 6811, 65, 1, 28, "Input"], Cell[204277, 6814, 2775, 46, 387, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[207089, 6865, 74, 1, 33, "Input"], Cell[207166, 6868, 2586, 41, 365, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[209789, 6914, 352, 9, 33, "Input"], Cell[210144, 6925, 38, 1, 33, "Output"] }, Open ]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[210243, 6933, 100, 2, 39, "Subsection"], Cell[210346, 6937, 87, 1, 33, "Input"], Cell[210436, 6940, 105, 4, 39, "Text"], Cell[CellGroupData[{ Cell[210566, 6948, 83, 1, 33, "Input"], Cell[210652, 6951, 37, 1, 70, "Print"] }, Open ]], Cell[210704, 6955, 59, 1, 33, "Input"], Cell[210766, 6958, 55, 1, 33, "Input"], Cell[210824, 6961, 121, 2, 52, "Input"], Cell[210948, 6965, 134, 2, 33, "Input"], Cell[211085, 6969, 77, 1, 39, "Text"], Cell[CellGroupData[{ Cell[211187, 6974, 66, 1, 33, "Input"], Cell[211256, 6977, 91, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[211384, 6983, 66, 1, 33, "Input"], Cell[211453, 6986, 91, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[211581, 6992, 52, 1, 33, "Input"], Cell[211636, 6995, 235, 4, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[211908, 7004, 56, 1, 33, "Input"], Cell[211967, 7007, 79, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[212083, 7013, 65, 1, 33, "Input"], Cell[212151, 7016, 35, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[212223, 7022, 74, 1, 33, "Input"], Cell[212300, 7025, 112, 2, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[212449, 7032, 74, 1, 33, "Input"], Cell[212526, 7035, 348, 6, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[212911, 7046, 109, 2, 33, "Input"], Cell[213023, 7050, 206, 4, 70, "Output"] }, Open ]], Cell[213244, 7057, 114, 2, 33, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[213395, 7064, 121, 2, 39, "Subsection"], Cell[213519, 7068, 638, 18, 105, "Text"], Cell[214160, 7088, 87, 1, 33, "Input"], Cell[CellGroupData[{ Cell[214272, 7093, 87, 1, 33, "Input"], Cell[214362, 7096, 37, 1, 28, "Print"] }, Open ]], Cell[214414, 7100, 53, 1, 33, "Input"], Cell[214470, 7103, 102, 2, 33, "Input"], Cell[214575, 7107, 114, 2, 33, "Input"], Cell[214692, 7111, 339, 9, 61, "Text"], Cell[CellGroupData[{ Cell[215056, 7124, 50, 1, 33, "Input"], Cell[215109, 7127, 50, 1, 33, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[215196, 7133, 50, 1, 33, "Input"], Cell[215249, 7136, 126, 2, 33, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[215412, 7143, 43, 1, 33, "Input"], Cell[215458, 7146, 93, 1, 35, "Output"] }, Open ]], Cell[215566, 7150, 159, 6, 39, "Text"], Cell[CellGroupData[{ Cell[215750, 7160, 92, 1, 33, "Input"], Cell[215845, 7163, 431, 7, 71, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[216313, 7175, 92, 1, 33, "Input"], Cell[216408, 7178, 431, 7, 71, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[216876, 7190, 92, 1, 33, "Input"], Cell[216971, 7193, 431, 7, 71, "Output"] }, Open ]], Cell[217417, 7203, 249, 8, 39, "Text"], Cell[CellGroupData[{ Cell[217691, 7215, 60, 1, 33, "Input"], Cell[217754, 7218, 10649, 168, 70, "Output"] }, Closed]], Cell[228418, 7389, 81, 1, 28, "Input"], Cell[CellGroupData[{ Cell[228524, 7394, 51, 1, 33, "Input"], Cell[228578, 7397, 10914, 182, 70, "Output"] }, Closed]], Cell[CellGroupData[{ Cell[239529, 7584, 55, 1, 28, "Input"], Cell[239587, 7587, 10977, 181, 70, "Output"] }, Closed]], Cell[250579, 7771, 145, 3, 28, "Input"], Cell[CellGroupData[{ Cell[250749, 7778, 72, 1, 33, "Input"], Cell[250824, 7781, 67, 1, 33, "Output"] }, Open ]], Cell[250906, 7785, 182, 6, 39, "Text"], Cell[CellGroupData[{ Cell[251113, 7795, 66, 1, 33, "Input"], Cell[251182, 7798, 93, 1, 35, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[251312, 7804, 66, 1, 33, "Input"], Cell[251381, 7807, 132, 2, 35, "Output"] }, Open ]], Cell[251528, 7812, 108, 2, 33, "Input"], Cell[251639, 7816, 112, 2, 33, "Input"], Cell[251754, 7820, 112, 2, 33, "Input"], Cell[251869, 7824, 112, 2, 33, "Input"], Cell[251984, 7828, 112, 2, 33, "Input"], Cell[CellGroupData[{ Cell[252121, 7834, 72, 1, 33, "Input"], Cell[252196, 7837, 67, 1, 33, "Output"] }, Open ]], Cell[252278, 7841, 86, 1, 33, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[252401, 7847, 121, 2, 39, "Subsection"], Cell[252525, 7851, 877, 29, 61, "Text"], Cell[CellGroupData[{ Cell[253427, 7884, 57, 1, 33, "Input"], Cell[253487, 7887, 704, 20, 70, "Output"] }, Open ]], Cell[254206, 7910, 860, 30, 61, "Text"], Cell[CellGroupData[{ Cell[255091, 7944, 50, 1, 33, "Input"], Cell[255144, 7947, 37, 1, 70, "Print"] }, Open ]], Cell[255196, 7951, 263, 12, 39, "Text"], Cell[CellGroupData[{ Cell[255484, 7967, 57, 1, 33, "Input"], Cell[255544, 7970, 61, 1, 70, "Output"] }, Open ]], Cell[255620, 7974, 624, 18, 105, "Text"], Cell[256247, 7994, 91, 3, 39, "Text"], Cell[256341, 7999, 169, 3, 71, "Input"], Cell[CellGroupData[{ Cell[256535, 8006, 49, 1, 33, "Input"], Cell[256587, 8009, 38, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[256662, 8015, 52, 1, 33, "Input"], Cell[256717, 8018, 35, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[256789, 8024, 55, 1, 33, "Input"], Cell[256847, 8027, 35, 1, 70, "Output"] }, Open ]], Cell[256897, 8031, 670, 21, 83, "Text"], Cell[257570, 8054, 308, 6, 71, "Input"], Cell[257881, 8062, 288, 5, 90, "Input"], Cell[CellGroupData[{ Cell[258194, 8071, 61, 1, 33, "Input"], Cell[258258, 8074, 80, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[258375, 8080, 62, 1, 33, "Input"], Cell[258440, 8083, 35, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[258512, 8089, 48, 1, 33, "Input"], Cell[258563, 8092, 44, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[258644, 8098, 55, 1, 33, "Input"], Cell[258702, 8101, 67, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[258806, 8107, 55, 1, 33, "Input"], Cell[258864, 8110, 67, 1, 70, "Output"] }, Open ]], Cell[258946, 8114, 581, 23, 61, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[259564, 8142, 111, 2, 39, "Subsection"], Cell[259678, 8146, 205, 5, 61, "Text"], Cell[259886, 8153, 47, 1, 33, "Input"], Cell[259936, 8156, 344, 11, 39, "Text"], Cell[CellGroupData[{ Cell[260305, 8171, 454, 8, 128, "Input"], Cell[260762, 8181, 364, 8, 90, "Input"] }, Closed]], Cell[261141, 8192, 16, 0, 31, "Text"], Cell[261160, 8194, 602, 17, 61, "Text"], Cell[CellGroupData[{ Cell[261787, 8215, 79, 1, 33, "Input"], Cell[261869, 8218, 75, 1, 70, "Output"] }, Open ]], Cell[261959, 8222, 105, 4, 39, "Text"], Cell[CellGroupData[{ Cell[262089, 8230, 57, 1, 33, "Input"], Cell[262149, 8233, 74, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[262260, 8239, 72, 1, 33, "Input"], Cell[262335, 8242, 890, 23, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[263262, 8270, 825, 21, 35, "Input"], Cell[264090, 8293, 40, 1, 70, "Output"] }, Open ]], Cell[264145, 8297, 16, 0, 36, "Text"], Cell[264164, 8299, 199, 5, 61, "Text"], Cell[264366, 8306, 91, 1, 33, "Input"], Cell[CellGroupData[{ Cell[264482, 8311, 109, 2, 33, "Input"], Cell[264594, 8315, 4793, 117, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[269424, 8437, 62, 1, 33, "Input"], Cell[269489, 8440, 2242, 58, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[271768, 8503, 90, 1, 33, "Input"], Cell[271861, 8506, 2128, 58, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[274026, 8569, 67, 1, 33, "Input"], Cell[274096, 8572, 4282, 109, 70, "Output"] }, Open ]], Cell[278393, 8684, 261, 7, 61, "Text"], Cell[CellGroupData[{ Cell[278679, 8695, 163, 3, 52, "Input"], Cell[278845, 8700, 40, 1, 70, "Output"] }, Open ]], Cell[278900, 8704, 16, 0, 36, "Text"], Cell[278919, 8706, 179, 5, 61, "Text"], Cell[CellGroupData[{ Cell[279123, 8715, 101, 2, 33, "Input"], Cell[279227, 8719, 1483, 39, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[280747, 8763, 177, 4, 33, "Input"], Cell[280927, 8769, 7044, 196, 70, "Output"] }, Open ]], Cell[287986, 8968, 266, 6, 61, "Text"], Cell[CellGroupData[{ Cell[288277, 8978, 190, 4, 52, "Input"], Cell[288470, 8984, 35, 1, 70, "Output"] }, Open ]], Cell[288520, 8988, 196, 5, 61, "Text"], Cell[288719, 8995, 16, 0, 36, "Text"] }, Closed]], Cell[288750, 8998, 676, 18, 84, "Text"] }, Closed]], Cell[289441, 9019, 26, 0, 28, "Input"], Cell[CellGroupData[{ Cell[289492, 9023, 155, 4, 72, "Section"], Cell[CellGroupData[{ Cell[289672, 9031, 105, 2, 60, "Subsection"], Cell[289780, 9035, 461, 15, 65, "Text"], Cell[CellGroupData[{ Cell[290266, 9054, 55, 1, 33, "Input"], Cell[290324, 9057, 130, 2, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[290491, 9064, 52, 1, 33, "Input"], Cell[290546, 9067, 52, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[290635, 9073, 54, 1, 33, "Input"], Cell[290692, 9076, 37, 1, 70, "Print"] }, Open ]], Cell[290744, 9080, 128, 6, 41, "Text"], Cell[CellGroupData[{ Cell[290897, 9090, 106, 3, 33, "Input"], Cell[291006, 9095, 189, 3, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[291232, 9103, 106, 3, 33, "Input"], Cell[291341, 9108, 189, 3, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[291567, 9116, 214, 6, 33, "Input"], Cell[291784, 9124, 177, 3, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[291998, 9132, 111, 3, 33, "Input"], Cell[292112, 9137, 100, 2, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[292249, 9144, 173, 5, 33, "Input"], Cell[292425, 9151, 338, 5, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[292800, 9161, 109, 3, 33, "Input"], Cell[292912, 9166, 88, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[293037, 9172, 111, 3, 33, "Input"], Cell[293151, 9177, 297, 6, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[293485, 9188, 146, 4, 33, "Input"], Cell[293634, 9194, 299, 6, 70, "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[293982, 9206, 109, 2, 39, "Subsection"], Cell[294094, 9210, 239, 7, 65, "Text"], Cell[CellGroupData[{ Cell[294358, 9221, 69, 1, 33, "Input"], Cell[294430, 9224, 37, 1, 70, "Print"] }, Open ]], Cell[CellGroupData[{ Cell[294504, 9230, 76, 1, 33, "Input"], Cell[294583, 9233, 66, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[294686, 9239, 56, 1, 33, "Input"], Cell[294745, 9242, 46, 1, 70, "Output"] }, Open ]], Cell[294806, 9246, 283, 11, 41, "Text"], Cell[CellGroupData[{ Cell[295114, 9261, 54, 1, 33, "Input"], Cell[295171, 9264, 58, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[295266, 9270, 54, 1, 33, "Input"], Cell[295323, 9273, 78, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[295438, 9279, 58, 1, 33, "Input"], Cell[295499, 9282, 119, 2, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[295655, 9289, 58, 1, 33, "Input"], Cell[295716, 9292, 229, 4, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[295982, 9301, 58, 1, 33, "Input"], Cell[296043, 9304, 119, 2, 70, "Output"] }, Open ]], Cell[296177, 9309, 304, 6, 89, "Text"], Cell[296484, 9317, 358, 11, 65, "Text"], Cell[296845, 9330, 74, 1, 33, "Input"], Cell[296922, 9333, 74, 1, 33, "Input"], Cell[296999, 9336, 36, 1, 41, "Text"], Cell[CellGroupData[{ Cell[297060, 9341, 54, 1, 33, "Input"], Cell[297117, 9344, 70, 1, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[297224, 9350, 54, 1, 33, "Input"], Cell[297281, 9353, 123, 2, 70, "Output"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[297453, 9361, 112, 2, 39, "Subsection"], Cell[297568, 9365, 581, 20, 89, "Text"], Cell[CellGroupData[{ Cell[298174, 9389, 68, 1, 33, "Input"], Cell[298245, 9392, 1815, 51, 70, "Output"] }, Open ]], Cell[300075, 9446, 447, 14, 89, "Text"], Cell[CellGroupData[{ Cell[300547, 9464, 78, 1, 52, "Input"], Cell[300628, 9467, 37, 1, 70, "Print"] }, Open ]], Cell[300680, 9471, 165, 6, 41, "Text"], Cell[CellGroupData[{ Cell[300870, 9481, 75, 1, 33, "Input"], Cell[300948, 9484, 271, 6, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[301256, 9495, 40, 1, 33, "Input"], Cell[301299, 9498, 98, 2, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[301434, 9505, 113, 3, 33, "Input"], Cell[301550, 9510, 98, 2, 70, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[301685, 9517, 45, 1, 33, "Input"], Cell[301733, 9520, 534, 17, 70, "Output"] }, Open ]], Cell[302282, 9540, 157, 4, 65, "Text"], Cell[CellGroupData[{ Cell[302464, 9548, 56, 1, 33, "Input"], Cell[302523, 9551, 292, 8, 70, "Output"] }, Open ]], Cell[302830, 9562, 41, 1, 33, "Input"] }, Closed]], Cell[302886, 9566, 26, 0, 28, "Input"] }, Closed]] } ] *) (*********************************************************************** End of Mathematica Notebook file. ***********************************************************************)