(* Content-type: application/mathematica *)

(*** Wolfram Notebook File ***)
(* http://www.wolfram.com/nb *)

(* CreatedBy='Mathematica 6.0' *)

(*CacheID: 234*)
(* Internal cache information:
NotebookFileLineBreakTest
NotebookFileLineBreakTest
NotebookDataPosition[       145,          7]
NotebookDataLength[      9046,        311]
NotebookOptionsPosition[      7630,        257]
NotebookOutlinePosition[      7964,        272]
CellTagsIndexPosition[      7921,        269]
WindowFrame->Normal
ContainsDynamic->False*)

(* Beginning of Notebook Content *)
Notebook[{
Cell["\<\
Here' s an alternative way to find characteristic polynomials of operators.  \
It depends on there being some vector v whose images v, Tv, T^2 v, etc \
generate the whole vector space, so it doesn't always work.  However, when \
the dimension of the vector space is large, it's much more practical than the \
determinant method for finding characteristic polynomials.

Anyhow, let's consider the operator T:R^4 -> R^4 with standard matrix\
\>", "Text",
 CellChangeTimes->{{3.437740048725917*^9, 3.437740205304979*^9}}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"MatrixForm", "[", 
  RowBox[{"A", "=", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"{", 
      RowBox[{"1", ",", "2", ",", "3", ",", "1"}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{
       RowBox[{"-", "1"}], ",", "3", ",", "2", ",", "0"}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"0", ",", "1", ",", "3", ",", "2"}], "}"}], ",", 
     RowBox[{"{", 
      RowBox[{"4", ",", 
       RowBox[{"-", "1"}], ",", "2", ",", "1"}], "}"}]}], "}"}]}], 
  "]"}]], "Input",
 CellChangeTimes->{{3.437470871545593*^9, 3.43747089901272*^9}}],

Cell[BoxData[
 TagBox[
  RowBox[{"(", "\[NoBreak]", GridBox[{
     {"1", "2", "3", "1"},
     {
      RowBox[{"-", "1"}], "3", "2", "0"},
     {"0", "1", "3", "2"},
     {"4", 
      RowBox[{"-", "1"}], "2", "1"}
    },
    GridBoxAlignment->{
     "Columns" -> {{Left}}, "ColumnsIndexed" -> {}, "Rows" -> {{Baseline}}, 
      "RowsIndexed" -> {}},
    GridBoxSpacings->{"Columns" -> {
        Offset[0.27999999999999997`], {
         Offset[0.7]}, 
        Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, "Rows" -> {
        Offset[0.2], {
         Offset[0.4]}, 
        Offset[0.2]}, "RowsIndexed" -> {}}], "\[NoBreak]", ")"}],
  Function[BoxForm`e$, 
   MatrixForm[BoxForm`e$]]]], "Output",
 CellChangeTimes->{{3.437470889627961*^9, 3.437470899765784*^9}, 
   3.437732813962881*^9}]
}, Open  ]],

Cell["\<\
I take the first standard basis vector for my \"v\" and then compute its \
image under T, T^2, etc.\
\>", "Text",
 CellChangeTimes->{{3.43774021632677*^9, 3.437740253462083*^9}}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"v0", " ", "=", " ", 
  RowBox[{"{", 
   RowBox[{"1", ",", "0", ",", "0", ",", "0"}], "}"}]}]], "Input",
 CellChangeTimes->{{3.4377328245876093`*^9, 3.4377328335248804`*^9}}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"1", ",", "0", ",", "0", ",", "0"}], "}"}]], "Output",
 CellChangeTimes->{3.437732835931069*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"v1", " ", "=", " ", 
  RowBox[{"A", ".", "v0"}]}]], "Input",
 CellChangeTimes->{{3.4377328391184874`*^9, 3.4377328426496468`*^9}}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"1", ",", 
   RowBox[{"-", "1"}], ",", "0", ",", "4"}], "}"}]], "Output",
 CellChangeTimes->{3.4377328442589808`*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"v2", " ", "=", " ", 
  RowBox[{"A", ".", "v1"}]}]], "Input",
 CellChangeTimes->{{3.43773284544645*^9, 3.437732850180704*^9}}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"3", ",", 
   RowBox[{"-", "4"}], ",", "7", ",", "9"}], "}"}]], "Output",
 CellChangeTimes->{3.4377328511338043`*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"v3", " ", "=", " ", 
  RowBox[{"A", ".", "v2"}]}]], "Input",
 CellChangeTimes->{{3.437732863024125*^9, 3.437732865399064*^9}}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"25", ",", 
   RowBox[{"-", "1"}], ",", "35", ",", "39"}], "}"}]], "Output",
 CellChangeTimes->{3.4377328667740293`*^9}]
}, Open  ]],

