(************** Content-type: application/mathematica ************** CreatedBy='Mathematica 5.2' Mathematica-Compatible Notebook This notebook can be used with any Mathematica-compatible application, such as Mathematica, MathReader or Publicon. The data for the notebook starts with the line containing 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[ 31534, 931]*) (*NotebookOutlinePosition[ 32607, 966]*) (* CellTagsIndexPosition[ 32563, 962]*) (*WindowFrame->Normal*) Notebook[{ Cell[CellGroupData[{ Cell["In search of beautiful matrices", "Section"], Cell[TextData[{ "It is often desirable to have a non-singular ", Cell[BoxData[ \(TraditionalForm\`2\[Times]2\)]], " matrix with small integer entries and with distinct integer eigenvalues. \ Note that no rational number can occur as an eigenvalue of a matrix with \ integer entries. " }], "Text"], Cell[TextData[{ "In this problem we want to find all nontriangular (that is ", Cell[BoxData[ \(TraditionalForm\`a*b \[NotEqual] 0\)]], ") matrices" }], "Text"], Cell[TextData[{ " ", Cell[BoxData[ FormBox[ RowBox[{"(", "\[NegativeThinSpace]", GridBox[{ {"a", "b"}, {"c", "d"} }], "\[NegativeThinSpace]", ")"}], TraditionalForm]]], " " }], "Text"], Cell["such that ", "Text"], Cell[TextData[{ " ", Cell[BoxData[ \(TraditionalForm\`a, b, c, d \[Element] {\(-9\), \(-8\), ... , \(-1\), 0, 1, 2, ... \ , 9}\)]], " " }], "Text"], Cell[TextData[{ "has either real eigenvalues in the set ", Cell[BoxData[ \(TraditionalForm\`{\(-9\), \(-8\), ... , \(-1\), 0, 1, 2, ... \ , 9}\)]], " or the real and imaginary parts of the nonreal eigenvalues are in the set \ ", Cell[BoxData[ \(TraditionalForm\`{\(-9\), \(-8\), ... , \(-1\), 0, 1, 2, ... \ , 9}\)]], ". " }], "Text"], Cell[TextData[{ "Consider three different cases: (1) the eigenvalues are real and distinct; \ (2) there is only one real eigenvalue; (3) the eigenvalues are nonreal. For \ each case build a table showing the matrix, its eigenvalues and \ eigenvectors. For repeated eigenvalue include a root vector. For nonreal \ eigenvalues, include only one eigenvalue and a corresponding eigenvector. \ Explore ", StyleBox["Options[TableForm]", "Input"], " to get your table to display nicely. " }], "Text"], Cell[TextData[{ "There are many similar names in this notebook, so I will set the \ spellcheck ", StyleBox["Off", "Input"], ". " }], "Text"], Cell[BoxData[{ \(\(Off[General::"\"];\)\), "\[IndentingNewLine]", \(\(Off[General::"\"];\)\)}], "Input"], Cell[CellGroupData[{ Cell["All matrices with real and distinct eigenvalues", "Subsection"], Cell[TextData[{ "The idea is to look at a matrix as a pair of two pairs of numbers: ", Cell[BoxData[ \(TraditionalForm\`{{a, b}, {c, d}}\)]], ". This is ", StyleBox["Mathematica", FontSlant->"Italic"], "'s representation for the matrix ", Cell[BoxData[ FormBox[ RowBox[{"(", "\[NegativeThinSpace]", GridBox[{ {"a", "b"}, {"c", "d"} }], "\[NegativeThinSpace]", ")"}], TraditionalForm]]], " . We will consider only matrices with a nonnegative entry ", Cell[BoxData[ \(TraditionalForm\`a\)]], " and relatively prime entries ", Cell[BoxData[ \(TraditionalForm\`a, b, c, d\)]], ". Since all triangular matrices belong to this class we will not include \ them in the Book. " }], "Text"], Cell[TextData[{ "The set of all possible pairs ", Cell[BoxData[ \(TraditionalForm\`{a, b}\)]], " is the Cartesian product of the sets ", Cell[BoxData[ \(TraditionalForm\`{0, 1, 2, ... , 9}\)]], " and ", Cell[BoxData[ \(TraditionalForm\`{\(-9\), \ \(-8\), \ ... , \(-1\), 0, 1, ... , 8, 9}\)]], ". The set of all possible pairs ", Cell[BoxData[ \(TraditionalForm\`{c, d}\)]], " is the Cartesian square of the last set. The set of matrices that we \ will start with is the Cartesian product of the previous two Cartesian \ products. " }], "Text"], Cell[TextData[{ "To get a Cartesian product of two sets I use ", StyleBox["Outer[]", "Input"], ". This is a complicated command. For this purpose it is enough to \ observe that the integer at position 4 in ", StyleBox["Outer", "Input"], " indicates to ", StyleBox["Outer", "Input"], " to treat as separate elements only sublists at level 1. Otherwise \ undesirable output will result. As an example consider " }], "Text"], Cell[BoxData[ \(Outer[List, {a, b, c}, {x, y, z}, 1]\)], "Input"], Cell[BoxData[ \(\(allabs = Flatten[Outer[List, Range[0, 9], Range[\(-9\), 9]], 1];\)\)], "Input"], Cell[BoxData[ \(Length[allabs]\)], "Input"], Cell[BoxData[ \(\(allcds = Flatten[Outer[List, Range[\(-9\), 9], Range[\(-9\), 9]], 1];\)\)], "Input"], Cell[BoxData[ \(Length[allcds]\)], "Input"], Cell["\<\ Now I produce the starting set of matrices of interest. This set will be \ further reduced in several steps. \ \>", "Text"], Cell[BoxData[ \(\(allmats = Flatten[Outer[List, allabs, allcds, 1], 1];\)\)], "Input"], Cell[BoxData[ \(Length[allmats]\)], "Input"], Cell[BoxData[ \(allmats[\([21249]\)]\)], "Input"], Cell["\<\ At this step we select non-triangular matrices whose entries are relatively \ prime. \ \>", "Text"], Cell[BoxData[ \(\(mats1 = Select[allmats, \((\((Apply[GCD, Flatten[#]] \[Equal] 1)\) \[And] \((#\[LeftDoubleBracket]1, 2\[RightDoubleBracket]\ #\[LeftDoubleBracket]2, 1\[RightDoubleBracket] \[NotEqual] 0)\))\) &];\)\)], "Input"], Cell[BoxData[ \(Length[mats1]\)], "Input"], Cell[TextData[{ "Looking at the formula for eigenvalues of a general matrix ", Cell[BoxData[ FormBox[ RowBox[{"(", "\[NegativeThinSpace]", GridBox[{ {"a", "b"}, {"c", "d"} }], "\[NegativeThinSpace]", ")"}], TraditionalForm]]], " , doing it by hand or in ", StyleBox["Mathematica: ", FontSlant->"Italic"] }], "Text"], Cell[BoxData[ \(FullSimplify[Eigenvalues[{{a, b}, {c, d}}]]\)], "Input"], Cell[TextData[{ "We see that the eigenvalues will be distinct integers if ", Cell[BoxData[ \(TraditionalForm\`\@\(4\ b\ c + \((a - d)\)\^2\)\)]], " is a positive integer. Now I select matrices from ", StyleBox["mats1", FontFamily->"Courier New", FontWeight->"Bold"], " that satisfy this condition: " }], "Text"], Cell[BoxData[ \(Timing[\ \(mats2 = Select[mats1, \((IntegerQ[\@\(4\ #\[LeftDoubleBracket]1, 2\ \[RightDoubleBracket]*#\[LeftDoubleBracket]2, 1\[RightDoubleBracket] + \((#\ \[LeftDoubleBracket]1, 1\[RightDoubleBracket] - #\[LeftDoubleBracket]2, 2\ \[RightDoubleBracket])\)\^2\)] \[And] Positive[\@\(4\ #\[LeftDoubleBracket]1, 2\ \[RightDoubleBracket]*#\[LeftDoubleBracket]2, 1\[RightDoubleBracket] + \((#\ \[LeftDoubleBracket]1, 1\[RightDoubleBracket] - #\[LeftDoubleBracket]2, 2\ \[RightDoubleBracket])\)\^2\)])\) &];\)]\)], "Input"], Cell[BoxData[ \(Length[mats2]\)], "Input"], Cell[TextData[{ "The same selection can be done using ", StyleBox["Cases[]", FontFamily->"Courier New", FontWeight->"Bold"] }], "Text"], Cell[BoxData[ \(Timing[\(mats2a = Cases[allmats1, {{a_, b_}, {c_, d_}} /; IntegerQ[\@\(4\ b\ c + \((a - d)\)\^2\)] \[And] Positive[\@\(4\ b\ c + \((a - d)\)\^2\)]];\)]\)], "Input"], Cell[BoxData[ \(Length[mats2a]\)], "Input"], Cell["\<\ At the final step we drop matrices with too large eigenvalues and too large \ coordinates in eigenvectors. These are all desired matrices. \ \>", "Text"], Cell[TextData[{ "To calculate the eigenvalues and the eigenvectors of a given matrix we use \ ", StyleBox["Eigenystem[]", FontFamily->"Courier New", FontWeight->"Bold"] }], "Text"], Cell[BoxData[ \(Eigensystem[mats2[\([2356]\)]]\)], "Input"], Cell["\<\ We are interested only in the absolute value of the numbers that appear in \ the last object: \ \>", "Text"], Cell[BoxData[ \(Abs[Flatten[Eigensystem[mats2[\([2356]\)]]]]\)], "Input"], Cell[TextData[{ "In fact only the ", StyleBox["Max[] ", FontFamily->"Courier New", FontWeight->"Bold"], "of the last set is relevant " }], "Text"], Cell[BoxData[ \(Max[Abs[Flatten[Eigensystem[mats2[\([2356]\)]]]]]\)], "Input"], Cell[BoxData[ \(Timing[\ \(mats3 = \[IndentingNewLine]Select[\ \ \[IndentingNewLine]mats2, \[IndentingNewLine]\((Max[\ Abs[Flatten[Eigensystem[#]]]] < 10)\) &\[IndentingNewLine]\ \ \ \ \ \ \ \ \ \ \ \ \ \ ];\)\ \[IndentingNewLine]\ \ \ \ \ \ \ \ \ \ \ \ \ \ ]\)], "Input"], Cell[BoxData[ \(Length[mats3]\)], "Input"], Cell[TextData[{ "Or using ", StyleBox["Cases[]", FontFamily->"Courier New", FontWeight->"Bold"], " " }], "Text"], Cell[BoxData[ \(Timing[\(mats3a = Cases[mats2, x_ /; Max[Abs[Flatten[Eigensystem[x]]]] < 10];\)]\)], "Input"], Cell[BoxData[ \(Length[mats3a]\)], "Input"], Cell[BoxData[ \(mats3[\([1]\)]\)], "Input"], Cell[TextData[{ "Next few cells I will look into the structure of ", StyleBox["mats3.", FontFamily->"Courier New", FontWeight->"Bold"] }], "Text"], Cell[BoxData[ \(Table[{k, Length[Select[ mats3, #\[LeftDoubleBracket]1, 1\[RightDoubleBracket] \[Equal] k &]]}, {k, 0, 9}]\)], "Input"], Cell[BoxData[ \(Length[Select[mats3, Det[#] \[Equal] 0 &]]\)], "Input"], Cell[BoxData[ \(Length[Select[mats3, Det[#] > 0 &]]\)], "Input"], Cell[BoxData[ \(Length[Select[mats3, Det[#] < 0 &]]\)], "Input"], Cell["\<\ The lack of symmetry in the last two numbers comes from the fact that we are \ considering only nonnegative top-left eintry. \ \>", "Text"], Cell["\<\ Recall that our final table has 4292 matrices. (It would have 2*4292-486, \ that is 8098 matrices if we also considered negative top-left eintries.) \ \>", "Text"], Cell[BoxData[ \(Length[mats3]\)], "Input"], Cell[TextData[{ "Since we are dealing with a large number of matrices, before making the \ final table I experiment with a short form of the table. I do that by using \ ", StyleBox["Take[]", FontFamily->"Courier New", FontWeight->"Bold"] }], "Text"], Cell[BoxData[ \(\(?Take\)\)], "Input"], Cell[BoxData[ \(Options[TableForm]\)], "Input"], Cell[BoxData[ \(TableForm[ Partition[Take[mats3, 24], 3, 3, {1, 1}, "\< \>"] /. {{a_Integer, b_Integer}, {c_Integer, d_Integer}} \[RuleDelayed] \ \ {MatrixForm[{{a, b}, {c, d}}], TableForm[Map[MatrixForm, Eigensystem[{{a, b}, {c, d}}], {2}], TableSpacing \[Rule] \ {1}]}, TableDirections \[Rule] {Column, Row, Row, Column}, TableSpacing \[Rule] \ {4, 5, 2, 4}, TableHeadings \[Rule] \ {None, {"\", \ "\", "\"}}]\)], "Input"], Cell[BoxData[ \(\(?Partition\)\)], "Input"], Cell[BoxData[ \(Partition[Take[mats3, 24], 3, 3, {1, 1}, "\< \>"]\)], "Input"], Cell[BoxData[ \(TableForm[ Partition[Take[mats3, Length[mats3]], 4, 4, {1, 2}, "\< \>"] /. {{a_Integer, b_Integer}, {c_Integer, d_Integer}} \[RuleDelayed] \ \ {MatrixForm[{{a, b}, {c, d}}], TableForm[Map[MatrixForm, Eigensystem[{{a, b}, {c, d}}], {2}], TableSpacing \[Rule] \ { .5}]}, TableDirections \[Rule] {Column, Row, Row, Column}, TableSpacing \[Rule] \ {4, 3, 2, 1}, TableHeadings \[Rule] \ {None, {"\", \ "\", "\", "\"}}]\)], "Input"], Cell[BoxData[ \(TableForm[ Partition[\ mats3, 3, 3, {1, 1}, "\< \>"] /. {{a_Integer, b_Integer}, {c_Integer, d_Integer}} \[RuleDelayed] \ \ {MatrixForm[{{a, b}, {c, d}}], TableForm[Map[MatrixForm, Eigensystem[{{a, b}, {c, d}}], {2}], TableSpacing \[Rule] \ {1}]}, TableDirections \[Rule] {Column, Row, Row, Column}, TableSpacing \[Rule] \ {4, 5, 2, 4}, TableHeadings \[Rule] \ {None, {"\", \ "\", "\"}}]\)], "Input"], Cell["\<\ If we are interested only in matrices with a 0 eigenvalue we select them with\ \ \>", "Text"], Cell[BoxData[ \(\(\(Select[\ mats3, Det[#] \[Equal] 0 &];\)\(\ \)\)\)], "Input"], Cell[BoxData[ \(TableForm[ Partition[Select[\ mats3, Det[#] \[Equal] 0 &], 3, 3, {1, 1}, "\< \>"] /. {{a_Integer, b_Integer}, {c_Integer, d_Integer}} \[RuleDelayed] \ \ {MatrixForm[{{a, b}, {c, d}}], TableForm[Map[MatrixForm, Eigensystem[{{a, b}, {c, d}}], {2}], TableSpacing \[Rule] \ {1}]}, TableDirections \[Rule] {Column, Row, Row, Column}, TableSpacing \[Rule] \ {4, 5, 2, 4}, TableHeadings \[Rule] \ {None, {"\", \ "\", "\"}}]\)], "Input"], Cell[CellGroupData[{ Cell["Matrices ordered by eigenvalues", "Subsubsection"], Cell[BoxData[ \(\(\(\ \)\(mats4e = Cases[mats3, x_ \[RuleDelayed] {x, Eigensystem[x]}];\)\)\)], "Input"], Cell[BoxData[ \(Length[mats4e]\)], "Input"], Cell[BoxData[ \(\(\(\ \)\(mats5e = Sort[\ mats4e, \((\((#1[\([2, 1, 1]\)] < #2[\([2, 1, 1]\)])\) || \((#1[\([2, 1, 1]\)] \[Equal] #2[\([2, 1, 1]\)] && #1[\([2, 1, 2]\)] < #2[\([2, 1, 2]\)])\))\) &];\)\)\)], "Input"], Cell[BoxData[ \(Take[\ mats5e, 6]\)], "Input"], Cell[BoxData[ \(Length[mats5e]\)], "Input"], Cell[BoxData[ \(\(\(\ \)\(mats6e = Cases[mats5e, x_ \[RuleDelayed] \ x\[LeftDoubleBracket]1\[RightDoubleBracket]];\)\)\)], "Input"], Cell[BoxData[ \(\(\(\ \)\(mats6e[\([1]\)]\)\)\)], "Input"], Cell[BoxData[ \(Length[\ mats6e]\)], "Input"], Cell[BoxData[ \(TableForm[ Partition[Take[mats6e, Length[mats6e]], 4, 4, {1, 2}, "\< \>"] /. {{a_Integer, b_Integer}, {c_Integer, d_Integer}} \[RuleDelayed] \ \ {MatrixForm[{{a, b}, {c, d}}], TableForm[Map[MatrixForm, Eigensystem[{{a, b}, {c, d}}], {2}], TableSpacing \[Rule] \ { .5}]}, TableDirections \[Rule] {Column, Row, Row, Column}, TableSpacing \[Rule] \ {4, 3, 2, 1}, TableHeadings \[Rule] \ {None, {"\", \ "\", "\", "\"}}]\)], "Input"], Cell[BoxData[ \(TableForm[Partition[\ mats6e, 3, 3, {1, 1}, Null], TableDirections \[Rule] {Column, Row, Row, Column}, TableSpacing \[Rule] {4, 5, 2, 4}, TableHeadings \[Rule] {None, {"\", \ "\", "\"}}]\)], \ "Input"] }, Closed]], Cell[CellGroupData[{ Cell["\<\ A way to reduce the number of matrices using \"standard rules\"\ \>", "Subsubsection"], Cell[BoxData[ \(\(mats4 = Select[mats3, \((\((Apply[ Plus, #\[LeftDoubleBracket]1\[RightDoubleBracket]] \ \[NotEqual] Apply[Plus, #\[LeftDoubleBracket]2\[RightDoubleBracket]])\ \) \[And] \((Apply[ Plus, \(Transpose[#]\)\[LeftDoubleBracket]1\ \[RightDoubleBracket]] \[NotEqual] Apply[Plus, \(Transpose[#]\)\[LeftDoubleBracket]2\ \[RightDoubleBracket]])\))\) &];\)\)], "Input"], Cell[BoxData[ \(Length[mats4]\)], "Input"], Cell[BoxData[ \(Table[{k, Length[Select[ mats4, #\[LeftDoubleBracket]1, 1\[RightDoubleBracket] \[Equal] k &]]}, {k, 0, 9}]\)], "Input"], Cell[BoxData[ \(Length[Select[mats4, Det[#] \[Equal] 0 &]]\)], "Input"], Cell[BoxData[ \(Length[\ Cases[mats4, x_ /; Det[x] > 0]]\)], "Input"], Cell[BoxData[ \(Length[\ Cases[mats4, x_ /; Det[x] < 0]]\)], "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Complex Integer Eigenvalues", "Subsection"], Cell[BoxData[ \(Length[mats1]\)], "Input"], Cell["\<\ Now we select all the matrices with non-real integer eigenvalues: \ \>", "Text"], Cell[BoxData[ \(Timing[\(mats2c = Cases[mats1, {{a_, b_}, {c_, d_}} /; IntegerQ[\@\(-\((\((a - d)\)\^2 + 4\ b\ c)\)\)] \[And] Positive[\@\(-\((\((a - d)\)\^2 + 4\ b\ c)\)\)]];\)]\)], \ "Input"], Cell[BoxData[ \(Length[mats2c]\)], "Input"], Cell[BoxData[ \(mats2c[\([60]\)]\)], "Input"], Cell[BoxData[ \(Max[ Abs[Union[Re[Flatten[Eigensystem[allmats2c[\([60]\)]]]], Re[Flatten[Eigensystem[allmats2c[\([60]\)]]]]]]]\)], "Input"], Cell["\<\ Disregard too large numbers in the solutions: These are all relevant \ matrices. \ \>", "Text"], Cell[BoxData[ \(Timing[\(mats3c = Cases[mats2c, x_ /; Max[ Abs[Union[Re[Flatten[Eigensystem[x]]], Re[Flatten[Eigensystem[x]]]]]] < 10];\)]\)], "Input"], Cell[BoxData[ \(Length[mats3c]\)], "Input"], Cell[BoxData[ \(TableForm[ Take[mats3c, {250, 260}] /. {{a_, b_}, {c_, d_}} \[RuleDelayed] \ \ {MatrixForm[{{a, b}, {c, d}}], Map[MatrixForm, Eigensystem[{{a, b}, {c, d}}], {2}]}]\)], "Input"], Cell[BoxData[ \(TableForm[ Take[mats3c, {115, 125}] /. {{a_, b_}, {c_, d_}} \[RuleDelayed] \ \ {MatrixForm[{{a, b}, {c, d}}], Map[MatrixForm, {{\(Eigensystem[{{a, b}, {c, d}}]\)\[LeftDoubleBracket]1, 1\[RightDoubleBracket]}, {LCM[ Denominator[ Re[\(\(Eigensystem[{{a, b}, {c, d}}]\)\[LeftDoubleBracket]2, 1\[RightDoubleBracket]\)[\([1]\)]]], Denominator[\(\(Eigensystem[{{a, b}, {c, d}}]\)\[LeftDoubleBracket]2, 1\[RightDoubleBracket]\)[\([1]\)]]] \ \(Eigensystem[{{a, b}, {c, d}}]\)\[LeftDoubleBracket]2, 1\[RightDoubleBracket]}}, {2}]}]\)], "Input"], Cell[BoxData[ \(TableForm[ Partition[Take[mats3c, Length[mats2c]], 4, 4, {1, 2}, "\< \>"] /. {{a_Integer, b_Integer}, {c_Integer, d_Integer}} \[RuleDelayed] \ \ {MatrixForm[{{a, b}, {c, d}}], TableForm[ Map[MatrixForm, {{\(Eigensystem[{{a, b}, {c, d}}]\)\[LeftDoubleBracket]1, 1\[RightDoubleBracket]}, {LCM[ Denominator[ Re[\(\(Eigensystem[{{a, b}, {c, d}}]\)\[LeftDoubleBracket]2, 1\[RightDoubleBracket]\)[\([1]\)]]], Denominator[\(\(Eigensystem[{{a, b}, {c, d}}]\)\[LeftDoubleBracket]2, 1\[RightDoubleBracket]\)[\([1]\)]]]\ \[IndentingNewLine]\(Eigensystem[{{a, b}, {c, d}}]\)\[LeftDoubleBracket]2, 1\[RightDoubleBracket]}}, {2}], TableSpacing \[Rule] \ {1}]}, TableDirections \[Rule] {Column, Row, Row, Column}, TableSpacing \[Rule] \ {4, 3, 2, 1}, TableHeadings \[Rule] \ {None, {"\", \ "\", "\", "\"}}]\)], "Input"], Cell[BoxData[ \(Length[mats3c]\)], "Input"], Cell[BoxData[ \(Re[\(Eigensystem[mats3c[\([47]\)]]\)[\([1, 1]\)]]\)], "Input"], Cell[BoxData[ \(\(\(\ \)\(mats4c = Cases[\[IndentingNewLine]mats3c, x_ \[RuleDelayed] {x, {Re[\(Eigensystem[x]\)[\([1, 1]\)]], Im[\(Eigensystem[x]\)[\([1, 1]\)]]}}\[IndentingNewLine]];\)\)\)], "Input"], Cell[BoxData[ \(Length[\ mats4c]\)], "Input"], Cell[BoxData[ \(\(mats4c\[LeftDoubleBracket]354\[RightDoubleBracket]\)\ \[LeftDoubleBracket]2, 2\[RightDoubleBracket]\)], "Input"], Cell[BoxData[ \(\(mats5c = Sort[mats4c, #1[\([2, 1]\)] < #2[\([2, 1]\)] \[Or] \((#1[\([2, 1]\)] == #2[\([2, 1]\)] \[And] #1[\([2, 2]\)] < #2[\([2, 2]\)])\) &];\)\)], "Input"], Cell[BoxData[ \(Length[mats5c]\)], "Input"], Cell[BoxData[ \(\(mats6c = Cases[\[IndentingNewLine]mats5c, x_ \[RuleDelayed] x\[LeftDoubleBracket]1\[RightDoubleBracket]\[IndentingNewLine]];\)\ \)], "Input"], Cell[BoxData[ \(mats6c[\([12]\)]\)], "Input"], Cell[BoxData[ \(TableForm[ Partition[Take[mats6c, Length[mats6c]], 4, 4, {1, 2}, "\< \>"] /. {{a_Integer, b_Integer}, {c_Integer, d_Integer}} \[RuleDelayed] \ \ {MatrixForm[{{a, b}, {c, d}}], TableForm[ Map[MatrixForm, {{\(Eigensystem[{{a, b}, {c, d}}]\)\[LeftDoubleBracket]1, 1\[RightDoubleBracket]}, {LCM[ Denominator[ Re[\(\(Eigensystem[{{a, b}, {c, d}}]\)\[LeftDoubleBracket]2, 1\[RightDoubleBracket]\)[\([1]\)]]], Denominator[\(\(Eigensystem[{{a, b}, {c, d}}]\)\[LeftDoubleBracket]2, 1\[RightDoubleBracket]\)[\([1]\)]]]\ \[IndentingNewLine]\(Eigensystem[{{a, b}, {c, d}}]\)\[LeftDoubleBracket]2, 1\[RightDoubleBracket]}}, {2}], TableSpacing \[Rule] \ {1}]}, TableDirections \[Rule] {Column, Row, Row, Column}, TableSpacing \[Rule] \ {4, 3, 2, 1}, TableHeadings \[Rule] \ {None, {"\", \ "\", "\", "\"}}]\)], "Input"], Cell[BoxData[ \(TableForm[ Partition[\ mats6c, 3, 3, {1, 1}, "\< \>"] /. {{a_Integer, b_Integer}, {c_Integer, d_Integer}} \[RuleDelayed] \ \ {MatrixForm[{{a, b}, {c, d}}], TableForm[ Map[MatrixForm, {{\(Eigensystem[{{a, b}, {c, d}}]\)\[LeftDoubleBracket]1, 1\[RightDoubleBracket]}, {LCM[ Denominator[ Re[\(\(Eigensystem[{{a, b}, {c, d}}]\)\[LeftDoubleBracket]2, 1\[RightDoubleBracket]\)[\([1]\)]]], Denominator[\(\(Eigensystem[{{a, b}, {c, d}}]\)\[LeftDoubleBracket]2, 1\[RightDoubleBracket]\)[\([1]\)]]]\ \[IndentingNewLine]\(Eigensystem[{{a, b}, {c, d}}]\)\[LeftDoubleBracket]2, 1\[RightDoubleBracket]}}, {2}], TableSpacing \[Rule] \ {1}]}, TableDirections \[Rule] {Column, Row, Row, Column}, TableSpacing \[Rule] \ {4, 5, 2, 4}, TableHeadings \[Rule] \ {None, {"\", \ "\", "\"}}]\)], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["Repeated Eigenvalues", "Subsection"], Cell[BoxData[ \(Length[mats1]\)], "Input"], Cell[TextData[{ "Disregard the constant multiple and triangular matrices (", Cell[BoxData[ \(TraditionalForm\`b\ c\ = 0\)]], "): " }], "Text"], Cell["Collect all repeated eigenvalues solutions: ", "Text"], Cell[BoxData[ \(Timing[\(mats2r = Cases[mats1, {{a_, b_}, {c_, d_}} /; \[Not] \((a\ d - b\ c == 0)\) \[And] \((a\^2 + 4\ b\ c - 2\ a\ d + d\^2 \[Equal] 0)\)];\)]\)], "Input"], Cell[BoxData[ \(Length[mats2r]\)], "Input"], Cell["\<\ Disregard too large numbers in the solutions: These are all relevant \ matrices. \ \>", "Text"], Cell[BoxData[ \(Timing[\(mats3r = Cases[mats2r, x_ /; Max[Abs[Flatten[Eigensystem[x]]]] < 10];\)]\)], "Input"], Cell[BoxData[ \(Length[mats3r]\)], "Input"], Cell[BoxData[ \(Off[Solve::"\"]\)], "Input"], Cell[BoxData[ \(Clear[RootVector]; RootVector[M_] := Module[{evl, evc}, evl = \(Eigensystem[M]\)\[LeftDoubleBracket]1, 1\[RightDoubleBracket]; evc = \(Eigensystem[M]\)\[LeftDoubleBracket]2, 1\[RightDoubleBracket]; \(({x, y} /. \(Solve[\((M - evl\ IdentityMatrix[2])\) . {x, y} \[Equal] evc, {x, y}]\)\[LeftDoubleBracket]1\[RightDoubleBracket])\) /. {y \ \[Rule] 0, x \[Rule] 0}]\)], "Input"], Cell[BoxData[ \(Length[mats3r]\)], "Input"], Cell[BoxData[ \(RootVector[mats3r[\([39]\)]]\)], "Input"], Cell[BoxData[ \(TableForm[\[IndentingNewLine]Take[ mats3r, {50, 60}] /. {{a_, b_}, {c_, d_}} \[RuleDelayed] \ \[IndentingNewLine]\ \ {\[IndentingNewLine]MatrixForm[{{a, b}, {c, d}}], Map[MatrixForm, \ \[IndentingNewLine]{\[IndentingNewLine]{\(Eigensystem[{{a, b}, {c, d}}]\)[\([1, 1]\)], "\"}, \[IndentingNewLine]Apply[LCM, Denominator[ RootVector[{{a, b}, {c, d}}]]]\[IndentingNewLine]{\(Eigensystem[{{a, b}, {c, d}}]\)[\([2, 1]\)], \ RootVector[{{a, b}, {c, d}}]}\[IndentingNewLine]}, \[IndentingNewLine]{2}]\ \[IndentingNewLine]\ \ \ \ \ \ \ \ \ }\[IndentingNewLine]\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ]\)], "Input"], Cell[BoxData[ \(TableForm[\[IndentingNewLine]Take[ mats3r, {50, 60}] /. {{a_, b_}, {c_, d_}} \[RuleDelayed] \ \[IndentingNewLine]\ \ {\[IndentingNewLine]MatrixForm[{{a, b}, {c, d}}], Map[MatrixForm, ReplacePart[ Eigensystem[{{a, b}, {c, d}}], "\", {1, 2}] /. {{0, 0} -> RootVector[{{a, b}, {c, d}}]}, {2}]\[IndentingNewLine]\ \ \ \ \ \ \ \ \ }\ \[IndentingNewLine]\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ]\)], "Input"], Cell[BoxData[ \(TableForm[\[IndentingNewLine]Partition[Take[mats3r, Length[mats3r]], 4, 4, {1, 1}, "\< \>"] /. {{a_Integer, b_Integer}, {c_Integer, d_Integer}} \[RuleDelayed] \ \ {MatrixForm[{{a, b}, {c, d}}], TableForm[ Map[MatrixForm, ReplacePart[ Eigensystem[{{a, b}, {c, d}}], "\", {1, 2}] /. {{0, 0} -> RootVector[{{a, b}, {c, d}}]}, \[IndentingNewLine]{2}], TableSpacing \[Rule] \ {1}]}, TableDirections \[Rule] {Column, Row, Row, Column}, TableSpacing \[Rule] \ {4, 3, 1, 2}, TableHeadings \[Rule] \ {None, {"\", "\", "\", "\"}}]\)], "Input"], Cell[CellGroupData[{ Cell["Matrices ordered by repeated eigenvalues", "Subsubsection"], Cell[BoxData[ \(Eigensystem[mats3r[\([23]\)]]\)], "Input"], Cell[BoxData[ \(\(Eigensystem[mats3r[\([23]\)]]\)[\([1, 1]\)]\)], "Input"], Cell[BoxData[ \(\(mats4r = Cases[\[IndentingNewLine]mats3r, x_ \[RuleDelayed] {x, \ \(Eigensystem[x]\)[\([1, 1]\)]}\[IndentingNewLine]];\)\)], "Input"], Cell[BoxData[ \(Length[mats4r]\)], "Input"], Cell[BoxData[ \(\(mats4r\[LeftDoubleBracket]54\[RightDoubleBracket]\)\ \[LeftDoubleBracket]2\[RightDoubleBracket]\)], "Input"], Cell[BoxData[ \(\(mats5r = Sort[mats4r, #1[\([2]\)] < #2[\([2]\)] &];\)\)], "Input"], Cell[BoxData[ \(Length[mats5r]\)], "Input"], Cell[BoxData[ \(\(mats6r = Cases[\[IndentingNewLine]mats5r, x_ \[RuleDelayed] x\[LeftDoubleBracket]1\[RightDoubleBracket]\[IndentingNewLine]];\)\ \)], "Input"], Cell[BoxData[ \(TableForm[\[IndentingNewLine]Partition[Take[mats6r, Length[mats6r]], 4, 4, {1, 1}, "\< \>"] /. {{a_Integer, b_Integer}, {c_Integer, d_Integer}} \[RuleDelayed] \ \ {MatrixForm[{{a, b}, {c, d}}], TableForm[ Map[MatrixForm, ReplacePart[ Eigensystem[{{a, b}, {c, d}}], "\", {1, 2}] /. {{0, 0} -> RootVector[{{a, b}, {c, d}}]}, \[IndentingNewLine]{2}], TableSpacing \[Rule] \ {1}]}, TableDirections \[Rule] {Column, Row, Row, Column}, TableSpacing \[Rule] \ {4, 3, 1, 2}, TableHeadings \[Rule] \ {None, {"\", "\", "\", "\"}}]\)], "Input"], Cell[BoxData[ \(TableForm[\[IndentingNewLine]Partition[allmats6r, 3, 3, {1, 1}, "\< \>"] /. {{a_Integer, b_Integer}, {c_Integer, d_Integer}} \[RuleDelayed] \ \ {MatrixForm[{{a, b}, {c, d}}], TableForm[ Map[MatrixForm, ReplacePart[ Eigensystem[{{a, b}, {c, d}}], "\", {1, 2}] /. {{0, 0} -> RootVector[{{a, b}, {c, d}}]}, {2}], TableSpacing \[Rule] \ {1}]}, TableDirections \[Rule] {Column, Row, Row, Column}, TableSpacing \[Rule] \ {4, 5, 2, 4}, TableHeadings \[Rule] \ {None, {"\", \ "\", "\"}}]\)], "Input"] }, Closed]] }, Closed]] }, Closed]], Cell["Probabilitiy of a beautiful matrix", "Section"] }, FrontEndVersion->"5.2 for Microsoft Windows", ScreenRectangle->{{0, 1152}, {0, 791}}, WindowSize->{1144, 764}, WindowMargins->{{0, Automatic}, {Automatic, 0}}, PrintingCopies->1, PrintingPageRange->{Automatic, Automatic}, PageHeaders->{{ Inherited, Inherited, Inherited}, { Inherited, "The Book of Beautiful Matrices. Vol. 3 (ordered by repeated \ eigenvelue)", Inherited}}, PrintingOptions->{"PrintingMargins"->{{18, 36}, {18, 54}}, "PrintCellBrackets"->False, "PrintRegistrationMarks"->True, "PrintMultipleHorizontalPages"->False}, ShowSelection->True, Magnification->1.25 ] (******************************************************************* 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[1776, 53, 50, 0, 92, "Section"], Cell[1829, 55, 310, 7, 59, "Text"], Cell[2142, 64, 171, 5, 38, "Text"], Cell[2316, 71, 250, 9, 52, "Text"], Cell[2569, 82, 26, 0, 38, "Text"], Cell[2598, 84, 168, 6, 38, "Text"], Cell[2769, 92, 381, 11, 59, "Text"], Cell[3153, 105, 505, 9, 81, "Text"], Cell[3661, 116, 147, 5, 39, "Text"], Cell[3811, 123, 130, 2, 56, "Input"], Cell[CellGroupData[{ Cell[3966, 129, 69, 0, 48, "Subsection"], Cell[4038, 131, 785, 22, 73, "Text"], Cell[4826, 155, 608, 17, 59, "Text"], Cell[5437, 174, 445, 10, 61, "Text"], Cell[5885, 186, 69, 1, 35, "Input"], Cell[5957, 189, 110, 2, 35, "Input"], Cell[6070, 193, 47, 1, 35, "Input"], Cell[6120, 196, 126, 3, 35, "Input"], Cell[6249, 201, 47, 1, 35, "Input"], Cell[6299, 204, 133, 3, 38, "Text"], Cell[6435, 209, 90, 1, 35, "Input"], Cell[6528, 212, 48, 1, 35, "Input"], Cell[6579, 215, 53, 1, 35, "Input"], Cell[6635, 218, 110, 3, 38, "Text"], Cell[6748, 223, 333, 6, 35, "Input"], Cell[7084, 231, 46, 1, 35, "Input"], Cell[7133, 234, 384, 11, 52, "Text"], Cell[7520, 247, 76, 1, 35, "Input"], Cell[7599, 250, 338, 9, 40, "Text"], Cell[7940, 261, 567, 9, 110, "Input"], Cell[8510, 272, 46, 1, 35, "Input"], Cell[8559, 275, 148, 5, 39, "Text"], Cell[8710, 282, 227, 4, 40, "Input"], Cell[8940, 288, 47, 1, 35, "Input"], Cell[8990, 291, 164, 3, 38, "Text"], Cell[9157, 296, 193, 6, 39, "Text"], Cell[9353, 304, 63, 1, 35, "Input"], Cell[9419, 307, 118, 3, 38, "Text"], Cell[9540, 312, 77, 1, 35, "Input"], Cell[9620, 315, 161, 6, 39, "Text"], Cell[9784, 323, 82, 1, 35, "Input"], Cell[9869, 326, 316, 5, 140, "Input"], Cell[10188, 333, 46, 1, 35, "Input"], Cell[10237, 336, 127, 6, 39, "Text"], Cell[10367, 344, 137, 3, 35, "Input"], Cell[10507, 349, 47, 1, 35, "Input"], Cell[10557, 352, 47, 1, 35, "Input"], Cell[10607, 355, 159, 5, 39, "Text"], Cell[10769, 362, 177, 4, 35, "Input"], Cell[10949, 368, 75, 1, 35, "Input"], Cell[11027, 371, 68, 1, 35, "Input"], Cell[11098, 374, 68, 1, 35, "Input"], Cell[11169, 377, 149, 3, 38, "Text"], Cell[11321, 382, 174, 3, 38, "Text"], Cell[11498, 387, 46, 1, 35, "Input"], Cell[11547, 390, 263, 7, 39, "Text"], Cell[11813, 399, 42, 1, 35, "Input"], Cell[11858, 402, 51, 1, 35, "Input"], Cell[11912, 405, 587, 10, 119, "Input"], Cell[12502, 417, 47, 1, 35, "Input"], Cell[12552, 420, 82, 1, 35, "Input"], Cell[12637, 423, 633, 11, 161, "Input"], Cell[13273, 436, 579, 10, 119, "Input"], Cell[13855, 448, 103, 3, 38, "Text"], Cell[13961, 453, 84, 1, 35, "Input"], Cell[14048, 456, 608, 10, 119, "Input"], Cell[CellGroupData[{ Cell[14681, 470, 56, 0, 34, "Subsubsection"], Cell[14740, 472, 117, 2, 35, "Input"], Cell[14860, 476, 47, 1, 35, "Input"], Cell[14910, 479, 307, 5, 56, "Input"], Cell[15220, 486, 50, 1, 35, "Input"], Cell[15273, 489, 47, 1, 35, "Input"], Cell[15323, 492, 168, 4, 35, "Input"], Cell[15494, 498, 62, 1, 35, "Input"], Cell[15559, 501, 49, 1, 35, "Input"], Cell[15611, 504, 635, 11, 161, "Input"], Cell[16249, 517, 329, 6, 98, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[16615, 528, 96, 2, 25, "Subsubsection"], Cell[16714, 532, 474, 10, 119, "Input"], Cell[17191, 544, 46, 1, 34, "Input"], Cell[17240, 547, 177, 4, 34, "Input"], Cell[17420, 553, 75, 1, 34, "Input"], Cell[17498, 556, 73, 1, 34, "Input"], Cell[17574, 559, 73, 1, 34, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[17696, 566, 49, 0, 48, "Subsection"], Cell[17748, 568, 46, 1, 35, "Input"], Cell[17797, 571, 91, 2, 38, "Text"], Cell[17891, 575, 240, 5, 40, "Input"], Cell[18134, 582, 47, 1, 35, "Input"], Cell[18184, 585, 49, 1, 35, "Input"], Cell[18236, 588, 160, 3, 35, "Input"], Cell[18399, 593, 105, 3, 38, "Text"], Cell[18507, 598, 220, 5, 56, "Input"], Cell[18730, 605, 47, 1, 35, "Input"], Cell[18780, 608, 243, 5, 77, "Input"], Cell[19026, 615, 874, 16, 140, "Input"], Cell[19903, 633, 1318, 23, 245, "Input"], Cell[21224, 658, 47, 1, 35, "Input"], Cell[21274, 661, 82, 1, 35, "Input"], Cell[21359, 664, 265, 5, 77, "Input"], Cell[21627, 671, 49, 1, 35, "Input"], Cell[21679, 674, 134, 2, 35, "Input"], Cell[21816, 678, 258, 5, 35, "Input"], Cell[22077, 685, 47, 1, 35, "Input"], Cell[22127, 688, 196, 5, 77, "Input"], Cell[22326, 695, 49, 1, 35, "Input"], Cell[22378, 698, 1318, 23, 245, "Input"], Cell[23699, 723, 1264, 22, 203, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[25000, 750, 42, 0, 48, "Subsection"], Cell[25045, 752, 46, 1, 35, "Input"], Cell[25094, 755, 155, 5, 38, "Text"], Cell[25252, 762, 60, 0, 38, "Text"], Cell[25315, 764, 231, 4, 36, "Input"], Cell[25549, 770, 47, 1, 35, "Input"], Cell[25599, 773, 105, 3, 38, "Text"], Cell[25707, 778, 138, 3, 35, "Input"], Cell[25848, 783, 47, 1, 35, "Input"], Cell[25898, 786, 56, 1, 35, "Input"], Cell[25957, 789, 514, 11, 77, "Input"], Cell[26474, 802, 47, 1, 35, "Input"], Cell[26524, 805, 61, 1, 35, "Input"], Cell[26588, 808, 884, 17, 266, "Input"], Cell[27475, 827, 580, 12, 182, "Input"], Cell[28058, 841, 836, 15, 224, "Input"], Cell[CellGroupData[{ Cell[28919, 860, 65, 0, 34, "Subsubsection"], Cell[28987, 862, 62, 1, 35, "Input"], Cell[29052, 865, 78, 1, 35, "Input"], Cell[29133, 868, 194, 4, 77, "Input"], Cell[29330, 874, 47, 1, 35, "Input"], Cell[29380, 877, 130, 2, 35, "Input"], Cell[29513, 881, 88, 1, 35, "Input"], Cell[29604, 884, 47, 1, 35, "Input"], Cell[29654, 887, 196, 5, 77, "Input"], Cell[29853, 894, 836, 15, 224, "Input"], Cell[30692, 911, 746, 13, 182, "Input"] }, Closed]] }, Closed]] }, Closed]], Cell[31477, 929, 53, 0, 54, "Section"] } ] *) (******************************************************************* End of Mathematica Notebook file. *******************************************************************)