
normform :=
`See ?frobenius, ?ratjordan, ?jordan, ?jordansymbolic, ?smithex, ?ismithex`:

# normform: A PACKAGE FOR THE COMPUTATION OF SEVERAL MATRIX NORMAL FORMS
# ----------------------------------------------------------------------
#
# This file contains six routines for the computation of normal forms of
# matrices. The routines are:
#  - frobenius
#  - ratjordan
#  - jordansymbolic
#  - jordan
#  - smithex
#  - ismithex
# For each routine a description of the algorithm is added and comments are
# inserted.
# For help see the on-line help facility so type one of these:
#  - ?frobenius
#  - ?ratjordan
#  - ?jordansymbolic
#  - ?jordan
#  - ?smithex
#  - ?ismithex
#
# AUTHORS: T.M.L. Mulders, A.H.M. Levelt
#          Mathematics Department
#          University of Nijmegen.
# E-mail:  mulders@sci.kun.nl, ahml@sci.kun.nl
#
# January 1993

macro(gcdexgeneral=`normform/gcdexgeneral`,
      simplalgebraic=`normform/simplalgebraic`,
      simplcomplex=`normform/simplcomplex`,
      simplratfunc=`normform/simplratfunc`,
      simplrational=`normform/simplrational`,
      multiplegeneral=`normform/multiplegeneral`,
      Id=`normform/Id`,
      basis=`normform/basis`,
      companion_to_ratjordan=`normform/companion_to_ratjordan`,
      cyclic_to_frobenius=`normform/cyclic_to_frobenius`,
      cyclic_vectors=`normform/cyclic_vectors`,
      deg_sort=`normform/deg_sort`,
      find_companion=`normform/find_companion`,
      find_ratjblock=`normform/find_ratjblock`,
      frobenius_to_invfact=`normform/frobenius_to_invfact`,
      frobenius_to_ratjordan=`normform/frobenius_to_ratjordan`,
      frobeniusform=`normform/frobeniusform`,
      identitymatrix=`normform/identitymatrix`,
      inv=`normform/inv`,
      invariant_to_jordan=`normform/invariant_to_jordan`,
      invfact_to_frobenius=`normform/invfact_to_frobenius`,
      jordanform=`normform/jordanform`,
      jordansymbolicform=`normform/jordansymbolicform`,
      priminv_to_ratjordan=`normform/priminv_to_ratjordan`,
      make_ratj_block=`normform/make_ratj_block`,
      mysmith=`normform/mysmith`,
      plist_to_polycompanion=`normform/plist_to_polycompanion`,
      ratjordan_to_jordan=`normform/ratjordan_to_jordan`,
      ratjordan_to_priminv=`normform/ratjordan_to_priminv`,
      ratjordanform=`normform/ratjordanform`,
      uppersmith=`normform/uppersmith`,
      zero_matrix=`normform/zero_matrix`,
      factors=readlib(factors)):


############################################################################
############################################################################
##
##          frobenius
##
###########################################################################
###########################################################################
# A Maple program for the computation of the Frobenius normal form of
# a matrix.
# Authors: T.M.L. Mulders, A.H.M. Levelt
#          Mathematics Department
#          University of Nijmegen.
# E-mail: mulders@sci.kun.nl, ahml@sci.kun.nl
#
# January 1993


# A matrix F is said to be in Frobenius normal form if F=diag(C1,C2,..,Ck)
# where Ci is the companion matrix associated with a polynomial pi and the
# polynomials pi satify the condition: pi divides p(i+1) for i=1..(k-1).
# If A is a square matrix over a field K, then there exist square matrices
# P and F over K such that F is in Frobenius normal form and
#               inverse(P)*A*P = F.
# The matrix F is called the Frobenius normal form of A and is uniquely
# determined by A.
#
# The function frobenius computes the Frobenius normal form F of a matrix A,
# the transformation matrix P and its inverse P^(-1).
# Specifically:
# - frobenius(A) or frobenius(A,K) will return the Frobenius normal form F
#   of A.
# - frobenius(A,'P') or frobenius(A,K,'P') will do the same as frobenius(A)
#   (resp. frobenius(A,K)) but now the transformation matrix is assigned to P.
# - frobenius(A,'P','Pinv') or frobenius(A,K,'P','Pinv')will do the same as
#   frobenius(A,'P') (resp. frobenius(A,K,'P')) but now also the inverse of
#   the transformation matrix is assigned to Pinv.
# Here K is a set of RootOf's and/or radicals defining an algebraic extension
# of Q(the rational numbers).
#
# Global description of the algorithm:
# For a given n by n matrix A over a field K, let L be the linear
# transformation of K^n induced by A. A polycyclic basis of K^n with
# respect to L is a basis of the following form:
# v1,L*v1,..,L^(d1-1)*v1,v2,L*v2,..,L^(d2-1)*v2,..,vr,L*vr,..,L^(dr-1)*vr
# such that v1,L*v1,..,L^(d1-1)*v1,..,vi,L*vi,..,L^(di-1)*vi,L^di*vi are
# linearly dependent for i=1..r.
# It is easy to see that the matrix B of L with respect to a polycyclic basis
# is of the form plist_to_polycompanion(plist,x), where plist is a list of
# monic elements of K[x] of strictly increasing degree (for a description of
# plist_to_polycompanion see below).
# The computation of a polycyclic basis of K^n and the transformation
# matrix from A to B is performed in the function cyclic_vectors.
# Next we view K^n as a K[x]-module via x*v=B*v. Suppose that
# B=plist_to_polycompanion(plist,x), where plist=[p1,..,pr] and degree(pi)=di.
# Let G be the r by r upper triangular matrix such that G[i,j] satisfies:
#  pj=G[1,j]+G[2,j]*x^d1+G[3,j]*x^d2+..+G[j,j]*x^d(j-1),
# where degree(G[j,j])=dj-d(j-1) and degree(G[i,j])<di-d(i-1) (d0=0).
# Let R be the K[x]-submodule of K[x]^r generated by the columns of G.
# Representants for the elements of the quotient module K[x]^r/R are the
# vectors [L1,L2,..,Lr] where degree(Li)<di-d(i-1). By taking the
# coefficients of the Li the quotient module is identified with K^n. The
# multiplication by x on the quotient module is identified with the
# multiplication by B on K^n.
# Next we compute the Smith normal form S of G. Say L*S*R=G. If R' is the
# K[x]-submodule of K[x]^r generated by the columns of S we get the following
# diagram:  
#            ~                 ~                 ~
#    K^n <------- K[x]^r/R' -------> K[x]^r/R -------> K^n
#                              L                 
#     |               |                  |              |
#     |               |                  |              |
#     |F              |x                 |x             |B
#     |               |                  |              |
#     |               |                  |              |
#    \ /             \ /                \ /            \ /
#            ~                 ~                 ~
#    K^n <------- K[x]^r/R' -------> K[x]^r/R -------> K^n
#                              L                
#
# Here F is in Frobenius normal form and thus it is the Frobenius normal
# form of B (and thus of A). The computation of the Smith normal form of G
# is performed in the function cyclic_to_frobenius.


frobenius:=proc(A)
local AA,n,i,j;
global SIMPLIFY,GCDEX;

  if not type(A,'matrix') then
    AA:=evalm(A)
  else
    AA:=A
  fi;
  if not type(AA,'matrix'('anything','square')) then
    ERROR(`expecting a square matrix`)
  fi;

  n:=linalg[rowdim](AA);
  for i to n do
    for j to n do
      if type(AA[i,j],indexed) then
        ERROR(`Unassigned array elements`)
      fi
    od
  od;

  if nargs>1 and type(args[2],set) then
    if args[2] ={I} then
      SIMPLIFY:=simplcomplex;
      GCDEX:=gcdexgeneral;
      frobeniusform(AA,args[3..nargs])
    else
      SIMPLIFY:=simplalgebraic;
      GCDEX:=gcdexgeneral;
      frobeniusform(AA,args[3..nargs])
    fi
  else
    if type(AA,'matrix'('rational')) then
      SIMPLIFY:=simplrational;
      GCDEX:=gcdex;
      frobeniusform(AA,args[2..nargs])
    else
      SIMPLIFY:=simplratfunc;
      GCDEX:=gcdexgeneral;
      frobeniusform(AA,args[2..nargs])
    fi
  fi

end:

`normform/frobeniusform`:=proc(A,P,Pinv)
local x,plist,inv_fact,V,Vinv,T,Tinv;

  if nargs=1 then
    plist:=cyclic_vectors(A,x);
    inv_fact:=cyclic_to_frobenius(plist,x)
  elif nargs=2 then
    plist:=cyclic_vectors(A,x,'V');
    inv_fact:=cyclic_to_frobenius(plist,x,'T');
    P:=map(SIMPLIFY,evalm(V&*T))
  else
    plist:=cyclic_vectors(A,x,'V','Vinv');
    inv_fact:=cyclic_to_frobenius(plist,x,'T','Tinv');
    P:=map(SIMPLIFY,evalm(V&*T));
    Pinv:=map(SIMPLIFY,evalm(Tinv&*Vinv))
  fi;

  invfact_to_frobenius(inv_fact,x)

end:


# cyclic_vectors computes a polycyclic basis of K^n with respect to A.
# If this basis is (b1,..,bn)=
# (v1,A*v1,..,A^(d1-1)*v1,v2,A*v2,..,A^(d2-1)*v2,..,vr,A*vr,..,A^(dr-1)*vr)
# and a1*b1+..+a(d1+..+di)*b(d1+..+di)+A^di*vi=0 we set
# pi=a1+a2*x+..+a(d1+..+di)*x^(d1+..+di-1)+x^(d1+..+di).
# cyclic_vectors returns the list [p1,..,pr].
# The matrix of A on this basis (b1,..,bn) is
# plist_to_polycompanion([p1,..,pr],x).

`normform/cyclic_vectors`:=proc(A,x,V,Vinv)
local i,j,l,n,r,carrier,car,U,Uinv,S,u,v,s,lincomb,plist,c,temp;

  n:=linalg[rowdim](A);
  U:=array(1..n,1..n);
  S:=array(1..n,1..n);
  plist:=[];
  if nargs>=3 then
    V:=array(1..n,1..n)
  fi;
  if nargs=4 then
    Vinv:=array(1..n,1..n)
  fi;

  carrier:=array(1..n);
  for i to n do carrier[i]:=0 od;
  lincomb:=array(1..n);

  r:=0;   # number of elements of basis already computed
  while r<n do
#######
# Start new cycle
#######
    for i to n while carrier[i]<>0 do od;   # find first gap
    v:=basis(n,i);
#######
    do
      u:=copy(v);
      for i to n do lincomb[i]:=0 od;

      # always v=u+U*lincomb
      for i to n do
        car:=carrier[i];
        if car<>0 and u[i]<>0 then
          c:=SIMPLIFY(u[i]/U[i,car]);
          u[i]:=0;
          for j from i+1 to n do u[j]:=SIMPLIFY(u[j]-c*U[j,car]) od;
          lincomb[car]:=c  
        fi
      od;

      i:=1;
      while i<=n and u[i]=0 do i:=i+1 od;
      if i<=n then
        # new element of basis
        r:=r+1;  
        carrier[i]:=r;   # this basis-element carries coordinate i

        #always U=V*S
        for j from i to n do U[j,r]:=u[j] od;
        if nargs>=3 then
          for j to n do V[j,r]:=v[j] od;
        fi;
        for j to r-1 do
          temp:=lincomb[j];
          for l from j+1 to r-1 do temp:=SIMPLIFY(temp+S[j,l]*lincomb[l]) od;
          S[j,r]:=-temp
        od;
        S[r,r]:=1;

        # compute A*v
        for i to n do
          temp:=0;
          for j to n do
            temp:=SIMPLIFY(temp+A[i,j]*v[j])
          od;
          u[i]:=temp
        od;
        v:=copy(u);
      else
        break
      fi
    od;

#######
# New cycle found
#######

    s:=array(1..r);
    for j to r do
      temp:=lincomb[j];
      for l from j+1 to r do temp:=SIMPLIFY(temp+S[j,l]*lincomb[l]) od;
      s[j]:=temp
    od;
    plist:=[op(plist),x^r-sum('s[r+1-j]*x^(r-j)','j'=1..r)]
#######
  od;

  if nargs=4 then
    Uinv:=inv(U,carrier);
    for i to n do
      for j to n do
        temp:=0;
        for l from i to n do temp:=SIMPLIFY(temp+S[i,l]*Uinv[l,j]) od;
        Vinv[i,j]:=temp
      od
    od
  fi;

  plist

end:


# A matrix B=plist_to_polycompanion(plist,x) is transformed to its Frobenius
# normal form F. If F=diag(C1,..,Cr), where Ci is the companion matrix
# associated with pi, then cyclic_to_frobenius will return the list
# [p1,..,pr].
# Let G be the matrix as described before. We compute the Smith normal
# form S of G. Then S=diag(p1,..,pr), where pi in K[x] such that pi
# divides p(i+1) for i=1..(r-1), and
# F=invfact_to_frobenius([p1,..,pr],x) is the Frobenius normal form
# of B (for a description of invfact_to_frobenius see below).
# Remark: to compute the Smith normal form of G we first simplify G using
# the fact that G is upper triangular. Then we use an adapted version of
# the Maple function smith.

`normform/cyclic_to_frobenius`:=proc(plist,x,T,Tinv)
local r,d,i,j,k,n,G,L,Linv,D,c,inv_fact,columnT,rowT,ii,jj,rr,q,
      columnTinv,rowTinv,US,S;

  r:=nops(plist);
  d:=array(0..r);
  d[0]:=0;
  for j to r do d[j]:=degree(plist[j],x) od;
  n:=d[r];

#######
# Compute matrix G
#######
  G:=zero_matrix(r,r);
  for j to r do
    for i to j-1 do
      G[i,j]:=sum('coeff(plist[j],x,k)*x^(k-d[i-1])','k'=d[i-1]..d[i]-1)
    od;
    G[j,j]:=sum('coeff(plist[j],x,k)*x^(k-d[j-1])','k'=d[j-1]..d[j])
  od;
#######

#######
# Compute Smith normal form of G
#######
  if nargs=2 then
    US:=uppersmith(G,x);
    S:=mysmith(US,x)
  elif nargs=3 then
    US:=uppersmith(G,x,'L');
    S:=mysmith(US,x,'L')
  else
    US:=uppersmith(G,x,'L','Linv');
    S:=mysmith(US,x,'L','Linv')
  fi;
#######

  D:=array(1..r);
  for i to r do D[i]:=degree(S[i,i],x) od;

  if nargs>=3 then
#######
# Compute transformation matrix (see diagram before)
#######
    c:=array(1..r);
    T:=array(1..n,1..n);
    columnT:=0;
    for i to r do
      for k to r do c[k]:=L[k,i] od;
      for j to D[i] do
        columnT:=columnT+1;
        for ii from r by -1 to 1 do
          q:=quo(c[ii],G[ii,ii],x,'rr');
          c[ii]:=SIMPLIFY(rr,x);
          for jj to ii-1 do
            c[jj]:=SIMPLIFY(c[jj]-q*G[jj,ii],x)
          od
        od;
        rowT:=0;
        for ii to r do
          for jj to d[ii]-d[ii-1] do
            rowT:=rowT+1;
            T[rowT,columnT]:=coeff(c[ii],x,jj-1)
          od
        od;
        for ii to r do c[ii]:=SIMPLIFY(c[ii]*x,x) od
      od
    od
#######
  fi;

  if nargs=4 then