Cell["Now I stop for a second to see if I' ve gone far enough", "Text",
 CellChangeTimes->{{3.437740260578813*^9, 3.437740274534437*^9}}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{
  RowBox[{"Solve", "[", 
   RowBox[{
    RowBox[{
     RowBox[{
      RowBox[{"c3", " ", "v3"}], " ", "+", " ", 
      RowBox[{"c2", " ", "v2"}], " ", "+", " ", 
      RowBox[{"c1", " ", "v1"}], " ", "+", " ", 
      RowBox[{"c0", " ", "v0"}]}], " ", "\[Equal]", " ", "0"}], ",", 
    RowBox[{"{", 
     RowBox[{"c0", ",", "c1", ",", "c2", ",", "c3"}], "}"}]}], "]"}], 
  " "}]], "Input",
 CellChangeTimes->{{3.4377328993825693`*^9, 3.4377329474125896`*^9}}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"{", 
   RowBox[{
    RowBox[{"c0", "\[Rule]", "0"}], ",", 
    RowBox[{"c1", "\[Rule]", "0"}], ",", 
    RowBox[{"c2", "\[Rule]", "0"}], ",", 
    RowBox[{"c3", "\[Rule]", "0"}]}], "}"}], "}"}]], "Output",
 CellChangeTimes->{3.4377329583185606`*^9}]
}, Open  ]],

Cell["\<\
The vectors are still independent.  So I need to keep going (note that this \
is *good* news).  Since the vector space at hand is only four dimensional, I \
know that the next vector will be the last one and that v, Tv, T^2 v, T^3 v \
will give me a basis for R^4.\
\>", "Text",
 CellChangeTimes->{{3.437740281663306*^9, 3.437740342072642*^9}, {
  3.437740376490958*^9, 3.437740391121349*^9}}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"v4", " ", "=", " ", 
  RowBox[{"A", ".", "v3"}]}]], "Input",
 CellChangeTimes->{{3.437732964474653*^9, 3.437732967583948*^9}}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"167", ",", "42", ",", "182", ",", "210"}], "}"}]], "Output",
 CellChangeTimes->{3.437732968365178*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{
  RowBox[{"Solve", "[", 
   RowBox[{
    RowBox[{
     RowBox[{"v4", " ", "+", 
      RowBox[{"c3", " ", "v3"}], " ", "+", " ", 
      RowBox[{"c2", " ", "v2"}], " ", "+", " ", 
      RowBox[{"c1", " ", "v1"}], " ", "+", " ", 
      RowBox[{"c0", " ", "v0"}]}], " ", "\[Equal]", " ", "0"}], ",", 
    RowBox[{"{", 
     RowBox[{"c0", ",", "c1", ",", "c2", ",", "c3"}], "}"}]}], "]"}], 
  " "}]], "Input",
 CellChangeTimes->{{3.4377328993825693`*^9, 3.4377329474125896`*^9}, {
  3.437732984833533*^9, 3.4377329867241335`*^9}}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"{", 
   RowBox[{
    RowBox[{"c0", "\[Rule]", 
     RowBox[{"-", "3"}]}], ",", 
    RowBox[{"c1", "\[Rule]", 
     RowBox[{"-", "6"}]}], ",", 
    RowBox[{"c2", "\[Rule]", "14"}], ",", 
    RowBox[{"c3", "\[Rule]", 
     RowBox[{"-", "8"}]}]}], "}"}], "}"}]], "Output",
 CellChangeTimes->{3.437732993099052*^9}]
}, Open  ]],

