Diagoalization and
Canonical Form Examples 2

Programming

\(\(\(
\)\(
\)\(<< 
      LinearAlgebra`MatrixManipulation`

    Off[General::"spell"]


 (*Multiply\ ith\ row\ by\ u*) 

    R1[i_, \ u_, \ A_]\  := \ 
      Module[\ {Aloc}, 
Aloc\  = \ 
          A; 
Aloc[\([i]\)]\  = \ 
          u\ \ \ A[\([i]\)]; 
Aloc
]


    C1[i_, \ u_, \ A_]\  := \ 
      Transpose[
        R1[i, \ u, \ Transpose[A]]]

 (*\ 
      Replace\ ith\ row\ by\ \((ith\ row\  + \ 
            c*\ jth\ row)\)\ \ *) 

    R2[c_, \ i_, \ j_, \ A_]\  := 
      Module[{Aloc}, 
Aloc\  = \ 
          A; 
Aloc[\([i]\)]\  = \ 
          Expand[\ A[\([i]\)]\  + \ 
              c\ A[\([j]\)]]; 
Aloc
]


    C2[c_, i_, \ j_, \ A_]\  := \ 
      Transpose[
        R2[c, \ i, \ j, \ 
          Transpose[
            A]]]

 (*Interchange\ ith\ and\ jth\ rows*) 

    R3[i_, \ j_, \ A_]\  := \ 
      Module[\ {Aloc}, 
Aloc\  = \ 
          A; 
Aloc[\([i]\)]\  = \ 
          A[\([j]\)]; 
Aloc[\([j]\)]\  = \ 
          A[\([i]\)]; 
Aloc
]


    C3[i_, \ j_, \ A_]\  := \ 
      Transpose[\ 
        R3[i, \ j, \ Transpose[A]]]




    degree[p_, \ x_]\  := \ 
      If[Exponent[p, x]\  == \ \(-Infinity\), \ \ Infinity, \ 
        Exponent[p, \ x]]


    size[p_]\  := \ 
      If[Abs[p]\  == \ 0, \ Infinity, \ Abs[p]]

    Minsize[A_]\  := \ 
      Min[Map[size[#]\  &, \ 
          A, \ {2}]]



    MinDegree[A_, x_]\  := \ 
      Min[\ Map[degree[#, \ x] &, \ 
          A, {2}]]





    findMinDegree[A_, \ x_, \ m_, rows_, columns_]\  := \ 
      Module[{B, pos, min}, 
B\  = \ 
          TakeMatrix[
            A, \ {m, m}, \ {rows, \ 
              columns}]; 
B\  = \ \ Map[degree[#, \ x] &, \ 
            B, {2}]; 
min\  = \ 
          Min[B]; 
pos\  = \ 
          Position[B, min, \ {2}]; 
pos\  = \ 
          Map[\ #\  + \ {m - 1, \ m - 1} &, \ 
            pos]
]


    MinDegreeQ[A_, \ x_, \ m_, rows_, \ 
        columns_]\  := 
MemberQ[
        findMinDegree[A, \ x, \ m, rows, \ columns], \ {m, 
          m}]


    Clear[findMinSize]

    findMinSize[A_, \ m_, \ rows_, columns_]\  := \ 
      Module[{B, \ min, \ pos}, 
B\  = \ 
          TakeMatrix[
            A, \ {m, m}, \ {rows, \ 
              columns}]; 
B\  = \ \ Map[size[#] &, \ 
            B, {2}]; 
min\  = \ 
          Min[B]; 
pos\  = \ 
          Position[B, min, \ {2}]; 
pos\  = \ 
          Map[\ #\  + \ {m - 1, \ m - 1} &, \ 
            pos]
]


    MinsizeQ[A_, \ \ m_, rows_, \ columns_]\  := 
MemberQ[
        findMinSize[A, \ \ m, rows, \ columns], \ {m, 
          m}]


    Move[A_, \ P_, \ Q_, \ \ {i0_, \ j0_}, \ {i_, \ j_}]\  := \ 
      Module[{Aloc\  = \ A, \ Ploc\  = \ P, \ 
          Qloc\  = \ Q}, 
Aloc = \ \ R3[i0, \ i, \ 
            Aloc]; 
Ploc\  = \ \ R3[i0, \ i, \ 
            Ploc]; 
Aloc\  = \ 
          C3[j0, \ j, \ Aloc]; 
Qloc = \ \ C3[j0, \ j, \ 
            Qloc]; 
{Aloc, \ Ploc, \ 
          Qloc}
]


    MoveMinDegree[A_, P_, \ Q_, \ \ \ m_, x_, rows_, \ columns_]\  := \ 
      Module[{Aloc\  = \ A, \ Ploc\  = \ P, \ Qloc\  = \ Q, \ 
          pos}, 
pos\  = \ \ findMinDegree[A, \ x, \ m, 
            rows, \ columns]; 
If[MemberQ[pos, \ {m, m}], \ 
          Return[{A, \ P, \ Q}]]; 
pos\  = \ 
          pos[\([1]\)]; 
\ 
        Move[A, P, \ Q, \ \ {m, m}, \ 
          pos]
]


    MoveMinSize[A_, P_, \ Q_, \ \ \ m_, rows_, \ columns_]\  := \ 
      Module[{Aloc\  = \ A, \ Ploc\  = \ P, \ Qloc\  = \ Q, \ 
          pos}, 
pos\  = \ \ findMinSize[A, \ \ m, rows, \ 
            columns]; 
If[MemberQ[pos, \ {m, m}], \ 
          Return[{A, \ P, \ Q}]]; 
pos\  = \ 
          pos[\([1]\)]; 
\ 
        Move[A, P, \ Q, \ \ {m, m}, \ 
          pos]
]



    LeadingCoefficient[p_, \ x_]\  := \ 
      Module[{m}, 
m\  = \ 
          Exponent[p, x]; 
If[m\  == 0, \ 
          p, 
Coefficient[p, \ 
            x^m]]
]


    NormalizeDiagonal[A_, \ Q_, \ \ m_, \ x_]\  := \ 
      Module[{Aloc = \ A, \ Qloc\  = \ Q, \ \ alpha, \ 
          u}, 
alpha\  = \ 
          Aloc[\([m, m]\)]; 
u\  = \ 
          LeadingCoefficient[alpha, x]; 
Aloc\  = \ 
          C1[m, \ 1/u, \ Aloc]; 
Qloc\  = \ 
          C1[m, \ 1/u, \ Qloc]; 
{Aloc, \ 
          Qloc}
]


    IntegerNormalizeDiagonal[A_, \ Q_, \ \ m_]\  := \ 
      Module[{Aloc = \ A, \ Qloc\  = \ Q, \ \ alpha, \ 
          u}, 
alpha\  = \ 
          Aloc[\([m, m]\)]/Abs[Aloc[\([m, m]\)]]; 
u\  = \ 
          LeadingCoefficient[alpha, x]; 
Aloc\  = \ 
          C1[m, \ 1/u, \ Aloc]; 
Qloc\  = \ 
          C1[m, \ 1/u, \ Qloc]; 
{Aloc, \ 
          Qloc}
]



    MinStep[A_, \ P_, \ Q_, \ m_, \ x_, rows_, \ columns_]\  := \ 
      Module[{Aloc = A, \ Ploc = P, \ 
          Qloc = \ Q}, 
{Aloc, \ Ploc, \ Qloc}\  = \ 
          MoveMinDegree[Aloc, Ploc, \ Qloc, \ m, \ x, \ rows, \ 
            columns]; 
{Aloc, Ploc, \ \ Qloc}\  = \ 
          ClearRow[Aloc, Ploc, \ \ Qloc, \ m, x, \ rows, \ 
            columns]; 
{Aloc, \ Ploc, \ Qloc}\  = 
          Expand[\ ClearColumn[Aloc, \ Ploc, Qloc, \ \ m, x, rows, 
              columns]]; 
{Aloc, \ Qloc}\ \  = \ 
          Expand[NormalizeDiagonal[Aloc, \ Qloc, \ m, \ 
              x]]; 
{Aloc, \ Ploc, \ 
          Qloc}
]


    IntegerMinStep[A_, \ P_, \ Q_, \ m_, \ rows_, \ columns_]\  := \ 
      Module[{Aloc = A, \ Ploc = P, \ 
          Qloc = \ Q}, 
{Aloc, \ Ploc, \ Qloc}\  = \ 
          MoveMinSize[Aloc, Ploc, \ Qloc, \ m, \ \ rows, \ 
            columns]; 
{Aloc, Ploc, \ \ Qloc}\  = \ 
          IntegerClearRow[Aloc, Ploc, \ \ Qloc, \ m, \ rows, \ 
            columns]; 
{Aloc, \ Ploc, \ Qloc}\  = 
          Expand[\ IntegerClearColumn[Aloc, \ Ploc, Qloc, \ \ m, rows, 
              columns]]; 
{Aloc, \ Qloc}\ \  = \ 
          Expand[IntegerNormalizeDiagonal[Aloc, \ Qloc, \ 
              m]]; 
{Aloc, \ Ploc, \ 
          Qloc}
]




    ZeroQ[A_, \ 
        x_]\  := \ \((Max[
            Exponent[A, 
              x]]\  == \ \(-Infinity\))\)


    IntegerZeroQ[A_]\  := \ \((Max[Abs[A]]\  == \ 0)\)


    DividesQ[c_, \ A_, \ x_]\  := \ 
      ZeroQ[Map[PolynomialRemainder[#, \ c, \ x] &, \ A, \ {2}], 
        x]


    DividesQ[c_, \ A_, \ x_, \ m_, rows_, \ 
        columns_]\  := 
DividesQ[c, \ 
        TakeMatrix[A, \ {m, m}, \ {rows, \ columns}], \ x]


    IntegerDividesQ[c_, \ A_]\  := \ 
      IntegerZeroQ[Map[Mod[#, \ c] &, \ A, \ {2}]]


    IntegerDividesQ[c_, \ A_, \ \ m_, rows_, \ 
        columns_]\  := 
IntegerDividesQ[c, \ 
        TakeMatrix[
          A, \ {m, m}, \ {rows, \ 
            columns}]]





    FindNonDivisible[c_, \ A_, \ x_, \ m_, \ rows_, \ columns_]\  := \ 
      Module[{C, max, \ pos}, 
C\  = \ 
          TakeMatrix[
            A, \ {m, m}, \ {rows, \ columns}]; 
C\  = \ 
          Map[PolynomialRemainder[#, \ c, \ x] &, \ 
            C, {2}]; 
C\  = \ 
          Exponent[C, x]; 
max\  = \ 
          Max[C]; 
pos\  = \ {}; 
If[
          max\  > \ \(-Infinity\), \ 
          pos\  = \ Position[C, \ max]]; 
pos\  = \ 
          Map[#\  + \ {m - 1, \ m - 1}\  &, \ 
            pos]
]


    IntegerFindNonDivisible[c_, A_, \ \ m_, \ rows_, \ 
        columns_]\  := 
Module[{C, max, \ 
          pos}, 
C\  = \ 
          TakeMatrix[
            A, \ {m, m}, \ {rows, \ columns}]; 
C\  = \ 
          Map[Mod[#, \ c] &, \ C, {2}]; 
C\  = \ 
          Abs[C]; 
max\  = \ 
          Max[C]; 
pos\  = \ {}; 
If[
          max\  > \ 0, \ 
          pos\  = \ Position[C, \ max]]; 
pos\  = \ 
          Map[#\  + \ {m - 1, \ m - 1}\  &, \ 
            pos]
]



    ClearRow[A_, P_, \ \ \ Q_, \ m_, x_, \ \ rows_, \ columns_]\  := \ 
      Module[
{Aloc\  = \ A, 
          Ploc = \ P, \ \ Qloc\  = \ Q, \ j, \ q}, 
j\  = \ 
          m + 1; 
While[
          j\  ≤ \ \ columns, 
While[
            Exponent[Aloc[\([m, \ j]\)], 
                x]\  ≠ \ \ \(-Infinity\)\ \ , 
q\  = \ PolynomialQuotient[Aloc[\([m, j]\)], Aloc[\([m, m]\)], \ 
                x]; 
Aloc\  = \ 
              C2[\(-q\), \ j, \ 
                m, \ \ Aloc]; 
Qloc\  = \ \ C2[\(-q\), \ 
                j, \ m, \ \ Qloc]; 
If[\ 
              Exponent[Aloc[\([m, \ j]\)], 
                  x]\  ≠ \ \ \(-Infinity\), 
Aloc\  = \ C3[m, \ j, \ Aloc]; 
Qloc\  = \ 
                C3[m, \ j, \ Qloc]; 
{Aloc, \ Ploc, \ 
                  Qloc}\  = 
                ClearColumn[Aloc, \ Ploc, \ Qloc, \ m, \ x, \ rows, \ 
                  
                  columns];
]\ ;  (*End\ If*) 
]\ ;  (*EndWhile*) 
\(j++\)
]\ ;  (*EndWhile*) 
{Aloc, 
          Ploc, \ \ Qloc}
]



    IntegerClearRow[A_, P_, \ \ \ Q_, \ m_, \ \ rows_, \ columns_]\  := \ 
      Module[
{Aloc\  = \ A, 
          Ploc = \ P, \ \ Qloc\  = \ Q, \ j, \ q}, 
j\  = \ 
          m + 1; 
While[
          j\  ≤ \ \ columns, 
While[
            Abs[Aloc[\([m, \ j]\)]]\  ≠ \ 
              0\ \ , 
q\  = \ 
              Quotient[Aloc[\([m, j]\)], 
                Aloc[\([m, m]\)]]; 
Aloc\  = \ 
              C2[\(-q\), \ j, \ 
                m, \ \ Aloc]; 
Qloc\  = \ \ C2[\(-q\), \ 
                j, \ m, \ \ Qloc]; 
If[
              Abs[Aloc[\([m, \ 
                      j]\)]]\  ≠ \ \ 0, 
Aloc\  = \ C3[m, \ j, \ Aloc]; 
Qloc\  = \ 
                C3[m, \ j, \ Qloc]; 
{Aloc, \ Ploc, \ 
                  Qloc}\  = 
                IntegerClearColumn[Aloc, \ Ploc, \ Qloc, \ m, \ \ rows, \ 
                  columns];
]\ ;  (*End\ If*) 
]\ ;  (*EndWhile*) 
\(j++\)
]\ ;  (*EndWhile*) 
{Aloc, 
          Ploc, \ \ Qloc}
]



    ClearColumn[A_, \ \ P_, Q_, \ \ \ m_, \ x_, rows_, \ columns_]\  := \ 
      Module[
{Aloc\  = \ A, \ Ploc\  = \ P, \ 
          Qloc\  = \ Q, \ \ j, \ q}, 
j\  = \ 
          m + 1; 
While[
          j\  ≤ \ \ rows, 
While[
            Exponent[Aloc[\([j, \ m]\)], 
                x]\  ≠ \ \ \(-Infinity\)\ \ , 
q\  = \ PolynomialQuotient[Aloc[\([j, m]\)], Aloc[\([m, m]\)], \ 
                x]; 
Aloc\  = \ 
              R2[\(-q\), \ j, \ 
                m, \ \ Aloc]; 
Ploc\  = \ \ R2[\(-q\), \ 
                j, \ m, \ \ Ploc]; 
If[\ 
              Exponent[Aloc[\([j, \ m]\)], 
                  x]\  ≠ \ \ \(-Infinity\), 
Aloc\  = \ R3[m, \ j, \ Aloc]; 
Ploc\  = \ 
                R3[m, \ j, \ Ploc]; 
{Aloc, \ Ploc, \ 
                  Qloc}\  = 
                ClearRow[Aloc, \ Ploc, \ Qloc, \ m, \ x, \ rows, \ 
                  columns];
]\ ;  (*End\ If*) 
]\ ;  (*EndWhile*) 
\(j++\)
]\ ;  (*EndWhile*) 
{Aloc, \ Ploc, \ 
          Qloc}
]



    IntegerClearColumn[A_, \ \ P_, Q_, \ \ \ m_, \ rows_, \ columns_]\  := \ 
      Module[
{Aloc\  = \ A, \ Ploc\  = \ P, \ 
          Qloc\  = \ Q, \ \ j, \ q}, 
j\  = \ 
          m + 1; 
While[
          j\  ≤ \ \ rows, 
While[
            Abs[Aloc[\([j, \ m]\)]]\  ≠ \ 
              0\ \ , 
q\  = \ 
              Quotient[Aloc[\([j, m]\)], 
                Aloc[\([m, m]\)]]; 
Aloc\  = \ 
              R2[\(-q\), \ j, \ 
                m, \ \ Aloc]; 
Ploc\  = \ \ R2[\(-q\), \ 
                j, \ m, \ \ Ploc]; 
If[\ 
              Abs[Aloc[\([j, \ m]\)]]\  ≠ \ 
                0, 
Aloc\  = \ 
                R3[m, \ j, \ Aloc]; 
Ploc\  = \ 
                R3[m, \ j, \ Ploc]; 
{Aloc, \ Ploc, \ 
                  Qloc}\  = 
                IntegerClearRow[Aloc, \ Ploc, \ Qloc, \ m, \ \ rows, \ 
                  columns];
]\ ;  (*End\ If*) 
]\ ;  (*EndWhile*) 
\(j++\)
]\ ;  (*EndWhile*) 
{Aloc, \ Ploc, \ 
          Qloc}
]






    Clear[PolySmithNormal]

    PolySmithNormal[A_, \ x_]\  := \ 
      Module[{rows, \ columns, \ P, \ Q, \ Aloc = A, \ m, \ k, \ pos, \ 
          i}, 
rows\  = \ Length[A]; \ \ columns = \ 
          Length[Transpose[A]]; 
k\  = \ 
          Min[{rows, \ columns}]; 
P\  = \ 
          IdentityMatrix[rows]; 
Q\  = \ 
          IdentityMatrix[columns]; 
m\  = \ 
          1; 
While[
          m ≤ \ k, 
If[
            ZeroQ[TakeMatrix[Aloc, \ {m, m}, \ {rows, \ columns}], x], \ 
            Return[{Aloc, \ P, \ Q}]]; 
{Aloc, \ P, \ 
              Q}\  = \ MinStep[Aloc, \ P, Q, \ m, \ x, rows, \ 
              columns]; 
alpha\  = \ 
            Aloc[\([m, m]\)]; 
While[\ 
            DividesQ[alpha, \ Aloc, x, \ m, rows, \ columns]\  == \ 
                False\  || \ \ MinDegreeQ[Aloc, \ x, \ m, rows, \ 
                  columns]\  == \ False, 
If[
              MinDegreeQ[Aloc, \ x, \ m, rows, \ columns]\  == \ 
                False, 
{Aloc, \ P, \ Q}\  = \ 
                MinStep[Aloc, \ P, Q, \ m, \ x, rows, \ 
                  columns], 
pos\  = \ \(FindNonDivisible[
                    alpha, \ Aloc, \ x, \ m, rows, \ 
                    columns]\)[\([1]\)]; 
i\  = \ 
                pos[\([1]\)]; \ 
              j\  = \ pos[\([2]\)]; 
beta\  = \ 
                Aloc[\([i, \ 
                    j]\)]; 
 (*Aloc\  = \ \ R2[\(-beta\), \ 
                    m, \ j, \ Aloc]\ ; \ \ \ P\  = \ \ R2[\(-beta\), \ m, \ 
                    j, \ P]\ ;*) 
Aloc\  = \ \ R2[1, \ m, \ 
                  i, \ Aloc]\ ; \ \ 
\ 
              P\  = \ \ R2[1, \ m, \ i, \ P]\ ; 
{Aloc, \ 
                  P, \ Q}\  = \ 
                MinStep[Aloc, \ P, Q, \ m, \ x, rows, \ 
                  columns]; 
alpha\  = \ 
                Aloc[\([m, 
                    m]\)];
]; \  (*End\ If\ *) 
];  (*End\ While\ \ mot\ min\ or\ doesnt\ divide\ *) 
\(m++\)
]; \  (*End\ While\ m\  ≤ \ \ k\ *) 

{Aloc, \ P, \ 
          Q}
]


    Clear[IntegerSmithNormal]

    IntegerSmithNormal[A_]\  := \ 
      Module[{rows, \ columns, \ P, \ Q, \ Aloc = A, \ m, \ k, \ pos, \ 
          i}, 
rows\  = \ Length[A]; \ \ columns = \ 
          Length[Transpose[A]]; 
k\  = \ 
          Min[{rows, \ columns}]; 
P\  = \ 
          IdentityMatrix[rows]; 
Q\  = \ 
          IdentityMatrix[columns]; 
m\  = \ 
          1; 
While[
          m ≤ \ k, 
If[
            IntegerZeroQ[TakeMatrix[Aloc, \ {m, m}, \ {rows, \ columns}]], \ 
            Return[{Aloc, \ P, \ Q}]]; 
{Aloc, \ P, \ 
              Q}\  = \ IntegerMinStep[Aloc, \ P, Q, \ m, \ rows, \ 
              columns]; 
alpha\  = \ 
            Aloc[\([m, m]\)]; 
While[\ 
            IntegerDividesQ[alpha, \ Aloc, \ m, rows, \ columns]\  == \ 
                False\  || \ \ MinsizeQ[Aloc, \ \ m, rows, \ 
                  columns]\  == \ False, 
If[
              MinsizeQ[Aloc, \ \ m, rows, \ columns]\  == \ 
                False, 
{Aloc, \ P, \ Q}\  = \ 
                IntegerMinStep[Aloc, \ P, Q, \ m, \ rows, \ 
                  columns], 
pos\  = \ \(IntegerFindNonDivisible[alpha, \ Aloc, \ \ m, rows, \ 
                    columns]\)[\([1]\)]; 
i\  = \ 
                pos[\([1]\)]; \ 
              j\  = \ pos[\([2]\)]; 
beta\  = \ 
                Aloc[\([i, \ j]\)]; 
Aloc\  = \ \ R2[1, \ 
                  m, \ i, \ Aloc]\ ; \ \ 
P\  = \ \ R2[1, \ 
                  m, \ i, \ P]\ ; 
{Aloc, \ P, \ Q}\  = 
                IntegerMinStep[Aloc, \ P, Q, \ m, \ rows, \ 
                  columns]; 
alpha\  = \ 
                Aloc[\([m, 
                    m]\)];
]; \  (*End\ If\ *) 
];  (*End\ While\ \ mot\ min\ or\ doesnt\ divide\ *) 
 (*Print[m]; \ 
            Print[MatrixForm[
                Aloc]];\ *) 
\(m++\);
]; \  (*End\ While\ m\  ≤ \ \ k\ *) 

{Aloc, \ P, \ 
          Q}
]


    taycoefs[f_, \ x_, \ x0_, \ 
        n_]\  := 
\ \ Block[\ {tp, \ u}, 
\ \ \ \ \ \ \ \ \ tp\  = \ 
          Normal[Series[
              f, \ {x, \ x0, \ n}]]; 
\ \ \ \ \ \ \ \ \ CoefficientList[\ 
          tp\  /. \ x\  -> \ x0\  + \ u, \ u]]


    mathorner[coefs_, \ 
        m_]\  := 
\ \ Block[{size\  = \ Length[m]}, 
\ \ \ \ \ \ \ \ If[
          coefs\  == \ {}, 
\ \ \ \ \ \ \ \ \ \ \ Table[
            0, \ {size}, \ {size}], 
\ \ \ \ \ \ \ \ \ \ \ First[
                coefs]\ IdentityMatrix[
                size]\  + 
\ \ \ \ \ \ \ \ \ \ \ \ \ m\  . \ 
              mathorner[Rest[coefs], \ 
                m]]]



    MatrixFunction[f_, x_, \ \ A_]\  := \ 
      Module[{coefs}, 
coefs\  = \ 
          taycoefs[f, \ x, \ 0, \ 20]; 
mathorner[coefs, \ 
          A]
]


    normalize[
        v_]\  := \ \ Module[{d}, 

d\  = \ \(Apply[ExtendedGCD, \ v]\)[\([1]\)]; 
\((1/
              d)\)\ v

]\)\)\)

Example 1.

B  =  {{2, -4, -12, 17, 
          12}, {0, -15, 9, 68, 55}, {0, 0, 1, 0, 0}, {0, -4, 0, 18, 
          13}, {0, 0, 3, 0, 
          2}}



    MatrixForm[B]

Smith Normal Form

EE  =  
        IdentityMatrix[5];

    BX  =  x  EE  -  B

    {BX',  P,  Q}  =  
        Simplify[PolySmithNormal[BX, x]];

    MatrixForm[BX']

    MatrixForm[Expand[%]]

invP  =  Inverse[P];
Simplify[MatrixForm[Inverse[P]]]

Rational Canonical Form

p1  =  Transpose[invP][[4]];
v1  =  (∑_(j = 1)^5) MatrixFunction[p1[[j]] ,  x,  
            B] . EE[[j]]

    
p2  =   Transpose[invP][[5]];
w1  =  (∑_(j = 1)^5) MatrixFunction[p2[[j]] ,  x,  B] . 
          EE[[j]]

v1  =  2197 v1;
w1  =  157 w1;
v1  =  normalize[v1]
w1  =  normalize[w1]

w2  =  B . w1

    w3  =  B . w2

    w4  =  B . w3

S  =  Transpose[{v1, w1, w2, w3, w4}];
MatrixForm[%]
Inverse[S] . B . S;
MatrixForm[%]

Characteristic Polynomial

Det[x EE  -  B]
Factor[%]

Jordan Decomposition -- built in routine

{S,  B'}  =  JordanDecomposition[B];
MatrixForm[B']
MatrixForm[Inverse[S] . B . S]
MatrixForm[S]

Jordan Decomposition -- Homemade

a  =   MatrixFunction[ (x - 2)^3,  x,  B] . 
        w1
b  =    (B - 1  EE) . w1
b2  =  (B - 2  EE) . b
b3  =  (B - 2  EE) . b2
S  =  
        Transpose[{v1,  a,  b,  b2,  b3}];
MatrixForm[S]
MatrixForm[Inverse[S] . B . S]

Jordan Decomposition -- Elementary approach

Clear[w1, w2, w3,  w4,  
      w5]

    {w1,  w2}  =  NullSpace[B  -   EE]

\(\(\(
\)\(
\)\({w5}\  = \ 
      NullSpace[
        B\  - 2\ EE]





    w4\  = \ LinearSolve[\((B - 2\ EE)\), \ w5]

    w3\  = \ LinearSolve[\((B - 2\ EE)\), \ w4]\)\)\)

S  =  
        Transpose[{w1, w2,  w3,  w4,  w5}];

    MatrixForm[S]

    MatrixForm[Inverse[S] . B . S]