#######
# Compute inverse transformation matrix (see diagram before)
#######
    Tinv:=array(1..n,1..n);
    columnTinv:=0;
    for i to r do
      for k to r do c[k]:=Linv[k,i] od;
      for j to d[i]-d[i-1] do
        columnTinv:=columnTinv+1;
        rowTinv:=0;
        for ii to r do
          c[ii]:=SIMPLIFY(rem(c[ii],S[ii,ii],x),x);
          for jj to D[ii] do
            rowTinv:=rowTinv+1;
            Tinv[rowTinv,columnTinv]:=coeff(c[ii],x,jj-1)
          od
        od;
        for ii to r do c[ii]:=SIMPLIFY(c[ii]*x,x) od
      od
    od
#######
  fi;

  inv_fact:=[];
  for i to r do
    if D[i]>0 then inv_fact:=[op(inv_fact),S[i,i]] fi
  od;

  inv_fact

end:


# An upper triangular matrix B is simplified. Entry B[i,j] is reduced
# modulo gcd(B[i,i],B[j,j]). If B' is the reduced matrix and L*B'*R=B
# then also L and L^(-1) are computed.

`normform/uppersmith`:=proc(B,x,L,Linv)
local i,j,k,n,r,s,t,A,d,q;

  A:=copy(B);
  n := linalg[rowdim](A);

  if nargs>=3 then
    L:=Id(n)
  fi;
  if nargs=4 then
    Linv:=Id(n)
  fi;

  for j from 2 to n do
    for i to j-1 do
      d:=GCDEX(A[i,i],A[j,j],x,'s','t');
      q:=quo(A[i,j],d,x,'r');
      A[i,j]:=SIMPLIFY(r,x);
      for k to i-1 do
        A[k,j]:=SIMPLIFY(A[k,j]-q*s*A[k,i],x)
      od;
      for k from j+1 to n do
        A[i,k]:=SIMPLIFY(A[i,k]-q*t*A[j,k],x)
      od;
      if nargs>=3 then
        for k to i do
          L[k,j]:=SIMPLIFY(L[k,j]+q*t*L[k,i],x)
        od
      fi;
      if nargs=4 then
        Linv[i,j]:=SIMPLIFY(-q*t,x)
      fi
    od
  od;

  op(A)

end:


# The Smith normal form S of a matrix B is computed. If L*S*R=B then
# also L and L^(-1) are computed. The matrix L computed in uppersmith is
# taken account of.
# For a description of mysmith see linalg[smith].
 
`normform/mysmith`:=proc(B,x,L,Linv)
local a,b,g,i,j,k,n,r,s,t,temp,A,isClear,q,lc;

  n:=linalg[rowdim](B);
  A:=copy(B);

  for k to n do
    isClear:=false;
    while not isClear do
      for i from k+1 to n do
        if A[i,k]=0 then next fi;
        g:=GCDEX(A[k,k],A[i,k],x,'s','t');
        a:=quo(A[k,k],g,x);b:=quo(A[i,k],g,x);
        for j from k+1 to n do
          temp:=SIMPLIFY(s*A[k,j]+t*A[i,j],x);
          A[i,j]:=SIMPLIFY(a*A[i,j]-b*A[k,j],x);
          A[k,j]:=temp
        od;
        if nargs>=3 then
          for j to n do
            temp:=SIMPLIFY(a*L[j,k]+b*L[j,i],x);
            L[j,i]:=SIMPLIFY(-t*L[j,k]+s*L[j,i],x);
            L[j,k]:=temp
          od
        fi;
        if nargs=4 then
          for j to n do
            temp:=SIMPLIFY(s*Linv[k,j]+t*Linv[i,j],x);
            Linv[i,j]:=SIMPLIFY(a*Linv[i,j]-b*Linv[k,j],x);
            Linv[k,j]:=temp
          od
        fi;
        A[k,k]:=SIMPLIFY(g,x);
        A[i,k]:=0
      od;
      isClear:=true;
      for i from k+1 to n do
        A[k,i]:=SIMPLIFY(rem(A[k,i],A[k,k],x,'q'),x);
      od;
      for i from k+1 to n do
        if A[k,i]=0 then next fi;
        g:=GCDEX(A[k,k],A[k,i],x,'s','t');
        a:=quo(A[k,k],g,x);b:=quo(A[k,i],g,x);
        for j from k+1 to n do
          temp:=SIMPLIFY(s*A[j,k]+t*A[j,i],x);
          A[j,i]:=SIMPLIFY(a*A[j,i]-b*A[j,k],x);
          A[j,k]:=temp
        od;
        A[k,k]:=SIMPLIFY(g,x);
        A[k,i]:=0;
        isClear:=false;
      od
    od
  od;
  r:=0;
  for i to n do
    if A[i,i]<>0 then
      r:=r+1;
      lc:=lcoeff(A[i,i],x);
      A[r,r]:=SIMPLIFY(A[i,i]/lc,x);
      if i<>r then
        A[i,i]:=0;
        if nargs>=3 then
          for j to n do
            temp:=L[j,r];
            L[j,r]:=L[j,i];
            L[j,i]:=temp
          od
        fi;
        if nargs=4 then
          for j to n do
            temp:=Linv[r,j];
            Linv[r,j]:=Linv[i,j];
            Linv[i,j]:=temp
          od
        fi
      fi
    fi
  od;
  for i to r-1 do
    for j from i+1 to r while A[i,i]<>1 do
      g:=GCDEX(A[i,i],A[j,j],x,'s','t');
      a:=quo(A[i,i],g,x); b:=quo(A[j,j],g,x);
      A[i,i]:=SIMPLIFY(g,x);
      A[j,j]:=SIMPLIFY( a*A[j,j],x );
      if nargs>=3 then
        for k to n do
          temp:=SIMPLIFY(a*L[k,i]+b*L[k,j],x);
          L[k,j]:=SIMPLIFY(-t*L[k,i]+s*L[k,j],x);
          L[k,i]:=temp
        od
      fi;
      if nargs=4 then
        for k to n do
          temp:=SIMPLIFY(s*Linv[i,k]+t*Linv[j,k],x);
          Linv[j,k]:=SIMPLIFY(a*Linv[j,k]-b*Linv[i,k],x);
          Linv[i,k]:=temp
        od
      fi
    od
  od;

  op(A)

end:


# inv computes the inverse of a permuted upper triangular matrix. The
# permutation is given by carrier.

`normform/inv`:=proc(A,carrier)
local B,n,i,j,k,temp;
  n:=linalg[rowdim](A);
  B:=array(1..n,1..n);
  for i to n do
    for j to i-1 do
      temp:=0;
      for k from j to i-1 do
        temp:=SIMPLIFY(temp+A[i,carrier[k]]*B[carrier[k],j])
      od;
      B[carrier[i],j]:=SIMPLIFY(-temp/A[i,carrier[i]])
    od;
    B[carrier[i],i]:=SIMPLIFY(1/A[i,carrier[i]]);
    for j from i+1 to n do
      B[carrier[i],j]:=0
    od
  od;
  op(B)
end:


# SIMPLIFY expands a polynomial with respect to x and normalizes its
# coefficients. According to the type of coefficients one of the following
# simpl* funcions is assigned to SIMPLIFY.

`normform/simplrational`:=proc(f,x)
  if nargs=1 then
    f
  else
    expand(f)
  fi
end:

`normform/simplcomplex`:=proc(f,x)
  if nargs=1 then
    f
  else
    expand(f)
  fi
end:

`normform/simplalgebraic`:=proc(f,x)
  if nargs=1 then
    evala(normal(expand(f)))
  else
    collect(f,x,x->evala(normal(expand(x))))
  fi
end:

`normform/simplratfunc`:=proc(f,x)
  if nargs=1 then
    normal(f)
  else
    collect(f,x,normal)
  fi
end:

# gcdexgeneral is the extended euclidean algorithm. This routine is used
# in case the coefficients of the polynomials are not rational numbers.

`normform/gcdexgeneral`:=proc(f,g,x,s,t)
local c,d,c1,d1,c2,d2,q,r,r1,r2;
  c:=f;d:=g;
  c1:=1;d1:=0;
  c2:=0;d2:=1;
  while d<>0 do
    q:=quo(c,d,x,'r');
    r1:=c1-q*d1;r2:=c2-q*d2;
    c:=d;c1:=d1;c2:=d2;
    d:=SIMPLIFY(r);d1:=SIMPLIFY(r1);d2:=SIMPLIFY(r2)
  od;
  s:=c1/lcoeff(c,x);
  t:=c2/lcoeff(c,x);
  c/lcoeff(c,x)
end:


# zero_matrix creates a zero-matrix end Id creates an identity-matrix

`normform/zero_matrix`:=proc(r,c)
local A,i,j;
  A:=array(1..r,1..c);
  for i to r do
    for j to c do
      A[i,j]:=0
    od
  od;
  op(A)
end:

`normform/Id`:=proc(n)
local i,j,I;
  I:=array(1..n,1..n);
  for i to n do
    for j to n do
      I[i,j]:=0
    od
  od;
  for i to n do I[i,i]:=1 od;
  op(I)
end:


# basis creates an element of the natural basis of a vector space

`normform/basis`:=proc(n,i)
local b,j;
  b:=array(1..n);
  for j to n do b[j]:=0 od;
  b[i]:=1;
  op(b)
end:


# For plist=[p1,...,pr] where pi is a monic polynomial in x
# invfact_to_frobenius(plist,x) makes a square matrix with diagonal blocks
# C1,...,Cr where Ci is the companion matrix to pi.

`normform/invfact_to_frobenius`:=proc(inv_fact,x)
local i;
  linalg[diag](seq(linalg[companion](inv_fact[i],x),i=1..nops(inv_fact)))
end:


# If a=a0+a1*x+x^2, b=b0+b1*x+b2*x^2+x^3 and
# c=c0+c1*x+c2*x^2+c3*x^3+c4*x^4+x^5, then
# plist_to_polycompanion([a,b,c],x) yields
#
#       [ 0  -a0  -b0   0  -c0 ]
#       [                      ]
#       [ 1  -a1  -b1   0  -c1 ]
#       [                      ]
#       [ 0   0   -b2   0  -c2 ]
#       [                      ]
#       [ 0   0    0    0  -c3 ]
#       [                      ]
#       [ 0   0    0    1  -c4 ]

`normform/plist_to_polycompanion`:=proc(plist,x)
local r,d,n,A,i,j,k;
  r:=nops(plist);
  d:=array(0..r);
  d[0]:=0;
  for i to r do d[i]:=degree(plist[i],x) od;
  n:=d[r];
  A:=zero_matrix(n,n);
  for i to r do
    for j from d[i-1]+2 to d[i] do A[j,j-1]:=1 od;
    for j from i to r do
      for k from d[i-1]+1 to d[i] do
        A[k,d[j]]:=-coeff(plist[j],x,k-1)
      od
    od
  od;
  op(A)
end:


`help/text/frobenius` := TEXT(
`FUNCTION: frobenius - compute the Frobenius normal form of a matrix`,
`   `,
`CALLING SEQUENCE:`,
`   frobenius(A) or frobenius(A, K)`,
`   frobenius(A, 'P') or frobenius(A, K, 'P')`,
`   frobenius(A, 'P', 'Pinv') or frobenius(A, K, 'P', 'Pinv')`,
`   `,
`PARAMETERS:`,
`   A           - a square matrix`,
`   K           - an algebraic extension`,
`   'P', 'Pinv' - (optional) assigned the transformation matrix and its inverse`,
`   `,
`SYNOPSIS:`,
`- The function frobenius(A) computes and returns the Frobenius normal form`,
`  F of a matrix A.`,
`   `,
`- F has the following structure: F = diag(C1,C2,..,Ck) where the Ci's are com-`,
`  panion matrices associated with polynomials p1, p2,.., pk with the property`,
`  that pi divides p(i+1), for i = 1..k-1.`,
`   `,
`- If called in the form frobenius(A, 'P'), then P will be assigned the`,
`  transformation matrix corresponding to the Frobenius normal form, that is,`,
`  the matrix P such that inverse(P) * A * P = F.`,
`  If called in the form frobenius(A, 'P', 'Pinv'), then Pinv will be assigned`,
`  the inverse of P.`,
`   `,
`- If the optional parameter K is present, all calculations will be performed`,
`  in the algebraic number field defined by K. Here K is a set of RootOf's`,
`  and/or radicals`,
`   `,
`- When K is not present also rational functions in several variables are`,
`  allowed as matrix entries`,
`   `, 
`- The Frobenius normal form defined in this way is unique (ie. if we require`,
`  that pi divides p(i+1) as above).`,
`   `,
`EXAMPLES:`,
`> A := array([[-9,21,-15,4,2,0],[-10,21,-14,4,2,0],[-8,16,-11,4,2,0],`,
`>             [-6,12,-9,3,3,0],[-4,8,-6,0,5,0],[-2,4,-3,0,1,3]]);`,
`                              [  -9  21  -15  4  2  0 ]`,
`                              [                       ]`,
`                              [ -10  21  -14  4  2  0 ]`,
`                              [                       ]`,
`                              [  -8  16  -11  4  2  0 ]`,
`                         A := [                       ]`,
`                              [  -6  12   -9  3  3  0 ]`,
`                              [                       ]`,
`                              [  -4   8   -6  0  5  0 ]`,
`                              [                       ]`,
`                              [  -2   4   -3  0  1  3 ]`,
`   `,
`> frobenius(A,'P','Pinv');`,
`                             [ 3  0  0  0  0   0  ]`,
`                             [                    ]`,
`                             [ 0  0  0  0  0   15 ]`,
`                             [                    ]`,
`                             [ 0  1  0  0  0  -47 ]`,
`                             [                    ]`,
`                             [ 0  0  1  0  0   56 ]`,
`                             [                    ]`,
`                             [ 0  0  0  1  0  -32 ]`,
`                             [                    ]`,
`                             [ 0  0  0  0  1   9  ]`,
`   `,
`> op(P);op(Pinv);`,
`                    [ 3  23/8  29/8  -17/8  -227/8  -857/8 ]`,
`                    [                                      ]`,
`                    [ 3  19/8  21/8  -29/8  -235/8  -829/8 ]`,
`                    [                                      ]`,
`                    [ 3  15/8  17/8  -25/8  -199/8  -705/8 ]`,
`                    [                                      ]`,
`                    [ 3   3/2   3/2    -3     -21   -147/2 ]`,
`                    [                                      ]`,
`                    [ 3   7/8   5/8  -25/8  -139/8  -473/8 ]`,
`                    [                                      ]`,
`                    [ 2   1/2   1/2    -1     -7     -49/2 ]`,
`   `,
`                     [  0    0     0     -1/3    0    1  ]`,
`                     [                                   ]`,
`                     [  3  27/2  -33/2   -40/3   10   5  ]`,
`                     [                                   ]`,
`                     [ -7   -30    22    172/3  -33  -14 ]`,
`                     [                                   ]`,
`                     [  5   25    -13   -160/3   27   14 ]`,
`                     [                                   ]`,
`                     [ -1   -10    4      20     -9   -6 ]`,
`                     [                                   ]`,
`                     [  0   3/2   -1/2   -8/3    1    1  ]`,
`   `,
`> A := array([[3+I,1-6*I,2+3*I,I],`,
`              [5+2*I,5-I,4+2*I,3-I],`,
`              [2-I,2-I,3+2*I,5],`,
`              [6,7-2*I,3*I,8-4*I]]);`,
`                       [  3 + I   1 - 6 I  2 + 3 I     I    ]`,
`                       [                                    ]`,
`                       [ 5 + 2 I   5 - I   4 + 2 I   3 - I  ]`,
`                  A := [                                    ]`,
`                       [  2 - I    2 - I   3 + 2 I     5    ]`,
`                       [                                    ]`,
`                       [    6     7 - 2 I    3 I    8 - 4 I ]`,
`   `,
`> frobenius(A,{I});`,
`                           [ 0  0  0  299 - 1029 I ]`,
`                           [                       ]`,
`                           [ 1  0  0   181 + 267 I ]`,
`                           [                       ]`,
`                           [ 0  1  0   - 83 - 6 I  ]`,
`                           [                       ]`,
`                           [ 0  0  1    19 - 2 I   ]`,
`   `,
`> s:=sqrt(2):`,
`> A := array([[4*s-6,-4*s+7,-3*s+6],`,
`              [3*s-6,-3*s+7,-3*s+6],`,
`              [3*s,1-3*s,-2*s]]);`,
`                     [    1/2           1/2           1/2     ]`,
`                     [ 4 2    - 6  - 4 2    + 7  - 3 2    + 6 ]`,
`                     [                                        ]`,
`                     [    1/2           1/2           1/2     ]`,
`                A := [ 3 2    - 6  - 3 2    + 7  - 3 2    + 6 ]`,
`                     [                                        ]`,
`                     [      1/2            1/2          1/2   ]`,
`                     [   3 2        1 - 3 2        - 2 2      ]`,
`   `,
`> frobenius(A,{sqrt(2)});`,
`                           [  1/2                  ]`,
`                           [ 2     0        0      ]`,
`                           [                       ]`,
`                           [               1/2     ]`,
`                           [            4 2    - 7 ]`,
`                           [   0   0  2 ---------- ]`,
`                           [              1/2      ]`,
`                           [             2    - 2  ]`,
`                           [                       ]`,
`                           [              1/2      ]`,
`                           [           5 2    - 6  ]`,
`                           [   0   1   ----------  ]`,
`                           [             1/2       ]`,
`                           [            2    - 2   ]`,
`   `,
`> alias(a=RootOf(X^3-2*X+X-5)):`,
`> A := array([[11+6*a^2+2*a,6*a^2+10,-6*a^2-2*a-10],`,
`              [1+3*a+a^2,a+a^2,-3*a-a^2],`,
`              [4*a+6*a^2+10,6*a^2+10,-9-4*a-6*a^2]]);`,
`                  [         2           2            2            ]`,
`                  [ 11 + 6 a  + 2 a  6 a  + 10  - 6 a  - 2 a - 10 ]`,
`                  [                                               ]`,
`                  [              2          2                2    ]`,
`             A := [   1 + 3 a + a      a + a        - 3 a - a     ]`,
`                  [                                               ]`,
`                  [          2          2                       2 ]`,
`                  [ 4 a + 6 a  + 10  6 a  + 10   - 9 - 4 a - 6 a  ]`,
`   `,
`> frobenius(A,{a});`,
`                         [ 1 - 2 a  0        0       ]`,
`                         [                           ]`,
`                         [                     2     ]`,
`                         [    0     0  10 + 5 a  - a ]`,
`                         [                           ]`,
`                         [                        2  ]`,
`                         [    0     1    1 + a + a   ]`,
`   `,
`> A := array([[(y+y^2-x^2)/y,(x-x^2-y+y^2)/y,(x^2-y^2)/y],`,
`              [1+x+y,(x-y+y^2+x*y)/y,-x-y],`,
`              [(y-x+y^2-x^2)/y,(x-y+y^2-x^2)/y,(x+x^2-y^2)/y]]);`,
`                 [        2    2          2        2     2    2   ]`,
`                 [   y + y  - x      x - x  - y + y     x  - y    ]`,
`                 [   -----------     ---------------    -------   ]`,
`                 [        y                 y              y      ]`,
`                 [                                                ]`,
`                 [                           2                    ]`,
`                 [                  x - y + y  + x y              ]`,
`            A := [    1 + x + y     ----------------    - x - y   ]`,
`                 [                          y                     ]`,
`                 [                                                ]`,
`                 [          2    2        2        2       2    2 ]`,
`                 [ y - x + y  - x    x - x  - y + y   x + x  - y  ]`,
`                 [ ---------------   ---------------  ----------- ]`,
`                 [        y                 y              y      ]`,
`   `,
`> frobenius(A);`,
`                            [ x/y  0        0      ]`,
`                            [                      ]`,
`                            [            x (x + y) ]`,
`                            [  0   0   - --------- ]`,
`                            [                y     ]`,
`                            [                      ]`,
`                            [                    2 ]`,
`                            [         x + x y + y  ]`,
`                            [  0   1  ------------ ]`,
`                            [               y      ]`,
`   `,
`SEE ALSO:  smithex, ismithex, ratjordan, jordansymbolic, jordan,`,
`           Frobenius, Ratjordan, Jordansymbolic`  
):



