# HyperCompanion-generates hyper-companion
# matrix of a power of a polynomial or companion matrix of a polynomial 
# 9/1/91  EWJ
# Used in classical to compute rational/classical canonical
# form of a rational matrix
#
HyperCompanion:=proc(p,e,x) local d,i,H;
if not type(e,posint) then ERROR(`2nd argument must be a positive integer`) fi;
if not type(x,name) then ERROR(`3rd argument must be a name`) fi;
if not type(p,polynom(anything,x)) then ERROR(`1st argument must be a polynomial in `,x) fi;
d:=degree(p,x);
H:=linalg[companion](p,x);
if e>1 then H:=linalg[diag](H$e) fi;
for i from d+1 by d to e*d do H[i,i-1]:=1 od;
op(H)
end:  

`help/text/HyperCompanion` := TEXT(
`FUNCTION: HyperCompanion - returns the hyper-companion matrix`,
`                           of a power of a polynomial`,
`   `,
`CALLING SEQUENCE: HyperCompanion(p,e,x);  `,
`   `,
`PARAMETERS: p - a polynomial in x`,
`            e - non-negative integer`,
`            x - name`,
`   `,
`SYNOPSIS:   `,
`- The call HyperCompanion(p,e,x) returns the hyper-companion matrix`,
`  of the eth power of the polynomial  p(x)`,
`   `,
`- If HC:=HyperCompanion(p,e,x) then HC is the matrix  diag(seq(com-`,
`   panion(p,x),i=1..e)  except that all the entries on the main subdiagonal`,
`   of  HC  are ones.`,
`-  The polynomial p must be in expanded form`,
`   `,
`EXAMPLES:   `,
`   `,
`> p:=x^2-x+1;`,
`                                     2`,
`                               p := x  - x + 1 `,
`    `,
`> HyperCompanion(p,1,x);`,
`                                  [ 0  -1 ]`,
`                                  [       ]`,
`                                  [ 1   1 ]`,
`    `,
`> HyperCompanion(p,2,x);`,
`                              [ 0  -1   0   0 ]`,
`                              [               ]`,
`                              [ 1   1   0   0 ]`,
`                              [               ]`,
`                              [ 0   1   0  -1 ]`,
`                              [               ]`,
`                              [ 0   0   1   1 ]`,
`   `,
`SEE ALSO:  linalg[companion]`
):

macro(factors=readlib(factors)):
# classical(A);
# E. Johnson  9/1/91
# Requires access to HyperCompanion
#
classical:=proc(M,PP) local i,C,S,L,P,Q,x,MM;
options  `copyright EWJ`;
if not type(M,'matrix') then MM:=evalm(M) else MM:=M fi;
if not type(MM,'matrix(rational,square)') then 
ERROR(`classical is implemented only for square rational matrices at this time`) fi;
L:=NULL;
S:=linalg[smith](x-MM,x);
#compute the elementary divisors
for i to linalg[rowdim](MM) do if S[i,i]<>1 then L:=L,op(factors(S[i,i])[2]) fi od;
#compute the classical form
C:=linalg[diag](seq(HyperCompanion(op(i),x),i=[L]));
#Use frobenius to compute the transition matrix if indicated
if nargs>1 then linalg[frobenius](C,P); linalg[frobenius](MM,Q); PP:=evalm(Q&*(1/P)) fi;
op(C);
end:

`help/text/classical` := TEXT(
`FUNCTION: classical - returns the classical or rational canonical form`,
`                      of a rational matrix`,
`   `,
`CALLING SEQUENCES:    classical(A);  `,
`                      classical(A,'P'); `,
`   `,
`PARAMETERS:    A- a rational matrix`,
`               P - (optional) used to return the transition matrix`,
`   `,
`SYNOPSIS:   `,
`- The call classical(A)  returns the matrix  C  in classical canonical `,
`  form which is similar to  A`,
`- The matrix  C  has the structure  C = diag(HC[1],...,HC[k])  where the `, 
`  HC[i] are hyper-companion matrices of the elementary divisors of  A `, 
`  i.e. hyper-companion matrices of the factors  p[i]^e[i] of the non- `,
`  constant polynomials on the diagonal of the Smith canonical form of `,
`  the characteristic matrix  xI-A`,
`- If all the eigenvalues of  A   are rational, then  C  is the transpose of`,
`  the jordan form of  A`,
`- If the optional second argument is given, then P will be assigned the`,
`  transformation matrix corresponding to this canonical form, that is, the`, 
`  matrix P such that inverse(P) * A * P = C `,
`       `,
`EXAMPLES:   `,
`   `,
`> A := array([[1,1],[1,1]]);`,
`                                     [ 1  1 ] `,
`                                A := [      ] `,
`                                     [ 1  1 ] `,
`     `,
`> classical(A,P);`,
`                                   [ 0  0 ] `,
`                                   [      ] `,
`                                   [ 0  2 ] `,
`      `,
`> evalm(1/P&*A&*P); `,
`                                   [ 0  0 ]  `,
`                                   [      ]  `,
`                                   [ 0  2 ]  `,
`    `,
`SEE ALSO:  linalg[jordan], linalg[smith], linalg[frobenius]`
):

class := `See ?classical and ?HyperCompanion`:
#save `class.m`;
#quit