Cell["\<\
So there' s my dependence relation.  The characteristic polynomial of my \
operator should accordingly be:  x^4 - 8 x^3 + 14 x^2 - 6 x - 3

Just in case, I recompute it the old way.\
\>", "Text",
 CellChangeTimes->{{3.43774035077234*^9, 3.437740459261738*^9}}],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"Det", "[", 
  RowBox[{
   RowBox[{"x", " ", 
    RowBox[{"IdentityMatrix", "[", "4", "]"}]}], "-", "A"}], "]"}]], "Input",
 CellChangeTimes->{{3.437733209346284*^9, 3.437733239955267*^9}}],

Cell[BoxData[
 RowBox[{
  RowBox[{"-", "3"}], "-", 
  RowBox[{"6", " ", "x"}], "+", 
  RowBox[{"14", " ", 
   SuperscriptBox["x", "2"]}], "-", 
  RowBox[{"8", " ", 
   SuperscriptBox["x", "3"]}], "+", 
  SuperscriptBox["x", "4"]}]], "Output",
 CellChangeTimes->{3.4377332538144646`*^9}]
}, Open  ]],

Cell["Tada", "Text",
 CellChangeTimes->{{3.437740462947276*^9, 3.437740463973791*^9}}]
},
WindowSize->{640, 623},
WindowMargins->{{144, Automatic}, {Automatic, 0}},
FrontEndVersion->"6.0 for Linux x86 (32-bit) (April 20, 2007)",
StyleDefinitions->"Default.nb"
]
(* End of Notebook Content *)

(* Internal cache information *)
(*CellTagsOutline
CellTagsIndex->{}
*)
(*CellTagsIndex
CellTagsIndex->{}
*)
(*NotebookFileOutline
Notebook[{
Cell[568, 21, 528, 9, 151, "Text"],
Cell[CellGroupData[{
Cell[1121, 34, 561, 16, 55, "Input"],
Cell[1685, 52, 793, 23, 72, "Output"]
}, Open  ]],
Cell[2493, 78, 188, 4, 51, "Text"],
Cell[CellGroupData[{
Cell[2706, 86, 197, 4, 32, "Input"],
Cell[2906, 92, 135, 3, 31, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[3078, 100, 154, 3, 32, "Input"],
Cell[3235, 105, 156, 4, 31, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[3428, 114, 149, 3, 32, "Input"],
Cell[3580, 119, 156, 4, 31, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[3773, 128, 150, 3, 32, "Input"],
Cell[3926, 133, 159, 4, 31, "Output"]
}, Open  ]],
Cell[4100, 140, 137, 1, 31, "Text"],
Cell[CellGroupData[{
Cell[4262, 145, 482, 13, 32, "Input"],
Cell[4747, 160, 289, 8, 31, "Output"]
}, Open  ]],
Cell[5051, 171, 403, 7, 71, "Text"],
Cell[CellGroupData[{
Cell[5479, 182, 150, 3, 32, "Input"],
Cell[5632, 187, 142, 3, 31, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[5811, 195, 549, 14, 32, "Input"],
Cell[6363, 211, 351, 11, 31, "Output"]
}, Open  ]],
Cell[6729, 225, 270, 6, 91, "Text"],
Cell[CellGroupData[{
Cell[7024, 235, 212, 5, 32, "Input"],
Cell[7239, 242, 286, 9, 33, "Output"]
}, Open  ]],
Cell[7540, 254, 86, 1, 31, "Text"]
}
]
*)

(* End of internal cache information *)