############################################################################
############################################################################
##
##          ratjordan
##
###########################################################################
###########################################################################
# A Maple program for the computation of the rational Jordan normal form
# of a matrix.
# Authors: T.M.L. Mulders, A.H.M. Levelt
#          Mathematics Department
#          University of Nijmegen.
# E-mail: mulders@sci.kun.nl, ahml@sci.kun.nl
#
# January 1993


# A primary invariant is a (non-empty) list
# prim_inv:=[[q1,[e11,e12,...]],[q2,[e21,e22,...]],....]
# where q1,q2,... are monic, irreducible, different polynomials in K[x],
# (K a field), and for each i [ei1,ei2,...] a non-empty list of positive
# integers.
# Conventions adopted: i->degree(qi) is non-decreasing and
# for each i, j->eij is non-decreasing.
#
# The matrix R in rational Jordan normal form corresponding to prim_inv
# is the square matrix with blocks
# ratj(q1,e11),ratj(q1,e12),...,ratj(q2,e21),ratj(q2,e22),...
# along the diagonal and zeroes elsewhere.
# Here
#                [C(p)  I             ]
#                [    C(p)  I         ]
#   ratj(p,e) =  [          .   .     ]
#                [            C(p)  I ]
#                [                C(p)]
# with e blocks C(p) along the diagonal. C(p) is the companion matrix
# corresponding to the monic polynomial p in K[x].
# If A is a square matrix over a field K, then there exist square matrices
# P and R over K such that R is in rational Jordan normal form and
#               inverse(P)*A*P = R.
# The matrix R is called the rational Jordan normal form of A.
#
# The function ratjordan computes the rational Jordan normal form R of
# a matrix A, the transformation matrix P and its inverse P^(-1).
# Specifically:
# - ratjordan(A) or ratjordan(A,K) will return the rational Jordan normal
#   form R of A.
# - ratjordan(A,'P') or ratjordan(A,K,'P') will do the same as ratjordan(A)
#   (resp. ratjordan(A,K)), but now the transformation matrix is assigned to P.
# - ratjordan(A,'P','Pinv') or ratjordan(A,K,'P','Pinv') will do the same
#   as ratjordan(A,'P') (resp. ratjordan(A,K,'P')), but now also the inverse
#   of the transformation matrix is assigned to Pinv.
# Here K is a set of RootOf's and/or radicals defining an algebraic extension
# of Q(the rational numbers).
#
# Global description of the algorithm:
# For a given n by n matrix A over a field K, we first compute the
# Frobenius normal form F of A. Then we compute the rational Jordan
# normal form of F, which is also the rational Jordan normal form of A.
# If F=diag(C1,..,Cr), where Ci is the companion matrix associated with a
# polynomial pi in K[x], we first compute the rational Jordan normal form
# of C1 to Cr. From these we then extract the rational Jordan normal form
# of F.


ratjordan:=proc(A)
local AA,n,i,j;
global SIMPLIFY,GCDEX,MULTIPLE;

  if not type(A,'matrix') then
    AA:=evalm(A)
  else
    AA:=A
  fi;
  if not type(AA,'matrix'('anything','square')) then
    ERROR(`expecting a square matrix`)
  fi;

  n:=linalg[rowdim](AA);
  for i to n do
    for j to n do
      if type(AA[i,j],indexed) then
        ERROR(`Unassigned array elements`)
      fi
    od
  od;

  if nargs>1 and type(args[2],set) then
    if args[2]={I} then
      SIMPLIFY:=simplcomplex;
      GCDEX:=gcdexgeneral;
      MULTIPLE:=multiplegeneral;
      ratjordanform(AA,args[2..nargs])
    else
      SIMPLIFY:=simplalgebraic;
      GCDEX:=gcdexgeneral;
      MULTIPLE:=multiplegeneral;
      ratjordanform(AA,args[2..nargs])
    fi
  else
    if type(AA,'matrix'('rational')) then
      SIMPLIFY:=simplrational;
      GCDEX:=gcdex;
      MULTIPLE:=lcm;
      ratjordanform(AA,{},args[2..nargs])
    else
      SIMPLIFY:=simplratfunc;
      GCDEX:=gcdexgeneral;
      MULTIPLE:=multiplegeneral;
      ratjordanform(AA,{},args[2..nargs])
    fi
  fi

end:

`normform/ratjordanform`:=proc(A,K,P,Pinv)
local F,prim_inv,x,T,Tinv,S,Sinv;

  if nargs=2 then
    F:=frobeniusform(A);
    prim_inv:=frobenius_to_ratjordan(F,K,x)
  elif nargs=3 then
    F:=frobeniusform(A,'T');
    prim_inv:=frobenius_to_ratjordan(F,K,x,'S');
    P:=map(SIMPLIFY,evalm(T&*S))
  else
    F:=frobeniusform(A,'T','Tinv');
    prim_inv:=frobenius_to_ratjordan(F,K,x,'S','Sinv');
    P:=map(SIMPLIFY,evalm(T&*S));
    Pinv:=map(SIMPLIFY,evalm(Sinv&*Tinv))
  fi;

  priminv_to_ratjordan(prim_inv,x)

end:


# frobenius_to_ratjordan computes the rational Jordan normal form R of a
# matrix F which is in Frobenius normal form. Say F=diag(C1,..,Cr), where
# Ci is the companion matrix associated with the polynomial pi. First we
# determine the irreducible factors P1,..,PN which appear in p1 through
# pr and build a matrix fact_mat such that pi=
# product(Pj^fact_mat[i,j],j=1..N). This matrix is used at several places
# in the algorithm.
# In fact we can immediately extract from fact_mat the rational Jordan
# normal form of F. If also the transformation matrix is wanted, we compute
# it first for C1 to Cr. Then we compute the transformation matrix by
# rearranging the former results.
# If R is the matrix in rational Jordan normal form corresponding to
# prim_inv:=[[q1,[e11,e12,...]],[q2,[e21,e22,...]],....], then
# prim_inv is returned by frobenius_to_ratjordan.


`normform/frobenius_to_ratjordan`:=proc(F,K,x,S,Sinv)
local P,inv_fact,g,L,h,fact_mat,r,N,T_list,i,j,k,facts,T,n,cols,prim_inv,
      exp_list,G,p,e,Tinv_list,Q,Qinv,d,degp,count,Tinv,m;

  # compute p1,..,pr
  inv_fact:=frobenius_to_invfact(F,x);
  r:=nops(inv_fact);

#######
# Compute fact_mat
#######
  g:=[inv_fact[1],seq(SIMPLIFY(quo(inv_fact[i],inv_fact[i-1],x),x),i=2..r)];
  L:=[];
  for i to r do
    m:=MULTIPLE(seq(denom(coeff(g[i],x,j)),j=0..degree(g[i],x)));
    h:=factors(SIMPLIFY(m*g[i],x),K)[2];
    L:=[op(L),seq([i,SIMPLIFY(h[j][1]/lcoeff(h[j][1],x),x),h[j][2]],j=1..nops(h))]
  od;
  P:=deg_sort([op({seq(L[i][2],i=1..nops(L))})],x);
  N:=nops(P);
  G:=array(1..r,1..N);
  fact_mat:=array(1..r,1..N);
  for i to r do for j to N do G[i,j]:=0; fact_mat[i,j]:=0 od od;
  for k to nops(L) do
    i:=L[k][1];
    p:=L[k][2];
    e:=L[k][3];
    for j to N do
      if p=P[j] then break fi
    od;
    G[i,j]:=e
  od;
  for j to N do fact_mat[1,j]:=G[1,j] od;
  for i from 2 to r do
    for j to N do
      fact_mat[i,j]:=fact_mat[i-1,j]+G[i,j]
    od
  od;
#######

  if nargs>=4 then
#######
# Compute transition matrix for C1 through Cr
#######
    T_list:=[];
    if nargs=5 then
      Tinv_list:=[]
    fi;
    for i to r do
      facts:=[];
      for j to N do
        if fact_mat[i,j]<>0 then facts:=[op(facts),[P[j],fact_mat[i,j]]] fi
      od;
      if nargs=4 then
        companion_to_ratjordan(facts,x,inv_fact[i],'Q')
      else
        companion_to_ratjordan(facts,x,inv_fact[i],'Q','Qinv');
        Tinv_list:=[op(Tinv_list),op(Qinv)]
      fi;
      T_list:=[op(T_list),op(Q)];
    od;
#######

#######
# Compute transition matrix by permuting diag(T_list[1],..,T_list[r])
#######
    d:=array(1..r,1..N);
    degp:=array(1..r);
    for i to r do
      for j to N do
        d[i,j]:=degree(P[j],x)*fact_mat[i,j]
      od;
      degp[i]:=sum('d[i,j]','j'=1..N)
    od;
    cols:=[];
    for j to N do
      for i to r do
        count:=sum('degp[k]','k'=1..i-1)+sum('d[i,k]','k'=1..j-1);
        for h to d[i,j] do
          cols:=[op(cols),count+h]
        od
      od
    od;

    T:=linalg[diag](op(T_list));
    n:=linalg[rowdim](T);
    S:=array(1..n,1..n);
    for i to n do
      for j to n do
        S[i,j]:=T[i,cols[j]]
      od
    od;

    if nargs=5 then
      Tinv:=linalg[diag](op(Tinv_list));
      Sinv:=array(1..n,1..n);
      for i to n do
        for j to n do
          Sinv[i,j]:=Tinv[cols[i],j]
        od
      od
    fi
#######
  fi;

#######
# Compute prim_inv
#######
  prim_inv:=[];
  for j to N do
    exp_list:=[];
    for i to r do
      if fact_mat[i,j]<>0 then exp_list:=[op(exp_list),fact_mat[i,j]] fi
    od;
    prim_inv:=[op(prim_inv),[P[j],exp_list]]
  od;
#######

  prim_inv

end:

`normform/deg_sort`:=proc(l,x)
local ll,n,i,j;
  ll:=l;
  n:=nops(ll);
  for i from 1 to nops(ll)-1 do
    for j from i+1 to nops(ll) do
      if degree(ll[j],x)<degree(ll[i],x) then
        ll:=[op(1..i-1,ll),ll[j],op(i..j-1,ll),op(j+1..n,ll)]
      fi
    od
  od;
  ll
end:


# companion_to_ratjordan computes the rational Jordan normal form of a
# matrix C which is the companion matrix of a polynomial p. Since the
# factors of p are known, the rational Jordan normal form of C is also
# known, so in fact we only have to compute the transition matrix.
#
# Global description of the algorithm:
# First consider the case where p=q^e, q irreducible. Let n=degree(p). Then
# we have the following diagram:
#                           ~
#                   K^n <------- K[x]/q^e
#
#                    |               |
#                    |               |
#                    |C              |x
#                    |               |
#                    |               |
#                   \ /             \ /
#                           ~
#                   K^n <------- K[x]/q^e
#
# We look for a K-basis (b1,..,bn) of K[x]/q^e such that we get the
# following diagram:
#                       ~                ~
#               K^n <------- K[x]/q^e -------> K^n
#
#                |               |              |
#                |               |              |
#                |C              |x             |ratj(q,e)
#                |               |              |
#                |               |              |
#               \ /             \ /            \ /
#                       ~                ~
#               K^n <------- K[x]/q^e -------> K^n
#
# Let q=x^d+q(d-1)*x^(d-1)+..+q1*x+q0. It follows that b1,..,bn must satisfy
# the following relations:
#
# x*b1      = b2
# x*b2      = b3
# ...
# x*bd      = -q0*b1-q1*b2-..-q(d-1)*bd
# x*b(d+1)  = b(d+2)+b1
# x*b(d+2)  = b(d+3)+b2
# ...
# x*b(2d)   = -q0*b(d+1)-q1*b(d+2)-..-q(d-1)*b(2d)+bd
# x*b(2d+1) = b(2d+2)+b(d+1)
# ...
# x*bn      = -q0*b(n-d+1)-q1*b(n-d+2)-..-q(d-1)*bn+b(n-d)
# From this we deduce that b1,b(d+1),b(2d+1),... must satisfy the following
# relations:
#
# q*b1      = 0
# q*b(d+1)  = q'*b1
# q*b(2d+1) = q'*b(d+1)-1/2*q''*b1
# q*b(3d+1) = q'*b(2d+1)-1/2*q''*b(d+1)+1/6*q'''*b1
# q*b(4d+1) = q'*b(3d+1)-1/2*q''*b(2d+1)+1/6*q'''*b(d+1)-1/24*q''''*b1
# ...
# where ' stands for taking the derivative with respect to x.
# If we choose b1=q^(e-1) we can compute b2,..,bn from the relations above.
# We assume that K is a perfect field, so q' is not zero. From this we
# see that q^(e-i-1) divides b(id+1) while q^(e-i) does not divide
# b(di+1). In particular we have gcd(b((e-1)i+1),q)=1.
# Notice also the following relations which can be easily proved:
# x^i*b1      = b(i+1)
# x^i*b(d+1)  = b(d+i+1)+binomial(i,1)*bi
# x^i*b(2d+1) = b(2d+i+1)+binomial(i,1)*b(d+i)+binomial(i,2)*b(i-1)
# ... 
#
# Now the general case where p=q1^e1*q2^e2*..*qr^er. To compose the partial
# results we use the following diagram:
#       ~          ~                               ~
# K^n <--- K[x]/p ---> K[x]/q1^e1 X..X K[x]/qr^er ---> K^n1 X......X K^nr
#
#  |          |            |               |            |             |
#  |          |            |               |            |             |
#  |C         |x           |x              |x           |ratj(q1,e1)  |ratj(qr,er)
#  |          |            |               |            |             |
#  |          |            |               |            |             |
# \ /        \ /          \ /             \ /          \ /           \ /
#       ~          ~                               ~
# K^n <--- K[x]/p ---> K[x]/q1^e1 X..X K[x]/qr^er ---> K^n1 X......X K^nr
#
# In order to compose the K_bases of K[x]/q1^e1 through K[x]/qr^er to a
# K-basis of K[x]/p we compute polynomials u1,..,ur such that
# (ui mod qi^ei)=1 and (ui mod qj^ej)=0.

`normform/companion_to_ratjordan`:=proc(fact_list,x,f,Q,Qinv)
local i,j,k,r,g_list,u_list,bbasis,q,e,d,qpower,diffq,
      part_basis,ratj_basis,n,s,t,g,rowQinv,pol_lincomb,qq,rr,
      lincomb,index,v,u,a;

  r:=nops(fact_list);
  n:=degree(f,x);

  g_list:=[seq(SIMPLIFY(fact_list[i][1]^fact_list[i][2],x),i=1..r)];

#######
# Compute u1,..,ur
#######
  u_list:=array(1..r);
  if r=1 then u_list[1]:=1
  else
    GCDEX(g_list[1],g_list[2],x,'s','t');
    u_list[1]:=SIMPLIFY(t*g_list[2],x);
    u_list[2]:=SIMPLIFY(s*g_list[1],x);
    g:=SIMPLIFY(g_list[1]*g_list[2],x);
    for i from 3 to r do
      GCDEX(g,g_list[i],x,'s','t');
      for j to i-1 do
        u_list[j]:=SIMPLIFY(rem(u_list[j]*t*g_list[i],f,x),x)
      od;
      u_list[i]:=SIMPLIFY(s*g,x);
      g:=SIMPLIFY(g*g_list[i],x)
    od
  fi;
#######

  bbasis:=[];  # basis will contain a K-basis of K[x]/f
  rowQinv:=0;

  Q:=array(1..n,1..n);
  if nargs=5 then
    Qinv:=array(1..n,1..n)
  fi;

  for i to r do
    q:=fact_list[i][1];
    e:=fact_list[i][2];
    d:=degree(q,x);

    qpower:=array(1..e+1);
    qpower[1]:=1;
    for j from 2 to e+1 do qpower[j]:=SIMPLIFY(q*qpower[j-1],x) od;

    if e>1 then
      diffq:=array(1..e-1);
      diffq[1]:=SIMPLIFY(diff(q,x),x);
      for j from 2 to e-1 do diffq[j]:=SIMPLIFY(diff(diffq[j-1],x),x) od
    fi;

#######
# Compute b1,b(d+1),b(2d+1),...
#######
    part_basis:=array(1..e);
    part_basis[1]:=SIMPLIFY(q^(e-1),x);
    for j from 2 to e do
      part_basis[j]:=SIMPLIFY(normal(sum('(-1)^(k-1)/(k!)*diffq[k]*part_basis[j-k]','k'=1..j-1)/q),x)
    od;
#######

#######
# Compute b1,..,bni
#######
    ratj_basis:=array(1..e*d);
    ratj_basis[1]:=part_basis[1];
    for k from 2 to d do
      ratj_basis[k]:=SIMPLIFY(x*ratj_basis[k-1],x)
    od;
    for j from 2 to e do
      ratj_basis[(j-1)*d+1]:=part_basis[j];
      for k from 2 to d do
        ratj_basis[(j-1)*d+k]:=SIMPLIFY(x*ratj_basis[(j-1)*d+k-1]-ratj_basis[(j-2)*d+k-1],x)
      od;
    od;
#######

#######
# Complete basis
#######
    for k to e*d do
      t:=SIMPLIFY(rem(u_list[i]*ratj_basis[k],f,x),x);
      bbasis:=[op(bbasis),t]
    od;
#######

    if nargs=5 then
#######
# Compute next e*d rows of Qinv (see diagram above)
#######

  #######
  # Compute coordinates of 1 with respect to basis (b1,..,bn)
  # Use the fact that q^(e-i-1) divides b(id+1) and gcd(b((e-1)d+1),q)=1
  #######
      pol_lincomb:=array(1..e);
      for j to e do pol_lincomb[j]:=0 od;
      GCDEX(part_basis[e],qpower[e+1],x,'s','t');  # =1
      pol_lincomb[e]:=SIMPLIFY(s,x);
      for j from e by -1 to 1 do
        qq:=quo(pol_lincomb[j],q,x,'rr');
        pol_lincomb[j]:=SIMPLIFY(rr,x);
        for k to j-1 do
          pol_lincomb[j-k]:=SIMPLIFY(rem(pol_lincomb[j-k]+qq*diffq[k]*(-1)^(k-1)/k!,qpower[j+1],x),x)
        od
      od;
      lincomb:=array(1..e*d);
      for j to e do
        for k to d do
          index:=(j-1)*d+k;
          lincomb[index]:=coeff(pol_lincomb[j],x,k-1);
          for v to min(j-1,k-1) do
            lincomb[index-v*d-v]:=SIMPLIFY(lincomb[index-v*d-v]+coeff(pol_lincomb[j],x,k-1)*binomial(k-1,v))
          od
        od
      od;

      for u to e*d do
        rowQinv:=rowQinv+1;
        Qinv[rowQinv,1]:=lincomb[u]
      od;
  #######

  #######
  # Compute coordinates of x^v with respect to basis (b1,..,bn)
  #######
      for v from 2 to n do
        a:=copy(lincomb);
        index:=0;
        for j to e-1 do
          index:=index+1;
          lincomb[index]:=SIMPLIFY(-coeff(q,x,0)*a[j*d]+a[j*d+1]);
          for k from 2 to d do
            index:=index+1;
            lincomb[index]:=SIMPLIFY(a[(j-1)*d+k-1]-coeff(q,x,k-1)*a[j*d]+a[j*d+k])
          od
        od;
        index:=index+1;
        lincomb[index]:=SIMPLIFY(-coeff(q,x,0)*a[e*d]);
        for k from 2 to d do
          index:=index+1;
          lincomb[index]:=SIMPLIFY(a[(e-1)*d+k-1]-coeff(q,x,k-1)*a[e*d])
        od;

        rowQinv:=rowQinv-e*d;
        for u to e*d do
          rowQinv:=rowQinv+1;
          Qinv[rowQinv,v]:=lincomb[u]
        od

      od
  #######

#######
    fi
  od;

#######
# Compute Q (see diagram above)
#######
  for j to n do
    for k to n do
    Q[k,j]:=coeff(bbasis[j],x,k-1)
    od
  od;
#######

  NULL
end:


# For a matrix F in Frobenius normal form, frobenius_to_invfact(F,x) computes
# the list inv_fact:=[p1,..,pr] such that F=invfact_to_frobenius(plist,x)

`normform/frobenius_to_invfact`:=proc(F,x)
local n,k,p,i,j,inv_fact;
  n:=linalg[rowdim](F);
  inv_fact:=[];
  k:=1;
  while k<=n do
    p:=0;
    i:=k+1;
    while i<=n and F[i,i-1]=1 do i:=i+1 od;
    for j from k to i-1 do
      p:=p-F[j,i-1]*x^(j-k)
    od;
    p:=sort(p+x^(i-k));
    inv_fact:=[op(inv_fact),p];
    k:=i
  od;
  inv_fact
end:


# For a primary invariant prim_inv, priminv_to_ratjordan(prim_inv,x) returns
# the matrix R in rational Jordan normal form corresponding to prim_inv

`normform/priminv_to_ratjordan`:=proc(prim_inv,x)
local r,i,j,p,exp_list,block_list;
  r:=nops(prim_inv);
  block_list:=[];
  for i to r do
    p:=prim_inv[i][1];
    exp_list:=prim_inv[i][2];
    for j to nops(exp_list) do
      block_list:=[op(block_list), make_ratj_block(p,x,exp_list[j])]
    od
  od;
  linalg[diag](op(block_list))
end:

# For a monic polynomial p in x and a positive integer e,
# make_ratj_block(p,x,e) returns the matrix ratj(p,e)

`normform/make_ratj_block`:=proc(p,x,e)
local C,d,n,J_block,i;
  C:=linalg[companion](p,x);
  d:=degree(p,x);
  n:=d*e;
  J_block:=zero_matrix(n,n);
  for i to e do
    linalg[copyinto](C,J_block,(i-1)*d+1,(i-1)*d+1)
  od;
  for i to n-d do
    J_block[i,i+d]:=1
  od;
  op(J_block)
end:


# multiplegeneral computes the product of the arguments

`normform/multiplegeneral`:=proc()
local i;
  SIMPLIFY(product('args[i]','i'=1..nargs))
end:

`help/text/ratjordan` := TEXT(
`FUNCTION: ratjordan - compute the rational Jordan normal form of a matrix`,
`   `,
`CALLING SEQUENCE:`,
`   ratjordan(A) or ratjordan(A, K)`,
`   ratjordan(A, 'P') or ratjordan(A, K, 'P')`,
`   ratjordan(A, 'P', 'Pinv') or ratjordan(A, K, 'P', 'Pinv')`,
`   `,
`PARAMETERS:`,
`   A          - a square matrix`,
`   K          - an algebraic extension`,
`   'P','Pinv' - (optional) assigned the transformation matrix and its inverse`,
`   `,
`SYNOPSIS:`,
`- The function ratjordan(A) computes and returns the rational Jordan normal`,
`  form R of a matrix A.`,
`   `,
`- R has the following structure: R = diag(R11,R12,..,R21,R22,..) where the`,
`  Rij's have the following shape:`,
`   `,
`             [ C(pi)   I                     ]`,
`             [                               ]`,
`             [       C(pi)   I               ]`,
`             [                               ]`,
`             [               .     .         ]`,
`             [                               ]`,
`             [                   C(pi)   I   ]`,
`             [                               ]`,
`             [                         C(pi) ]`,
`   `,
`  where there are eij blocks C(pi) along the diagonal and C(pi) is the`,
`  companion matrix associated with the irreducible polynomial pi.`,
`  Convention: i->degree(pi) is non-decreasing and for each i, j->eij is`,
`  non_decreasing`,
`  `,
`- If called in the form ratjordan(A, 'P'), then P will be assigned the`,
`  transformation matrix corresponding to the rational Jordan normal form,`,
`  that is, the matrix P such that inverse(P) * A * P = R.`,
`  If called in the form ratjordan(A, 'P', 'Pinv'), then Pinv will be assigned`,
`  the inverse of P.`,
`   `,
`- If the optional parameter K is present, all calculations will be performed`,
`  in the algebraic number field defined by K. Here K is a set of RootOf's`,
`  and/or radicals`,
`   `,
`- When K is not present also rational functions in several variables are`,
`  allowed as matrix entries`,
`   `,
`EXAMPLES:`,
`> A := array([[-9,21,-15,4,2,0],[-10,21,-14,4,2,0],[-8,16,-11,4,2,0],`,
`>             [-6,12,-9,3,3,0],[-4,8,-6,0,5,0],[-2,4,-3,0,1,3]]);`,
`                              [  -9  21  -15  4  2  0 ]`,
`                              [                       ]`,
`                              [ -10  21  -14  4  2  0 ]`,
`                              [                       ]`,
`                              [  -8  16  -11  4  2  0 ]`,
`                         A := [                       ]`,
`                              [  -6  12   -9  3  3  0 ]`,
`                              [                       ]`,
`                              [  -4   8   -6  0  5  0 ]`,
`                              [                       ]`,
`                              [  -2   4   -3  0  1  3 ]`,
`   `,
`> ratjordan(A,'P','Pinv');`,
`                             [ 1  1  0  0  0   0 ]`,
`                             [                   ]`,
`                             [ 0  1  0  0  0   0 ]`,
`                             [                   ]`,
`                             [ 0  0  3  0  0   0 ]`,
`                             [                   ]`,
`                             [ 0  0  0  3  0   0 ]`,
`                             [                   ]`,
`                             [ 0  0  0  0  0  -5 ]`,
`                             [                   ]`,
`                             [ 0  0  0  0  1   4 ]`,
`   `,
`> op(P);op(Pinv);`,
`                        [  1   1/4  3  -3/8   3   7/2 ]`,
`                        [                             ]`,
`                        [  1   1/4  3  -3/8  5/2  5/2 ]`,
`                        [                             ]`,
`                        [  1   1/4  3  -3/8   2    2  ]`,
`                        [                             ]`,
`                        [ 3/4  3/8  3  -3/8  3/2  3/2 ]`,
`                        [                             ]`,
`                        [ 1/2  1/4  3  -3/8   1    1  ]`,
`                        [                             ]`,
`                        [ 1/4  1/8  2  -1/8  1/2  1/2 ]`,
`   `,
`                          [  0  -4   6    0   -2  0 ]`,
`                          [                         ]`,
`                          [  0   0  -4    8   -4  0 ]`,
`                          [                         ]`,
`                          [  0   0   0  -1/3   0  1 ]`,
`                          [                         ]`,
`                          [  0   0   0   8/3  -8  8 ]`,
`                          [                         ]`,
`                          [ -2   6  -4    0    0  0 ]`,
`                          [                         ]`,
`                          [  2  -4   2    0    0  0 ]`,
`   `,
`> A := array([[-3-I,1,2+I,7-9*I],`,
`              [-2,1,1,5-I],`,
`              [-2-2*I,1,2+2*I,4-2*I],`,
`              [2,0,-1,-2+8*I]]);`,
`                        [  - 3 - I   1   2 + I    7 - 9 I  ]`,
`                        [                                  ]`,
`                        [     -2     1     1       5 - I   ]`,
`                   A := [                                  ]`,
`                        [ - 2 - 2 I  1  2 + 2 I   4 - 2 I  ]`,
`                        [                                  ]`,
`                        [     2      0     -1    - 2 + 8 I ]`,
`   `,
`> ratjordan(A,{I});`,
`                         [ 1 + I    0    0      0     ]`,
`                         [                            ]`,
`                         [   0    1 + I  0      0     ]`,
`                         [                            ]`,
`                         [   0      0    0  - 2 - 5 I ]`,
`                         [                            ]`,
`                         [   0      0    1  - 4 + 7 I ]`,
`   `,
`> s:=sqrt(2):`,
`> A := array([[4*s-6,-4*s+7,-3*s+6],`,
`              [3*s-6,-3*s+7,-3*s+6],`,
`              [3*s,1-3*s,-2*s]]);`,
`                     [    1/2           1/2           1/2     ]`,
`                     [ 4 2    - 6  - 4 2    + 7  - 3 2    + 6 ]`,
`                     [                                        ]`,
`                     [    1/2           1/2           1/2     ]`,
`                A := [ 3 2    - 6  - 3 2    + 7  - 3 2    + 6 ]`,
`                     [                                        ]`,
`                     [      1/2            1/2          1/2   ]`,
`                     [   3 2        1 - 3 2        - 2 2      ]`,
`   `,
`> ratjordan(A,{sqrt(2)});`,
`                           [        1/2             ]`,
`                           [ 1 - 3 2       0     0  ]`,
`                           [                        ]`,
`                           [              1/2       ]`,
`                           [      0      2       0  ]`,
`                           [                        ]`,
`                           [                    1/2 ]`,
`                           [      0        0   2    ]`,
`   `,
`> alias(a=RootOf(X^3-2*X+X-5)):`,
`> A := array([[11+6*a^2+2*a,6*a^2+10,-6*a^2-2*a-10],`,
`              [1+3*a+a^2,a+a^2,-3*a-a^2],`,
`              [4*a+6*a^2+10,6*a^2+10,-9-4*a-6*a^2]]);`,
`                  [         2           2            2            ]`,
`                  [ 11 + 6 a  + 2 a  6 a  + 10  - 6 a  - 2 a - 10 ]`,
`                  [                                               ]`,
`                  [              2          2                2    ]`,
`             A := [   1 + 3 a + a      a + a        - 3 a - a     ]`,
`                  [                                               ]`,
`                  [          2          2                       2 ]`,
`                  [ 4 a + 6 a  + 10  6 a  + 10   - 9 - 4 a - 6 a  ]`,
`   `,
`> ratjordan(A,{a});`,
`                         [ 1 - 2 a     0         0    ]`,
`                         [                            ]`,
`                         [    0     1 - 2 a      0    ]`,
`                         [                            ]`,
`                         [                          2 ]`,
`                         [    0        0     3 a + a  ]`,
`   `,
`> A := array([[(y+y^2-x^2)/y,(x-x^2-y+y^2)/y,(x^2-y^2)/y],`,
`              [1+x+y,(x-y+y^2+x*y)/y,-x-y],`,
`              [(y-x+y^2-x^2)/y,(x-y+y^2-x^2)/y,(x+x^2-y^2)/y]]);`,
`               [         2    2             2        2     2    2   ]`,
`               [    y - x  + y       - y - x  + x + y     x  - y    ]`,
`               [    -----------      -----------------    -------   ]`,
`               [         y                   y               y      ]`,
`               [                                                    ]`,
`               [                               2                    ]`,
`               [                    - y + x + y  + x y              ]`,
`          A := [     1 + y + x      ------------------    - y - x   ]`,
`               [                             y                      ]`,
`               [                                                    ]`,
`               [            2    2          2        2       2    2 ]`,
`               [ - x + y - x  + y    - y - x  + x + y   x + x  - y  ]`,
`               [ -----------------   -----------------  ----------- ]`,
`               [         y                   y               y      ]`,
`   `,
`> ratjordan(A);`,
`                              [ x + y   0    0  ]`,
`                              [                 ]`,
`                              [   0    x/y   0  ]`,
`                              [                 ]`,
`                              [   0     0   x/y ]`,
`   `,
`SEE ALSO: smithex, ismithex, frobenius, jordansymbolic, jordan,`,
`          Frobenius, Ratjordan, Jordansymbolic`
):



############################################################################
############################################################################
##
##          jordansymbolic and jordan
##
###########################################################################
###########################################################################
# A Maple program for the computation of the Jordan normal form of a matrix.
# Authors: T.M.L. Mulders, A.H.M. Levelt
#          Mathematics Department
#          University of Nijmegen.
# E-mail: mulders@sci.kun.nl, ahml@sci.kun.nl
#
# January 1993


# An invariant is a (non_empty) list
# invariant:=[[x1,[e11,e12,...]],[x2,[e21,e22,...]],....]
# where xi in K (K a field), and for each i [ei1,ei2,...] a non-empty
# list of positive integers.
# Convention adopted: for each i, j->eij is non_decreasing.
#
# The matrix J in Jordan normal form corresponding to invariant is the
# square matrix with blocks
# jord(x1,e11),jord(x1,e12),...,jord(x2,e21),jord(x2,e22),...
# along the diagonal and zeroes elsewhere.
# Here
#              [x 1      ]
#              [  x 1    ]
#  jord(x,e) = [    . .  ]
#              [      x 1]
#              [        x]
# with e times x along the diagonal.
# If A is a square matrix over a field K, and the characteristic polynomial
# of A splits completely over K, then there exist square matrices
# P and J over K such that J is in Jordan normal form and
#               inverse(P)*A*P = J.
# The matrix J is called the Jordan normal form of A.
# If the characteristic polynomial p of A does not split completely in K
# we can still compute the Jordan normal form of A as it would be in
# a splitting field L of p over K. We will give the zeroes of p in L\K
# symbolic names. These names will then appear in both J and P. If K=Q
# (the rational numbers) or some algebraic extension of Q we will also
#  compute the Jordan normal form of A in C (the complex numbers). The zeroes
# of p will be computed exactly if possible. Zeroes which are not computed
# exactly, will be approximated by floating point numbers.
#
# The function jordansymbolic computes the Jordan normal form J of
# a matrix A, the transformation matrix P and its inverse P^(-1).
# Here symbolic names are used for the zeroes of the characteristic
# polynomial p not in K. Also a list of irreducible factors of p is returned.
# Specifically:
# - jordansymbolic(A) or jordansymbolic(A,K) will return [J,l], where J is
#   the Jordan normal form of A (using symbolic names if necessary) and
#   l=[ll,x], where x is a name and ll is a list of irreducible factors of
#   p(x). If symbolic names are used then xij is a zero of ll[i].
# - jordansymbolic(A,'P') or jordansymbolic(A,K,'P') will do the same as
#   jordansymbolic(A) (resp. jordansymbolic(A,K)), but now the transformation
#    matrix is assigned to P.
# - jordansymbolic(A,'P','Pinv') or jordansymbolic(A,K,'P','Pinv')will do the
#   same as jordansymbolic(A,'P') (resp. jordansymbolic(A,K,'P')), but now
#   also the inverse of the transformation matrix is assigned to Pinv.
# Here K is a set of RootOf's and/or radicals defining an algebraic extension
# of Q(the rational numbers).
#
# The function jordan computes the jordan normal form J of a matrix A with
# entries in some algebraic extension of Q, the transformation matrix P and
# its inverse P^(-1).
# Here A is considered as a matrix with complex number entries. The zeroes
# of the characteristic polynomial p are computed exactly, if possible.
# Otherwise they are approximated by floating point numbers.
# Specifically:
# - jordan(A) or jordan(A,K) will return the Jordan normal form J of A.
# - jordan(A,'P') or jordan(A,K,'P') will do the same as jordan(A) (resp.
#   jordan(A,K)), but now the transformation matrix is assigned to P.
# - jordan(A,'P','Pinv') or jordan(A,K,'P','Pinv') will do the same as
#   jordan(A,'P') (resp. jordan(A,K,'P')), but now also the inverse of the
#   transformation matrix is assigned to Pinv.
# Here K is a set of RootOf's and/or radicals defining an algebraic extension
# of Q(the rational numbers).
#
# Global description of the algorithm:
# For a given n by n matrix A over a field K, we first compute the rational
# Jordan normal form R of A. Then we compute the Jordan normal form of R,
# which is also the Jordan normal form of A.
# First consider the case where R=C(p), the companion matrix of the monic,
# irreducible polynomial p=x^n+p(n-1)*x^(n-1)+..+p1*x+p0.
# If y is a zero of p then
# (y^(n-1)+p(n-1)*y^(n-2)+..+p2*y+p1,y^(n-2)+p(n-1)*y^(n-3)+..+p3*y+p2,..
#  ..,y^2+p(n-1)*y+p(n-2),y+p(n-1),1)
# is an eigenvector of R with eigenvalue y.
# Let v1     = x^(n-1)+p(n-1)*x^(n-2)+..+p2*x+p1,
#     v2     = x^(n-2)+p(n-1)*x^(n-3)+..+p3*x+p2,
#     ...
#     v(n-2) = x^2+P(n-1)*x+p(n-2),
#     v(n-1) = x+p(n-1),
#     vn     = 1. 
# If y1,..,yn are the different zeroes of p in a splitting field of p over
# K (we asssume that p is separable, this is always true if K is a perfect
# field) we get:
#       inverse(V)*R*V=diag(y1,..,yn),
# where
#          [ v1(y1) v1(y2) ... v1(yn) ]
#          [ v2(y1) v2(y2) ... v2(yn) ]
#      V = [  ...    ...   ...  ...   ]
#          [  ...    ...   ...  ...   ]
#          [ vn(y1) vn(y2) ... vn(yn) ]
# One can prove that
#      [1 y1 ... y1^(n-1)] [v1(y1) v1(y2) ... v1(yn)] 
#      [1 y2 ... y2^(n-1)] [v2(y1) v2(y2) ... v2(yn)] 
#      [.................] [........................] =
#      [.................] [........................] 
#      [1 yn ... yn^(n-1)] [vn(y1) vn(y2) ... vn(yn)] 
#
#    = diag(diff(p,x)(y1),diff(p,x)(y2),...,diff(p,x)(yn)).
# If s and t are such that s*p+t*diff(p,x)=1 then we get
#                                            [1 y1 ... y1^(n-1)]
#                                            [1 y2 ... y2^(n-1)]
#     inverse(V)=diag(t(y1),t(y2),...,t(yn))*[.................]
#                                            [.................]
#                                            [1 yn ... yn^(n-1)]
# Let Y=diag(y1,..,yn). From V^(-1)*R*V=Y it follows that
#                          [C(p)  I             ]
#                          [    C(p)  I         ]
#   diag(V^(-1),..,V^(-1))*[          .   .     ]*diag(V,..,V)=
#                          [            C(p)  I ]
#                          [                C(p)]
#
#          [ Y I       ]
#          [   Y I     ]
#        = [     . .   ]
#          [       Y I ]
#          [         Y ]
# It is now easy to see that to get our general result, we only have to
# permute diag(V,..,V) and diag(V^(-1),..,V^(-1)).


jordansymbolic:=proc(A)
local AA,n,i,j;
global SIMPLIFY,GCDEX,MULTIPLE;

  if not type(A,'matrix') then
    AA:=evalm(A)
  else
    AA:=A
  fi;
  if not type(AA,'matrix'('anything','square')) then
    ERROR(`expecting a square matrix`)
  fi;

  n:=linalg[rowdim](AA);
  for i to n do
    for j to n do
      if type(AA[i,j],indexed) then
        ERROR(`Unassigned array elements`)
      fi
    od
  od;

  if nargs>1 and type(args[2],set) then
    if args[2]={I} then
      SIMPLIFY:=simplcomplex;
      GCDEX:=gcdexgeneral;
      MULTIPLE:=multiplegeneral;
      jordansymbolicform(AA,args[2..nargs])
    else
      SIMPLIFY:=simplalgebraic;
      GCDEX:=gcdexgeneral;
      MULTIPLE:=multiplegeneral;
      jordansymbolicform(AA,args[2..nargs])
    fi
  else
    if type(AA,'matrix'('rational')) then
      SIMPLIFY:=simplrational;
      GCDEX:=gcdex;
      MULTIPLE:=lcm;
      jordansymbolicform(AA,{},args[2..nargs])
    else
      SIMPLIFY:=simplratfunc;
      GCDEX:=gcdexgeneral;
      MULTIPLE:=multiplegeneral;
      jordansymbolicform(AA,{},args[2..nargs])
    fi
  fi

end:

`normform/jordansymbolicform`:=proc(A,K,P,Pinv)
local l,R,T,Tinv,S,Sinv;

  if nargs=2 then
    R:=ratjordanform(A,K);
    l:=ratjordan_to_jordan(R)
  elif nargs=3 then
    R:=ratjordanform(A,K,'T');
    l:=ratjordan_to_jordan(R,'S');
    P:=map(SIMPLIFY,evalm(T&*S))
  else
    R:=ratjordanform(A,K,'T','Tinv');
    l:=ratjordan_to_jordan(R,'S','Sinv');
    P:=map(SIMPLIFY,evalm(T&*S));
    Pinv:=map(SIMPLIFY,evalm(Sinv&*Tinv))
  fi;

  [invariant_to_jordan(l[1]),l[2]]

end:


`normform/ratjordan_to_jordan`:=proc(R,S,Sinv)
local prim_inv,x,i,j,k,d,N,T,Tinv,Tinvlist,Tlist,exp_list,invariant,n,p,
      partT,partTinv,s,t,v,w;

  prim_inv:=ratjordan_to_priminv(R,x);

  invariant:=[];
  if nargs>=2 then
    Tlist:=[]
  fi;
  if nargs=3 then
    Tinvlist:=[]
  fi;

  N:=nops(prim_inv);
  for i to N do
    p:=prim_inv[i][1];
    exp_list:=prim_inv[i][2];
    d:=degree(p,x);
    if d=1 then
      invariant:=[op(invariant),[-coeff(p,x,0),exp_list]]
    else
      for j to d do
        invariant:=[op(invariant),[evaln(x.i.j),exp_list]]
      od
    fi;

    if nargs>=2 then
      # Compute eigenvector of C(p) with eigenvalue x
      v:=array(1..d);
      v[d]:=1;
      for j from d-1 by -1 to 1 do
        v[j]:=sum('coeff(p,x,k)*x^(k-j)','k'=j..(d-1))+x^(d-j)
      od;

      n:=sum('exp_list[j]','j'=1..nops(exp_list));

      partT:=zero_matrix(n*d,n);
      for j to n do
        for k to d do
          partT[(j-1)*d+k,j]:=v[k]
        od
      od;

      T:=array(1..n*d,1..n*d);
      if d=1 then
        linalg[copyinto](subs(x=-coeff(p,x,0),op(partT)),T,1,1)
      else
        for j to d do
          linalg[copyinto](subs(x=evaln(x.i.j),op(partT)),T,1,(j-1)*n+1)
        od
      fi;

      Tlist:=[op(Tlist),op(T)]
    fi;

    if nargs=3 then
      GCDEX(p,diff(p,x),x,'s','t');
      w:=array(1..d);
      w[1]:=SIMPLIFY(t,x);
      for j from 2 to d do
        w[j]:=SIMPLIFY(rem(x*w[j-1],p,x),x)
      od;

      partTinv:=zero_matrix(n,n*d);
      for j to n do
        for k to d do
          partTinv[j,(j-1)*d+k]:=w[k]
        od
      od;
      Tinv:=array(1..n*d,1..n*d);
      if d=1 then
        linalg[copyinto](subs(x=-coeff(p,x,0),op(partTinv)),Tinv,1,1)
      else
        for j to d do
          linalg[copyinto](subs(x=evaln(x.i.j),op(partTinv)),Tinv,(j-1)*n+1,1)
        od
      fi;
      Tinvlist:=[op(Tinvlist),op(Tinv)]
    fi
  od;

  if nargs>=2 then
    S:=linalg[diag](op(Tlist))
  fi;
  if nargs=3 then
    Sinv:=linalg[diag](op(Tinvlist))
  fi;

  [invariant,[[seq(prim_inv[i][1],i=1..N)],x]]

end:


# ratjordan_to_priminv(R,x) computes the primary invariant of a matrix
# R which is in rational Jordan normal form

`normform/ratjordan_to_priminv`:=proc(R,x)
local p,r,n,plist,exp_list,l,i,N,prim_inv;
  n:=linalg[rowdim](R);
  r:=1;
  plist:=[];
  while r<=n do
    l:=find_ratjblock(R,r,x);
    plist:=[op(plist),l];
    r:=r+l[2]*degree(l[1],x)
  od;
  p:=plist[1][1];
  exp_list:=[plist[1][2]];
  prim_inv:=[];
  N:=nops(plist);
  i:=2;
  while i<=N do
    if plist[i][1]=p then
      exp_list:=[op(exp_list),plist[i][2]]
    else
      prim_inv:=[op(prim_inv),[p,exp_list]];
      p:=plist[i][1];
      exp_list:=[plist[i][2]]
    fi;
    i:=i+1
  od;
  prim_inv:=[op(prim_inv),[p,exp_list]];
  prim_inv
end:

`normform/find_ratjblock`:=proc(R,r,x)
local i,n,e,p;
  n:=linalg[rowdim](R);
  p:=find_companion(R,r,x);
  e:=1;
  i:=r+degree(p,x);
  do
    if i>n then RETURN([p,e]) fi;
    if identitymatrix(R,i-degree(p,x),i,degree(p,x)) then
      e:=e+1;
      i:=i+degree(p,x)
    else
      RETURN([p,e])
    fi
  od
end:

`normform/find_companion`:=proc(A,r,x)
local i,j,n,p;
  n:=linalg[rowdim](A);
  i:=r+1;
  while i<=n and A[i,i-1]=1 do i:=i+1 od;
  p:=0;
  for j from r to i-1 do p:=p-A[j,i-1]*x^(j-r) od;
  p:=p+x^(i-r)
end:

`normform/identitymatrix`:=proc(A,i,j,m)
local n;
  n:=linalg[rowdim](A);
  if i+m-1>n or j+m-1>n then
    false
  else
    linalg[equal](linalg[submatrix](A,i..i+m-1,j..j+m-1),array(1..m,1..m,identity))
  fi
end:

`normform/invariant_to_jordan`:=proc(invariant)
local block_list,N,M,i,j;
  N:=nops(invariant);
  block_list:=[];
  for i to N do
    M:=nops(invariant[i][2]);
    for j to M do
      block_list:=[op(block_list),linalg[JordanBlock](invariant[i][1],invariant[i][2][j])]
    od
  od;
  linalg[diag](op(block_list))
end:


# jordan(A) computes the Jordan normal form of a matrix A with entries in
# some algebraic extension of Q. First jordansymbolic is applied to A, then
# the symbolic zeroes of the characteristic polynomial are replaced by the
# actual zeroes. The zeroes of the characteristic polynomial of A are computed
# exactly if possible. The zeroes which cannot be computed exactly are
# approximated by floating point numbers.

jordan:=proc(A)
local AA,n,i,j,l;
global SIMPLIFY,GCDEX,MULTIPLE;

  if not type(A,'matrix') then
    AA:=evalm(A)
  else
    AA:=A
  fi;
  if not type(AA,'matrix'('anything','square')) then
    ERROR(`expecting a square matrix`)
  fi;

  n:=linalg[rowdim](AA);
  for i to n do
    for j to n do
      if type(AA[i,j],indexed) then
        ERROR(`Unassigned array elements`)
      fi
    od
  od;

  if nargs>1 and type(args[2],set) then
    if args[2] union {sqrt(-1),I}={sqrt(-1),I} then
      SIMPLIFY:=simplcomplex;
      GCDEX:=gcdexgeneral;
      MULTIPLE:=multiplegeneral;
      l:=jordansymbolicform(AA,args[2..nargs]);
      jordanform(l,args[3..nargs])
    else
      SIMPLIFY:=simplalgebraic;
      GCDEX:=gcdexgeneral;
      MULTIPLE:=multiplegeneral;
      l:=jordansymbolicform(AA,args[2..nargs]);
      jordanform(l,args[3..nargs])
    fi
  else
    SIMPLIFY:=simplrational;
    GCDEX:=gcdex;
    MULTIPLE:=lcm;
    l:=jordansymbolicform(AA,{},args[2..nargs]);
    jordanform(l,args[2..nargs])
  fi

end:

`normform/jordanform`:=proc(l,P,Pinv)
local N,J,x,d,z,zeroes,i,j;

  N:=nops(l[2][1]);
  x:=l[2][2];
  J:=l[1];
  for i to N do
    d:=degree(l[2][1][i],x);
    if d>1 then

      # determine zeroes
      z:=[solve(l[2][1][i]=0,x)];
      zeroes:=[];
      for j to nops(z) do
        if type(z[j],RootOf) then
          zeroes:=[op(zeroes),fsolve(op(z[j]),op(indets(op(z[j]))),complex)]
        else
          zeroes:=[op(zeroes),z[j]]
        fi
      od;

      # substitute zeroes for symbolic names
      for j to nops(zeroes) do
        J:=subs(evaln(x.i.j)=zeroes[j],op(J))
      od;
      if nargs>=2 then
        for j to nops(zeroes) do
          P:=subs(evaln(x.i.j)=zeroes[j],op(P))
        od
      fi;
      if nargs=3 then
        for j to nops(zeroes) do
          Pinv:=subs(evaln(x.i.j)=zeroes[j],op(Pinv))
        od
      fi

    fi
  od;

  op(J)

end:


`help/text/jordansymbolic` := TEXT(
`FUNCTION: jordansymbolic - compute the Jordan normal form of a matrix`,
`   `,
`CALLING SEQUENCE:`,
`   jordansymbolic(A) or jordansymbolic(A, K)`,
`   jordansymbolic(A, 'P') or jordansymbolic(A, K, 'P')`,
`   jordansymbolic(A, 'P', 'Pinv') or jordansymbolic(A, K, 'P', 'Pinv')`,
`   `,
`PARAMETERS:`,
`   A          - a square matrix`,
`   K          - an algebraic extension`,
`   'P','Pinv' - (optional) assigned the transformation matrix and its inverse`,
`   `,
`SYNOPSIS:`,
`- The function jordansymbolic(A) computes and returns the Jordan normal`,
`  form J of a matrix A.`,
`   `,
`- J has the following structure: J=diag(J11,J12,..,J21,J22,..) where the`,
`  Jij's have the following shape:`,
`   `,
`           [ xi  1              ]`,
`           [                    ]`,
`           [     xi  1          ]`,
`           [                    ]`,
`           [         .   .      ]`,
`           [                    ]`,
`           [             xi  1  ]`,
`           [                    ]`,
`           [                 xi ]`,
`   `,
`  where there are eij times xi along the diagonal. Here xi is a zero of`,
`  the characteristic polynomial p of A. If p does not split completely,`,
`  symbolic names are chosen for the missing zeroes of p. If, by some`,
`  means, one knows such missing zeroes they can be substituted for the`,
`  symbolic names. For this jordansymbolic actually returns a list [J,l],`,
`  where J is the Jordan normal form of A (using symbolic names if necessary)`,
`  and l=[ll,x], where x is a name and ll is a list of irreducible factors of`,
`  p(x). If symbolic names are used then xij is a zero of ll[i].`,
`  Convention: for each i, j->eij is non_decreasing.`,
`   `,
`- If called in the form jordansymbolic(A,'P'), then P will be assigned the`,
`  transformation matrix corresponding to the Jordan normal form,`,
`  that is, the matrix P such that inverse(P) * A * P = J.`,
`  If called in the form jordansymbolic(A,'P','Pinv'), then Pinv will be`,
`  assigned the inverse of P.`,
`   `,
`- If the optional parameter K is present, all calculations will be performed`,
`  in the algebraic number field defined by K. Here K is a set of RootOf's`,
`  and/or radicals`,
`   `,
`- When K is not present also rational functions in several variables are`,
`  allowed as matrix entries`,
`   `,
`EXAMPLES:`,
`> A := array([[-9,21,-15,4,2,0],[-10,21,-14,4,2,0],[-8,16,-11,4,2,0],`,
`>             [-6,12,-9,3,3,0],[-4,8,-6,0,5,0],[-2,4,-3,0,1,3]]);`,
`                              [  -9  21  -15  4  2  0 ]`,
`                              [                       ]`,
`                              [ -10  21  -14  4  2  0 ]`,
`                              [                       ]`,
`                              [  -8  16  -11  4  2  0 ]`,
`                         A := [                       ]`,
`                              [  -6  12   -9  3  3  0 ]`,
`                              [                       ]`,
`                              [  -4   8   -6  0  5  0 ]`,
`                              [                       ]`,
`                              [  -2   4   -3  0  1  3 ]`,
`   `,
`> l:=jordansymbolic(A,'P','Pinv');`,
`           [ 3  0  0  0   0    0  ]`,
`           [                      ]`,
`           [ 0  3  0  0   0    0  ]`,
`           [                      ]`,
`           [ 0  0  1  1   0    0  ]                                 2`,
`     l := [[                      ], [[- 3 + x, - 1 + x, 5 - 4 x + x ], x]]`,
`           [ 0  0  0  1   0    0  ]`,
`           [                      ]`,
`           [ 0  0  0  0  x31   0  ]`,
`           [                      ]`,
`           [ 0  0  0  0   0   x32 ]`,
`   `,
`> op(P);op(Pinv);`,
`             [ 3  -3/8   1   1/4   3 x31 - 17/2    3 x32 - 17/2  ]`,
`             [                                                   ]`,
`             [ 3  -3/8   1   1/4  5/2 x31 - 15/2  5/2 x32 - 15/2 ]`,
`             [                                                   ]`,
`             [ 3  -3/8   1   1/4     2 x31 - 6       2 x32 - 6   ]`,
`             [                                                   ]`,
`             [ 3  -3/8  3/4  3/8   3/2 x31 - 9/2   3/2 x32 - 9/2 ]`,
`             [                                                   ]`,
`             [ 3  -3/8  1/2  1/4      x31 - 3         x32 - 3    ]`,
`             [                                                   ]`,
`             [ 2  -1/8  1/4  1/8   1/2 x31 - 3/2   1/2 x32 - 3/2 ]`,
`   `,
`                     [    0        0      0  -1/3   0  1 ]`,
`                     [                                   ]`,
`                     [    0        0      0   8/3  -8  8 ]`,
`                     [                                   ]`,
`                     [    0        -4     6    0   -2  0 ]`,
`                     [                                   ]`,
`                     [    0        0     -4    8   -4  0 ]`,
`                     [                                   ]`,
`                     [ 3 - x31  x31 - 4   1    0    0  0 ]`,
`                     [                                   ]`,
`                     [ 3 - x32  x32 - 4   1    0    0  0 ]`,
`   `,
`> solve(x^2-4*x+5);`,
`                                  2 + I, 2 - I`,
`   `,
`> subs({x31=2+I,x32=2-I},l[1]);`,
`                          [ 3  0  0  0    0      0   ]`,
`                          [                          ]`,
`                          [ 0  3  0  0    0      0   ]`,
`                          [                          ]`,
`                          [ 0  0  1  1    0      0   ]`,
`                          [                          ]`,
`                          [ 0  0  0  1    0      0   ]`,
`                          [                          ]`,
`                          [ 0  0  0  0  2 + I    0   ]`,
`                          [                          ]`,
`                          [ 0  0  0  0    0    2 - I ]`,
`   `,
`> subs({x31=2+I,x32=2-I},op(P));subs({x31=2+I,x32=2-I},op(Pinv));`,
`              [ 3  -3/8   1   1/4   - 5/2 + 3 I    - 5/2 - 3 I  ]`,
`              [                                                 ]`,
`              [ 3  -3/8   1   1/4  - 5/2 + 5/2 I  - 5/2 - 5/2 I ]`,
`              [                                                 ]`,
`              [ 3  -3/8   1   1/4    - 2 + 2 I      - 2 - 2 I   ]`,
`              [                                                 ]`,
`              [ 3  -3/8  3/4  3/8  - 3/2 + 3/2 I  - 3/2 - 3/2 I ]`,
`              [                                                 ]`,
`              [ 3  -3/8  1/2  1/4     - 1 + I        - 1 - I    ]`,
`              [                                                 ]`,
`              [ 2  -1/8  1/4  1/8  - 1/2 + 1/2 I  - 1/2 - 1/2 I ]`,
`   `,
`                      [   0       0      0  -1/3   0  1 ]`,
`                      [                                 ]`,
`                      [   0       0      0   8/3  -8  8 ]`,
`                      [                                 ]`,
`                      [   0       -4     6    0   -2  0 ]`,
`                      [                                 ]`,
`                      [   0       0     -4    8   -4  0 ]`,
`                      [                                 ]`,
`                      [ 1 - I  - 2 + I   1    0    0  0 ]`,
`                      [                                 ]`,
`                      [ 1 + I  - 2 - I   1    0    0  0 ]`,
`   `,
`> A := array([[-3-I,1,2+I,7-9*I],`,
`              [-2,1,1,5-I],`,
`              [-2-2*I,1,2+2*I,4-2*I],`,
`              [2,0,-1,-2+8*I]]);`,
`                        [  - 3 - I   1   2 + I    7 - 9 I  ]`,
`                        [                                  ]`,
`                        [     -2     1     1       5 - I   ]`,
`                   A := [                                  ]`,
`                        [ - 2 - 2 I  1  2 + 2 I   4 - 2 I  ]`,
`                        [                                  ]`,
`                        [     2      0     -1    - 2 + 8 I ]`,
`   `,
`> jordansymbolic(A,{I});`,
`  [ 1 + I    0     0    0  ]`,
`  [                        ]`,
`  [   0    1 + I   0    0  ]                                            2`,
` [[                        ], [[- 1 - I + x, 2 + 5 I - (- 4 + 7 I) x + x ], x]]`,
`  [   0      0    x21   0  ]`,
`  [                        ]`,
`  [   0      0     0   x22 ]`,
`   `,
`> s:=sqrt(2):`,
`> A := array([[s,1-3*s],[3,1/s]]);`,
`                                [  1/2         1/2 ]`,
`                                [ 2     1 - 3 2    ]`,
`                           A := [                  ]`,
`                                [             1/2  ]`,
`                                [   3    1/2 2     ]`,
`   `,
`> jordansymbolic(A,{sqrt(2)});`,
`              [ x11   0  ]             1/2        1/2      2`,
`             [[          ], [[- 2 + 9 2    - 3/2 2    x + x ], x]]`,
`              [  0   x12 ]`,
`> alias(a=RootOf(X^3-2*X+X-5)):`,
`> A := array([[1-a,2+a^2],[3+a-2*a^2,3]]);`,
`                              [                    2 ]`,
`                              [     1 - a     2 + a  ]`,
`                         A := [                      ]`,
`                              [            2         ]`,
`                              [ 3 + a - 2 a      3   ]`,
`   `,
`> jordansymbolic(A,{a});`,
`             [ x11   0  ]             2                      2`,
`            [[          ], [[- 8 + 3 a  + 4 a - (4 - a) x + x ], x]]`,
`             [  0   x12 ]`,
`> A:=array([[-1,-1/y],[y^2+y+1,y+1]]);`,
`                                [     -1      - 1/y ]`,
`                                [                   ]`,
`                           A := [  2                ]`,
`                                [ y  + y + 1  y + 1 ]`,
`   `,
`> l:=jordansymbolic(A);`,
`                         [ x11   0  ]                 2`,
`                   l := [[          ], [[1/y - y x + x ], x]]`,
`                         [  0   x12 ]`,
`   `,
`> x:=l[2][2]:`,
`> z:=solve(x^2-y*x+1/y,x);`,
`                                    3 1/2                      3 1/2`,
`                            (- 4 + y )                 (- 4 + y )`,
`           z := 1/2 y + 1/2 -------------, 1/2 y - 1/2 -------------`,
`                                  1/2                        1/2`,
`                                 y                          y`,
`   `,
`> map(normal,subs({x11=z[1],x12=z[2]},l[1]));`,
`             [      3/2           3 1/2                           ]`,
`             [     y    + (- 4 + y )                              ]`,
`             [ 1/2 --------------------              0            ]`,
`             [              1/2                                   ]`,
`             [             y                                      ]`,
`             [                                                    ]`,
`             [                                3/2           3 1/2 ]`,
`             [                               y    - (- 4 + y )    ]`,
`             [             0             1/2 -------------------- ]`,
`             [                                        1/2         ]`,
`             [                                       y            ]`,
`   `,
`SEE ALSO: smithex, ismithex, frobenius, ratjordan, jordan,`,
`          Frobenius, Ratjordan, Jordansymbolic`
):


`help/text/jordan` := TEXT(
`FUNCTION: jordan - compute the Jordan normal form of a matrix`,
`   `,
`CALLING SEQUENCE:`,
`   jordan(A) or jordan(A, K)`,
`   jordan(A, 'P') or jordan(A, K, 'P')`,
`   jordan(A, 'P', 'Pinv') or jordan(A, K, 'P', 'Pinv')`,
`   `,
`PARAMETERS:`,
`   A          - a square matrix`,
`   K          - an algebraic extension`,
`   'P','Pinv' - (optional) assigned the transformation matrix and its inverse`,
`   `,
`SYNOPSIS:`,
`- The function jordan(A) computes and returns the Jordan normal`,
`  form J of a matrix A with entries in an algebraic extension of Q (the`,
`  rational numbers).`,
`   `,
`- J has the following structure: J=diag(J11,J12,..,J21,J22,..) where the`,
`  Jij's have the following shape:`,
`   `,
`           [ xi  1              ]`,
`           [                    ]`,
`           [     xi  1          ]`,
`           [                    ]`,
`           [         .   .      ]`,
`           [                    ]`,
`           [             xi  1  ]`,
`           [                    ]`,
`           [                 xi ]`,
`   `,
`  where there are eij times xi along the diagonal. Here xi is a zero of`,
`  the characteristic polynomial p of A. The zeroes of the characteristic`,
`  polynomial are computed exactly, if possible. Otherwise they are`,
`  approximated by floating point numbers.`,
`  Convention: for each i, j->eij is non_decreasing.`,
`   `,
`- If called in the form jordan(A,'P'), then P will be assigned the`,
`  transformation matrix corresponding to the Jordan normal form,`,
`  that is, the matrix P such that inverse(P) * A * P = J.`,
`  If called in the form jordan(A,'P','Pinv'), then Pinv will be`,
`  assigned the inverse of P.`,
`   `,
`- If the optional parameter K is present, all calculations will be performed`,
`  in the algebraic number field defined by K. Here K is a set of RootOf's`,
`  and/or radicals`,
`   `,
`EXAMPLES:`,
`> A := array([[-9,21,-15,4,2,0],[-10,21,-14,4,2,0],[-8,16,-11,4,2,0],`,
`>             [-6,12,-9,3,3,0],[-4,8,-6,0,5,0],[-2,4,-3,0,1,3]]);`,
`                              [  -9  21  -15  4  2  0 ]`,
`                              [                       ]`,
`                              [ -10  21  -14  4  2  0 ]`,
`                              [                       ]`,
`                              [  -8  16  -11  4  2  0 ]`,
`                         A := [                       ]`,
`                              [  -6  12   -9  3  3  0 ]`,
`                              [                       ]`,
`                              [  -4   8   -6  0  5  0 ]`,
`                              [                       ]`,
`                              [  -2   4   -3  0  1  3 ]`,
`   `,
`> jordan(A,'P','Pinv');`,
`                          [ 1  1  0  0    0      0   ]`,
`                          [                          ]`,
`                          [ 0  1  0  0    0      0   ]`,
`                          [                          ]`,
`                          [ 0  0  3  0    0      0   ]`,
`                          [                          ]`,
`                          [ 0  0  0  3    0      0   ]`,
`                          [                          ]`,
`                          [ 0  0  0  0  2 + I    0   ]`,
`                          [                          ]`,
`                          [ 0  0  0  0    0    2 - I ]`,
`   `,
`> op(P);op(Pinv);`,
`              [  1   1/4  3  -3/8   - 5/2 + 3 I    - 5/2 - 3 I  ]`,
`              [                                                 ]`,
`              [  1   1/4  3  -3/8  - 5/2 + 5/2 I  - 5/2 - 5/2 I ]`,
`              [                                                 ]`,
`              [  1   1/4  3  -3/8    - 2 + 2 I      - 2 - 2 I   ]`,
`              [                                                 ]`,
`              [ 3/4  3/8  3  -3/8  - 3/2 + 3/2 I  - 3/2 - 3/2 I ]`,
`              [                                                 ]`,
`              [ 1/2  1/4  3  -3/8     - 1 + I        - 1 - I    ]`,
`              [                                                 ]`,
`              [ 1/4  1/8  2  -1/8  - 1/2 + 1/2 I  - 1/2 - 1/2 I ]`,
`   `,
`                      [   0       -4     6    0   -2  0 ]`,
`                      [                                 ]`,
`                      [   0       0     -4    8   -4  0 ]`,
`                      [                                 ]`,
`                      [   0       0      0  -1/3   0  1 ]`,
`                      [                                 ]`,
`                      [   0       0      0   8/3  -8  8 ]`,
`                      [                                 ]`,
`                      [ 1 - I  - 2 + I   1    0    0  0 ]`,
`                      [                                 ]`,
`                      [ 1 + I  - 2 - I   1    0    0  0 ]`,
`   `,
`> A := array([[-3-I,1,2+I,7-9*I],`,
`              [-2,1,1,5-I],`,
`              [-2-2*I,1,2+2*I,4-2*I],`,
`              [2,0,-1,-2+8*I]]);`,
`                        [  - 3 - I   1   2 + I    7 - 9 I  ]`,
`                        [                                  ]`,
`                        [     -2     1     1       5 - I   ]`,
`                   A := [                                  ]`,
`                        [ - 2 - 2 I  1  2 + 2 I   4 - 2 I  ]`,
`                        [                                  ]`,
`                        [     2      0     -1    - 2 + 8 I ]`,
`   `,
`> jordan(A,{I});`,
`                               [1 + I, 0, 0, 0]`,
`   `,
`                               [0, 1 + I, 0, 0]`,
`   `,
`                                                       1/2`,
`                 [0, 0, - 2 + 7/2 I + 1/2 (- 41 - 76 I)   , 0]`,
`   `,
`                                                          1/2`,
`                 [0, 0, 0, - 2 + 7/2 I - 1/2 (- 41 - 76 I)   ]`,
`   `,
`> s:=sqrt(2):`,
`> A := array([[s,1-3*s],[3,1/s]]);`,
`                                [  1/2         1/2 ]`,
`                                [ 2     1 - 3 2    ]`,
`                           A := [                  ]`,
`                                [             1/2  ]`,
`                                [   3    1/2 2     ]`,
`   `,
`> jordan(A,{sqrt(2)});`,
`                         1/2                 1/2 1/2  1/2`,
`                   [3/4 2    + 1/4 (25 - 72 2   )    2   , 0]`,
`   `,
`                            1/2                 1/2 1/2  1/2`,
`                   [0, 3/4 2    - 1/4 (25 - 72 2   )    2   ]`,
`   `,
`> alias(a=RootOf(X^3-2*X+X-5)):`,
`> A := array([[1-a,2+a^2],[3+a-2*a^2,3]]);`,
`                              [                    2 ]`,
`                              [     1 - a     2 + a  ]`,
`                         A := [                      ]`,
`                              [            2         ]`,
`                              [ 3 + a - 2 a      3   ]`,
`   `,
`> jordan(A,{a});`,
`                                                    2 1/2`,
`                  [2 - 1/2 a + 1/2 (48 - 24 a - 11 a )   , 0]`,
`   `,
`                                                       2 1/2`,
`                  [0, 2 - 1/2 a - 1/2 (48 - 24 a - 11 a )   ]`,
`   `,
`> A := array([[-12752,-6285,-9457,-7065,-4939,-5865,-3769],`,
`              [13028,6430,9656,7213,5041,5984,3841],`,
`              [16425,8080,12192,9108,6370,7569,4871],`,
`              [-6065,-2979,-4508,-3364,-2354,-2801,-1803],`,
`              [2968,1424,2231,1664,1171,1404,919],`,
`              [-22762,-11189,-16902,-12627,-8833,-10498,-6760],`,
`              [23112,11400,17135,12799,8946,10622,6821]]);`,
`              [ -12752   -6285   -9457   -7065  -4939   -5865  -3769 ]`,
`              [                                                      ]`,
`              [  13028   6430    9656    7213    5041   5984    3841 ]`,
`              [                                                      ]`,
`              [  16425   8080    12192   9108    6370   7569    4871 ]`,
`              [                                                      ]`,
`         A := [  -6065   -2979   -4508   -3364  -2354   -2801  -1803 ]`,
`              [                                                      ]`,
`              [  2968    1424    2231    1664    1171   1404    919  ]`,
`              [                                                      ]`,
`              [ -22762  -11189  -16902  -12627  -8833  -10498  -6760 ]`,
`              [                                                      ]`,
`              [  23112   11400   17135   12799   8946   10622   6821 ]`,
`   `,
`> jordan(A);`,
`                             1/2`,
`                           [2   , 0, 0, 0, 0, 0, 0]`,
`   `,
`                                 1/2`,
`                          [0, - 2   , 0, 0, 0, 0, 0]`,
`   `,
`                       [0, 0, -1.804919732, 0, 0, 0, 0]`,
`   `,
`                       [0, 0, 0, -1.124910946, 0, 0, 0]`,
`   `,
`                [0, 0, 0, 0, .6203192706 + 1.035886564 I, 0, 0]`,
`   `,
`                [0, 0, 0, 0, 0, .6203192706 - 1.035886564 I, 0]`,
`   `,
`                        [0, 0, 0, 0, 0, 0, 1.689192137]`,
`   `,
`SEE ALSO: smithex, ismithex, frobenius, ratjordan, jordansymbolic,`,
`          Frobenius, Ratjordan, Jordansymbolic`
):



############################################################################
############################################################################
##
##          smithex
##
###########################################################################
###########################################################################
# The MapleV algorithm linalg[smith] has been extended such that
# smithex(A,x,'L','R') returns the smith normal form S of A and
# L and R are unimodular matrices such that A = L*S*R.
# Most changes and additions are between signs '#++++++++++' and '#----------'.
# Authors of adaptation: T.M.L. Mulders, A.H.M. Levelt
#                        Mathematics Department
#                        University of Nijmegen
# E-mail: mulders@sci.kun.nl, ahml@sci.kun.nl
#
# January 1993

smithex := proc(B,x,L,R)
local a,b,g,i,j,k,l,m,n,q,r,s,t,lc,tb,temp,A,localB,Left,Right,isClear;


        option `Copyright 1990 by the University of Waterloo`;
        if not type(x,name) then ERROR(`2nd argument must be a name`) fi;
        if not type(B,'matrix') then localB:=evalm(B) else localB:=B fi;
        if not type(localB,'matrix(polynom(anything,x))') then
            ERROR(`matrix entries must be univariate polynomials in`,x) fi;
        if not type(localB,'matrix(polynom(ratpoly(rational),x))') then
            ERROR(`not implemented`) fi;
#++++++++++
        if nargs=4 and not (type(L,name) and type(R,name)) then
            ERROR(`3rd and 4th argument must be names`) fi;
#----------

        n := linalg[rowdim](localB);
        m := linalg[coldim](localB);
        A := array(1..n,1..m);
 
#++++++++++
        Left := Id(n);
        Right := Id(m);
#----------

        userinfo(1,smithex,`dimension`,n,` by`,m);
        for i to n do for j to m do A[i,j] := collect(localB[i,j],x,normal) 
        od od;

        for k to min(n,m) do

            #  Pivot selection from row k and column k
            for i from k to n while A[i,k] = 0 do od;
            for j from k to m while A[k,j] = 0 do od;
            if i > n and j > m then next fi;

            #  Select the smallest non-zero entry as the pivot
            for l from i+1 to n do
                if A[l,k] = 0 then next fi;
                if degree(A[l,k],x) < degree(A[i,k],x) then i := l fi
            od;
            for l from j+1 to m do
                if A[k,l] = 0 then next fi;
                if degree(A[k,l],x) < degree(A[k,j],x) then j := l fi
            od;

            if i <= n and (j > m or
                degree(A[i,k],x) < degree(A[k,j],x)) then
                    #  Pivot is A[i,k], interchange row k,i if necessary
                    if i <> k then
                        for l from k to m do
                            t := A[i,l]; A[i,l] := A[k,l]; A[k,l] := t
                        od;
#++++++++++
                        for l  to n do
                            t := Left[l,i]; Left[l,i] := Left[l,k]; Left[l,k] := t
                        od
#----------
                    fi
            else    #  Pivot is A[k,j], interchange column k,j if necessary
                    if j <> k then
                        for l from k to n do
                            t := A[l,j]; A[l,j] := A[l,k]; A[l,k] := t
                        od;
#++++++++++
                        for l to m do
                            t := Right[j,l]; Right[j,l] := Right[k,l]; Right[k,l] := t
                        od
#----------  
                    fi
            fi;

userinfo(2,smithex,`elimination at row`,k);
          isClear := false;
          while not isClear do

            #  0 out column k from k+1 to n
            for i from k+1 to n do
                if A[i,k] = 0 then next fi;
                g := gcdex(A[k,k], A[i,k], x, 's', 't');
                a := quo(A[k,k],g,x); b := quo(A[i,k],g,x);
                #
                #  We have  s A[k,k]/g + t A[i,k]/g = 1
                #
                #       [  s  t ]  [ A[k,k]  A[k,j] ]   [ g  ... ]
                #       [       ]  [                ] = [        ]
                #       [ -b  a ]  [ A[i,k]  A[i,j] ]   [ 0  ... ]
                #
                #       for j = k+1..m  where note  s a + t b = 1
                #
                for j from k+1 to m do
                    temp := normal( s*A[k,j] + t*A[i,j] );
                    A[i,j] := normal( a*A[i,j] - b*A[k,j] );
                    A[k,j] := temp
                od;
#++++++++++
                for j to n do
                    temp := normal(a*Left[j,k] + b*Left[j,i]);
                    Left[j,i] := normal(-t*Left[j,k] + s*Left[j,i]);
                    Left[j,k] := temp
                od;
#----------
                A[k,k] := g;
                A[i,k] := 0
            od;
            isClear := true;

            #  0 out row k from k+1 to m
#++++++++++
            for i from k+1 to m do 
                A[k,i] := rem(A[k,i],A[k,k],x,'q'); 
                for j to m do Right[k,j] := normal(Right[k,j] + q* Right[i,j]) od
            od;
#----------
            for i from k+1 to m do
                if A[k,i] = 0 then next fi;
                g := gcdex(A[k,k], A[k,i], x, 's', 't');
                a := quo(A[k,k],g,x); b := quo(A[k,i],g,x);
                for j from k+1 to n do
                    temp := normal( s*A[j,k] + t*A[j,i] );
                    A[j,i] := normal( a*A[j,i] - b*A[j,k] );
                    A[j,k] := temp
                od;
#++++++++++
                for j to m do
                    temp := normal( a*Right[k,j] + b*Right[i,j]);
                    Right[i,j] := normal(-t*Right[k,j] + s*Right[i,j]);
                    Right[k,j] := temp
                od;
#----------
                A[k,k] := g;
                A[k,i] := 0;
                isClear := false;
            od;

          od;

        od;
        r := 0;
        #  At this point, A is diagonal: some A[i,i] may be zero
        #  Move non-zero's up also making all entries unit normal
        for i to min(n,m) do
            if A[i,i] <> 0 then
                r := r+1;
#++++++++++
                lc := lcoeff(A[i,i],x);
                A[r,r] := normal(A[i,i]/lc);
                if i=r then 
                    for j to m do Right[i,j] := normal(Right[i,j]*lc) od
                else
                    A[i,i] := 0;
                    for j to n do 
                        temp := Left[j,r];
                        Left[j,r] := Left[j,i];
                        Left[j,i] := temp
                    od;
                    for j to m do
                        temp := normal(Right[i,j]*lc);
                        Right[i,j] := normal(Right[r,j]/lc);
                        Right[r,j] := temp
                    od
                fi
#----------
            fi
        od;
#  Now make A[i,i] | A[i+1,i+1] for 1 <= i < r
        for i to r-1 do
            for j from i+1 to r while A[i,i] <> 1 do
#++++++++++
                g := gcdex(A[i,i],A[j,j],x,'s','t');
                a := quo(A[i,i],g,x); b:= quo(A[j,j],g,x);
                A[i,i] := g;
                A[j,j] := normal( a*A[j,j] );
                for k to n do
                  temp := normal(a*Left[k,i] + b*Left[k,j]);
                  Left[k,j] := normal(-t*Left[k,i] + s*Left[k,j]);
                  Left[k,i] := temp
                od;
                for k to m do
                  tb := normal(t*b);
                  temp := normal((1-tb)*Right[i,k] + tb*Right[j,k]);
                  Right[j,k] := normal(-Right[i,k] + Right[j,k]);
                  Right[i,k] := temp
                od
#----------
            od
        od;

#++++++++++
        if nargs>2 then L := eval(Left) fi;
        if nargs>3 then R := eval(Right) fi;
#----------

        subs('localB'=localB,op(A));
        if has(",'localB') then ERROR(`undefined matrix elements`)
        else " fi;

end:


`help/text/smithex` := TEXT(
`FUNCTION: smithex - Compute the Smith normal form S of a matrix`,
`   `,
`CALLING SEQUENCE:`,
`   smithex(A, x, 'L', 'R')`,
`   `,
`PARAMETERS:`,
`   A        - a rectangular matrix of univariate polynomials in x`,
`   x        - the variable name`,
`   'L', 'R' - assigned unimodular matrices such that L*S*R=A`,
`   `,
`SYNOPSIS:`,
`- The Smith normal form of an n by m matrix with univariate polynomial entries`,
`  in x over a field F is computed.  That is, the polynomials are then regarded`,
`  as elements of the Euclidean domain F[x].`,
`   `,
`- This routine is only as powerful as Maple's normal function, i.e. at`,
`  present it only understands the field Q of rational numbers and rational`,
`  functions over Q.`,
`   `,
`- The Smith normal form is a diagonal matrix S where:`,
`    - rank(A) = number of nonzero rows (columns) of S`,
`    - S[i,i] is a monic polynomial for 0 < i <= rank(A)`,
`    - S[i,i] divides S[i+1,i+1] for 0 < i < rank(A)`,
`    - S[i,i] is the greatest common divisor of all i by i minors of A`,
`  Hence if n = m and rank(A) = n then product(S[i,i],i=1..n)=`,
`  det(A)/lcoeff(det(A),x).`,
`   `,
`EXAMPLES:`,
`> A := array([[3*x,x^2+x],[0,x^2]]);`,
`                                   [       2     ]`,
`                                   [ 3 x  x  + x ]`,
`                              A := [             ]`,
`                                   [         2   ]`,
`                                   [  0     x    ]`,
`   `,
`> smithex(A,x,'L','R');`,
`                                   [ x   0 ]`,
`                                   [       ]`,
`                                   [     2 ]`,
`                                   [ 0  x  ]`,
`   `,
`> op(L);op(R);`,
`                                    [ 1  0 ]`,
`                                    [      ]`,
`                                    [ x  1 ]`,
`   `,
`                                 [  3  x + 1 ]`,
`                                 [           ]`,
`                                 [ -3   - x  ]`,
`   `,
`> A := array([[y^2*x,x^2-(1+y)*x],[x,x^2*(y-2)]]);`,
`                              [  2     2             ]`,
`                              [ y  x  x  - (1 + y) x ]`,
`                         A := [                      ]`,
`                              [          2           ]`,
`                              [   x     x  (y - 2)   ]`,
`   `,
`> smithex(A,x,'L','R');`,
`                      [ x                0               ]`,
`                      [                                  ]`,
`                      [        3        2                ]`,
`                      [    x (y  x - 2 y  x - x + 1 + y) ]`,
`                      [ 0  ----------------------------- ]`,
`                      [             3      2             ]`,
`                      [            y  - 2 y  - 1         ]`,
`   `,
`> op(L);op(R);`,
`             [      5      4    2            3        2           ]`,
`             [   - y  + 2 y  + y  + 1 + y + y  x - 2 y  x - x     ]`,
`             [ - --------------------------------------------  -1 ]`,
`             [                    3      2                        ]`,
`             [                   y  - 2 y  - 1                    ]`,
`             [                                                    ]`,
`             [                        1                         0 ]`,
`   `,
`                      [  1           x (y - 2)          ]`,
`                      [                                 ]`,
`                      [                    3      2     ]`,
`                      [ -1  - x y + 2 x + y  - 2 y  - 1 ]`,
`   `,
`SEE ALSO:  ismithex, Smith`
):



############################################################################
############################################################################
##
##          ismithex
##
###########################################################################
###########################################################################
# The MapleV algorithm linalg[ismith] has been extended such that
# ismithex(A,'L','R') returns the smith normal form S of A and
# L and R are unimodular matrices such that A = L*S*R.
# Most changes and additions are between signs '#++++++++++' and '#------!
# Authors of adaptation: T.M.L. Mulders, A.H.M. Levelt
#                        Mathematics Department
#                        University of Nijmegen
# E-mail: mulders@sci.kun.nl, ahml@sci.kun.nl
#
# January 1993


ismithex := proc(BB,L,R)
local B,a,b,g,i,j,k,l,m,n,q,s,t,tb,temp,A,Left,Right,isClear,sgn;

        option `Copyright 1990 by the University of Waterloo`;
        if not type(BB,'matrix') then B:=evalm(BB) else B:=BB fi;
        if not type(B, 'matrix') then ERROR(`invalid arguments`) fi;
#++++++++++
        if nargs=3 and not (type(L,name) and type(R,name)) then
            ERROR(`2nd and 3rd argument must be names`) fi;
#----------
      
        n := linalg[rowdim](B);
        m := linalg[coldim](B);
userinfo(1,ismithex,`dimension`,n,'`by`',m);
        A := array(1..n,1..m);

#++++++++++
        Left := Id(n);
        Right := Id(m);
#----------

        for i to n do
            for j to m do
                if type(B[i,j],integer) then A[i,j] := B[i,j]
                else ERROR(`matrix entries must be integers`)
                fi
            od
        od;

        for k to min(n,m) do

            #  Pivot selection from row k and column k
            for i from k to n while A[i,k] = 0 do od;
            for j from k to m while A[k,j] = 0 do od;
            if i > n and j > m then next fi;

            #  Select the smallest non-zero entry as the pivot
            for l from i+1 to n do
                if A[l,k] = 0 then next fi;
                if abs(A[l,k]) < abs(A[i,k]) then i := l fi
            od;
            for l from j+1 to m do
                if A[k,l] = 0 then next fi;
                if abs(A[k,l]) < abs(A[k,j]) then j := l fi
            od;

            if i <= n and (j > m or abs(A[i,k]) < abs(A[k,j])) then
                    #  Pivot is A[i,k], interchange row k,i if necessary
                    if i <> k then
                        for l from k to m do
                            t := A[i,l]; A[i,l] := A[k,l]; A[k,l] := t
                        od;
#++++++++++
                        for l  to n do
                            t := Left[l,i]; Left[l,i] := Left[l,k]; Left[l,k] := t
                        od
#----------

                    fi
            else    #  Pivot is A[k,j], interchange column k,j if necessary
                    if j <> k then
                        for l from k to n do
                            t := A[l,j]; A[l,j] := A[l,k]; A[l,k] := t
                        od;
#++++++++++
                        for l to m do
                            t := Right[j,l]; Right[j,l] := Right[k,l]; Right[k,l] := t
                        od
#----------

                    fi
            fi;

userinfo(2,ismithex,`elimination at row`,k);

          isClear := false;
          while not isClear do

            #  Zero out column k from k+1 to n
            for i from k+1 to n do
                if A[i,k] = 0 then next fi;
                g := igcdex(A[k,k], A[i,k], 's', 't');
                a := iquo(A[k,k],g); b := iquo(A[i,k],g);
                #
                #  We have  s A[k,k]/g + t A[i,k]/g = 1
                #
                #       [  s  t ]  [ A[k,k]  A[k,j] ]   [ g  ... ]
                #       [       ]  [                ] = [        ]
                #       [ -b  a ]  [ A[i,k]  A[i,j] ]   [ 0  ... ]
                #
                #       for j = k+1..m  where note  s a + t b = 1
                #
                for j from k+1 to m do
                    temp := s*A[k,j] + t*A[i,j];
                    A[i,j] := a*A[i,j] - b*A[k,j];
                    A[k,j] := temp
                od;
#++++++++++
                for j to n do
                    temp := a*Left[j,k] + b*Left[j,i];
                    Left[j,i] := -t*Left[j,k] + s*Left[j,i];
                    Left[j,k] := temp
                od;
#----------
                A[k,k] := g;
                A[i,k] := 0
            od;
            isClear := true;

            #  Zero out row k from k+1 to m
#++++++++++
            for i from k+1 to m do
                A[k,i] := irem(A[k,i],A[k,k],'q');
                for j to m do Right[k,j] := Right[k,j] + q*Right[i,j] od
            od;
#----------
            for i from k+1 to m do
                if A[k,i] = 0 then next fi;
                g := igcdex(A[k,k], A[k,i], 's', 't');
                a := iquo(A[k,k],g); b := iquo(A[k,i],g);
                for j from k+1 to n do
                    temp := s*A[j,k] + t*A[j,i];
                    A[j,i] := a*A[j,i] - b*A[j,k];
                    A[j,k] := temp
                od;
#++++++++++
                for j to m do
                    temp:= a*Right[k,j] + b*Right[i,j];
                    Right[i,j] := -t*Right[k,j] + s*Right[i,j];
                    Right[k,j] := temp
                od;
#----------
                A[k,k] := g;
                A[k,i] := 0;
                isClear := false;
            od;

          od;

        od;


        l := 0;
        #  At this point, A is diagonal: some A[i,i] may be zero
        #  Move non-zero's up also making all entries unit normal
        for i to min(n,m) do
            if A[i,i] <> 0 then
                l := l+1;
#++++++++++
                sgn := sign(A[i,i]);
                A[l,l] := sgn*A[i,i];
                if i=l then
                    for j to m do Right[i,j] := sgn*Right[i,j] od
                else
                    A[i,i] := 0;
                    for j to n do
                        temp := Left[j,l];
                        Left[j,l] := Left[j,i];
                        Left[j,i] := temp
                    od;
                    for j to m do
                        temp := sgn*Right[i,j];
                        Right[i,j] := sgn*Right[l,j];
                        Right[l,j] := temp
                    od
                fi
#----------
            fi
        od;
        
        #  Now make A[i,i] | A[i+1,i+1] for 1 <= i < l
        for i to l-1 do
            for j from i+1 to l while A[i,i] <> 1 do
#++++++++++
                g := igcdex(A[i,i],A[j,j],'s','t');
                a := iquo(A[i,i],g); b:= iquo(A[j,j],g);
                A[i,i] := g;
                A[j,j] := a*A[j,j];
                for k to n do
                  temp := a*Left[k,i] + b*Left[k,j];
                  Left[k,j] := -t*Left[k,i] + s*Left[k,j];
                  Left[k,i] := temp
                od;
                for k to m do
                  tb := t*b;
                  temp := (1-tb)*Right[i,k] + tb*Right[j,k];
                  Right[j,k] := -Right[i,k] + Right[j,k];
                  Right[i,k] := temp
                od
#----------
            od
        od;

#++++++++++
        if nargs>1 then L := eval(Left) fi;
        if nargs>2 then R := eval(Right) fi;
#----------

        op(A)

end:


`help/text/ismithex` := TEXT(
`FUNCTION: ismithex - integer-only Smith normal form S of a matrix`,
`   `,
`CALLING SEQUENCE:`,
`   ismithex(A, 'L', 'R')`,
`   `,
`PARAMETERS:`,
`   A        - a rectangular matrix of integers`,
`   'L', 'R' - assigned unimodular matrices such that L*S*R=A`,
`   `,
`SYNOPSIS:`,
`- The function ismithex computes the Smith normal form S of an n by m`,
`  rectangular matrix of integers.`,
`   `,
`- If two n by m matrices have the same Smith normal form, they are`,
`  equivalent.`,
`   `,
`- The Smith normal form is a diagonal matrix S where:`,
`    - rank(A) = number of nonzero rows (columns) of S`,
`    - sign(S[i,i]) = 1  for 0 < i <= rank(A)`,
`    - S[i,i] divides S[i+1,i+1] for 0 < i < rank(A)`,
`    - S[i,i] is the greatest common divisor of all i by i minors of A`,
`  Hence if n = m and rank(A) = n then abs(det(A)) = product(S[i,i],i=1..n).`,
`   `,
`- The Smith normal form is obtained by doing elementary row and column opera-`,
`  tions. This includes interchanging rows (columns), multiplying through a`,
`  row (column) by -1, and adding integral multiples of one row (column) to`,
`  another.`,
`   `,
`- Although the rank and determinant can be easily obtained from S this is not`,
`  an efficient method for computing these quantities except that this may`,
`  yield a partial factorization of det(A) without doing any explicit`,
`  factorizations.`,
`   `,
`EXAMPLES:`,
`> A := array( [[9,-36,30], [-36,192,-180], [30,-180,180]] );`,
`                                 [  9    -36   30  ]`,
`                                 [                 ]`,
`                            A := [ -36   192  -180 ]`,
`                                 [                 ]`,
`                                 [  30  -180   180 ]`,
`   `,
`> ismithex(A,'L','R');`,
`                                 [ 3   0   0 ]`,
`                                 [           ]`,
`                                 [ 0  12   0 ]`,
`                                 [           ]`,
`                                 [ 0   0  60 ]`,
`   `,
`> op(L);op(R);`,
`                               [ -17   -5   -4 ]`,
`                               [               ]`,
`                               [  64   19   15 ]`,
`                               [               ]`,
`                               [ -50  -15  -12 ]`,
`   `,
`                                [  1  -24   30 ]`,
`                                [              ]`,
`                                [ -1   25  -30 ]`,
`                                [              ]`,
`                                [  0   -1   1  ]`,
`SEE ALSO:  smithex`
):

#save `normform.m`;
#quit
