

#
#--> eigenplot3d(A,...) : display the eigenvectors of a 3 by 3 matrix geometrically
#
# A must be a 3 by 3 matrix (or Matrix) of real constants.
# This routine generates a 3-dimensional graph of the eigenvectors
# and displays in text the numerical values of the eigenvalues and eigenvectors of A.
#
#
# The 3-D graph is constructed as follows.
# We graph the unit sphere.  We color the unit sphere as follows.
# If (x,y,z) is a point on the unit sphere we use COLOR(RGB,abs(x),abs(y),abs(z)).
# Next we construct n (default 80) unit vectors u[1], ..., u[n], which are
# roughly equally spaced on the surface of the unit sphere.
# For each u[i] we draw the vector v[i] = A.u[i] with it's tail at u[i] i.e.
# on the unit sphere.  Thus if v[i] is near an eigenvector, it will be
# perpendicular to the surface of the unit sphere.  Moreover, if it's eigenvalue
# is +ve, it will stick out from the sphere, if -ve, it will not be visible
# as it sticks into the unit sphere.  Note, the default rendering of the
# unit sphere, if changed, for example to hidden line, will enable you to
# see such a vector going inside the unit sphere.
#
# numvectors=200 controls the approximate number of vectors.
#                  The default is numvectors=80.
# quality=rough reduces the quality of the arrows and sphere.
#     This is useful when you want smooth rotation on a slower computer.
#
# Next we compute the real eigenvectors and draw them in black.
# If v is an eigenvector, and u = v/||v||, with lambda its eigenvalue, then 
# if lambda > 0 then we draw the vector 1.2 v with tail at u else we draw
# the vector -v with tail at u-v, i.e. pointing to the unit sphere.
#
# The region option.
# In order to see what is happening in the postive octant (x>0,y>0,z>0)
# the option region = posoct may be specified.  This is useful when the
# values of x,y,z are known to be non-negative, e.g. if they represent
# populations.  Other options are
# region = tophalf (y>0), region = bottomhalf (y<0),
# region = righthalf (x>0), region = lefthalf (x<0),
# region = fronthalf (z>0), region = backhalf (z<0)
# are useful for looking at the vectors v[i] directed inside the unit sphere.
# 
# Also, we display A, the numerical values for the eigenvalues and eigenvectors
# in text like this
#
#    [  1 3/2   2]  lambda=4.34  v=<1.12,1,1.12>  
#    [3/2   1 3/2]  lambda=-.34  v=<-.450,1,-.450>
#    [  2 3/2   1]  lambda=-1    v=<-1,0,1>       
#
# where there is some attempt to display exact values exactly.
# If the input matrix is purely numerical then we would get e.g.
#
#   [   0 1.2   2]  lambda=1.47          v=<.843,.341,.416>                
#   [.597   0   0]  lambda=-.332+.390*I  v=<-.376+.442*I,.676,-.430-.147*I>
#   [   0 .81 .81]  lambda=-.332-.390*I  v=<-.376-.442*I,.676,-.430+.147*I>
#
# The number of digits displayed is controled by the digits option.  For example
# at digits=8 we get
# 
#   [0 1 1]  lambda=1+3^(1/2)  v=<1,3^(1/2),1> 
#   [0 1 3]  lambda=1-3^(1/2)  v=<1,-3^(1/2),1>
#   [0 1 1]  lambda=0          v=<1,0,0>       
#
# The display of this information, the matrix and the eigenvalues/eigenvectors
# may be turned off by eigeninfo=false and matrixinfo=false.
#
# Summary of options
#
#   digits = posint (3) number of decimal places for output of numerical data
#   eigeninfo = boolean (true) display numerical values of eigenvalues/eigenvectors in title
#   matrixinfo = boolean (true) display numerical values of matrix in title
# # info = boolean (true) display all of the above (for turning it all off)
#   eigenvectors = boolean (true) draw eigenvectors
#   eigencolor = color (black) color of the eigenvectors
#   numvectors = posint (80) show this many (approx) vectors
#   region = value (unitsphere) which region to show
#   arrowthickness = positive (0.5 = thin) thickness of arrows
#   quality = {smooth,rough} (smooth) quality of arrows and sphere
#   scaled = boolean (true) use a sqrt scaling on the magnitude of the vectors to me
#            small vectors bigger (more visible) and big vectors smaller.
# 
#
# Author : Michael Monagan, October-December 2001.
# 


macro( p1=[.5103400268, -.5030862103e-1, .8584999129],
       p2=[.5156867860, .8156798049, .2621709263],
       p3=[-.3614720512, .5303137929, .7668801974],
       p4=[-.4150300790, .8821784028, -.2225113441],
       p5=[-.9955914700, .5728838842e-1, .7426752587e-1],
       p6=[-.4236813157, -.5190202926, .7423692334],
       p7=[-.5156867860, -.8156798049, -.2621709263],
       p8=[.4150300790, -.8821784028, .2225113441],
       p9=[.9955914700, -.5728838842e-1, -.7426752587e-1],
      p10=[.4236813157, .5190202926, -.7423692334],
      p11=[-.5103400268, .5030862103e-1, -.8584999129],
      p12=[.3614720512, -.5303137929, -.7668801974] ):

# These 12 points represent the 20 faces of an icosahedron.
# The centriods of these faces are 20 points equally spaced on the unit sphere.
# To get more points on the unit sphere, we subdivide each face into four
# equilateral triangles, take the centroid of each, and make it a unit vector.
# Doing this once gives us 80 points approximately equally spaced.

ICOSAHEDRON_FACES :=
         [[p12, p11, p7], [p12, p10, p11], [p12, p9, p10], [p12, p8, p9],
          [p12, p7, p8], [p11, p10, p4], [p11, p5, p7], [p11, p4, p5],
          [p10, p9, p2], [p10, p2, p4], [p9, p8, p1], [p9, p1, p2],
          [p8, p7, p6], [p8, p6, p1], [p7, p5, p6], [p3, p1, p6],
          [p3, p6, p5], [p3, p5, p4], [p3, p4, p2], [p3, p2, p1]]:

macro( p1=p1, p2=p2, p3=p3, p4=p4, p5=p5, p6=p6,
       p7=p7, p8=p8, p9=p9, p10=p10, p11=p11, p12=p12 ):



#--> eigenplot3d(A)
eigenplot3d := proc(AA::{matrix,Matrix}) 
local A,D,E,F,G,S,M,u,t,a,b,c,d,e,f,i,opts,q,
      arrowoptions,sphereoptions,se,sc,dm,ec,nv,n,s,domain,
      H,V,vp,lambda,v,objects,l,T,tf,ei,mi,
      inrange,centroid,subdivide,fix,NORM,VECTOR,
      basisinfo,matrixinfo,realfix,realeigen;

   if not assigned(vectorplot3d) then 
   error "vectorplot3d undefined: please read the file vecplot3d" fi;

   if type(AA,matrix) then A := Matrix(AA) else A := AA fi;
   A := evalf(A);
   if not type(A,'Matrix'(3,3,float)) then error "3 by 3 matrix of real constants expected" fi;

# Subroutines
centroid := proc(f) local v; v := f[1]+f[2]+f[3]; v/NORM(v) end;
subdivide := proc(f::list([float,float,float])) local p,q,r;
    (p,q,r) := (f[1]+f[2])/2,(f[2]+f[3])/2,(f[3]+f[1])/2;
    (p,q,r) := (p/NORM(p),q/NORM(q),r/NORM(r));
    [f[1],p,r], [f[2],q,p], [f[3],r,q], [p,q,r];
end;
inrange := proc(x,r)
   if type(x,numeric) then x>=op([1,1],r) and x<=op(2,r)
   else inrange(x[1],r[1]) and inrange(x[2],r[2]) and inrange(x[3],r[3])
   fi
end:
fix := proc(x,d) if length(sprintf("%a",x))<=d+1 then x else evalf(x,d) fi; end;
# Utilities for efficiency
NORM := proc(v) (v[1]^2+v[2]^2+v[3]^2)^(1/2) end;
VECTOR := proc(u) rtable(1..3,u,'subtype'=Vector['column']) end;
macro(realeigen=`LAplots/realeigen`):
realeigen := proc(A) local n,E,V,fix,re,rv,i,j,realfix,L,m;
use LinearAlgebra in
   if nargs=1 then n := RowDimension(A); E,V := Eigenvectors(evalf(A));
   else E,V := args[1],args[2]; n := RowDimension(V); fi;
   #issame := proc(x,y) evalb( abs(x-y) <= abs(x)*10^(1-Digits) ); end; 
   realfix := proc(x)
         if type(x,float) then x
         elif type(x,complex(float)) then if fnormal(Im(x))=0.0 then Re(x) else x fi
         else error "should not happen";
         fi
   end;
   E := map(realfix,E);
   V := map(realfix,V);
   re := NULL;
   rv := NULL;
   for i to n do
       if Im(E[i])=0.0 and {seq(Im(V[j,i]),j=1..n)} = {0.0} then
          re := re,E[i];
          rv := rv,map(Re,Column(V,i));
       fi;
   od;
   # sort real eigenvalues from smallest to largest
   re,rv := [re],[rv];
   m := nops(re);
   L :=  seq([re[i],rv[i]],i=1..m);
   L := sort([L],proc(u,v) evalb(u[1]<v[1]) end);
   re := seq(L[i][1],i=1..m);
   rv := seq(L[i][2],i=1..m);
   [re],[rv];
end use;
end:
basisinfo := proc(B,n,d) local fix,A,v,lineformat,line,i;
      if not type(B,set) then return basisinfo({B},n,d) fi;
      fix := proc(x) if length(sprintf("%a",x))<=d+1 then x else evalf(x,d) fi; end;
      A := {seq(map(fix,v),v=B)};
      lineformat := cat("<","%a,"$(n-1),"%a>");
      line := proc(v) local i; sprintf(lineformat,seq(v[i],i=1..n)) end;
      if nops(A)=1 then return line(A[1]) fi;
      cat( "{", line(A[1]), seq( cat(",",line(A[i])), i=2..nops(A) ), "}" );
end:
matrixinfo := proc(A,m,n,d) local i,j,fix,l,B,line;
      fix := proc(x) if length(sprintf("%a",x))<=d+3 then x else evalf(x,d) fi; end;
      B := map(fix,A);
      l := [seq( max(seq( length(sprintf("%a",B[i,j])), i=1..m )), j=1..n )];
      line := sprintf(cat("[","%%%da"$n,"]"),l[1],seq(l[i]+1,i=2..n));
      [seq( sprintf(line,seq(B[i,j],j=1..n) ), i=1..m )];
end:
realfix := proc(x)
   if type(x,float) then x
   elif type(x,complex(float)) then if fnormal(Im(x))=0.0 then Re(x) else x fi
   else x;
   fi
end:

   opts := [args[2..nargs]];
   if hasoption(opts,'digits'=posint,'D','opts') then else D := 3 fi;

   mi := true; ei := true;
   #if hasoption(opts,'info'=boolean,'ei','opts') then mi := ei; fi;
   hasoption(opts,'matrixinfo'=boolean,'mi','opts');
   hasoption(opts,'eigeninfo'=boolean,'ei','opts');

   # Include matrix in title
   if mi then M := matrixinfo(AA,3,3,D) else M := ["","",""] fi;

if hasoption(opts,'thickness','a','opts') or 
   hasoption(opts,'arrowthickness','a','opts') then 
   arrowoptions := 'thickness'=a else arrowoptions := 'thickness'='thin' fi;

if hasoption(opts,'quality','q','opts') and q='rough' then
     arrowoptions := arrowoptions, 'arrowstyle'='rough';
     sphereoptions := 'grid'=[15,15], 'contours'=15, 'thickness'=1;
else sphereoptions := 'grid'=[25,25], 'contours'=25, 'thickness'=1;
fi;

if hasoption(opts,'eigenvectors'=boolean,'se','opts') then else se := true fi;
if hasoption(opts,'scaled'=boolean,'sc','opts') then else sc := true fi;

if hasoption(opts,'eigencolour','ec','opts') or
   hasoption(opts,'eigencolor','ec','opts') then else ec := 'black'; fi;
if type(ec,list) then ec := map(`plot/color`,ec) else ec := [`plot/color`(ec)$3] fi;

if hasoption(opts,'region','dm','opts') then else dm := 'unitsphere' fi;
if not member(dm,{'posoct','unitsphere','righthalf','lefthalf',
                  'fronthalf','backhalf','tophalf','bottomhalf'}) then error "invalid style" fi;
if dm='posoct' then dm := [0..1,0..1,0..1];
elif dm='unitsphere' then dm := [-1..1,-1..1,-1..1];
elif dm='righthalf' then dm := [0..1,-1..1,-1..1];
elif dm='fronthalf' then dm := [-1..1,-1..1,0..1];
elif dm='backhalf' then dm := [-1..1,-1..1,-1..0];
elif dm='tophalf' then dm := [-1..1,0..1,-1..1];
elif dm='bottomhalf' then dm := [-1..1,-1..0,-1..1];
else dm := [-1..0,-1..1,-1..1];
fi;

if hasoption(opts,'numvectors','nv','opts') then 
else if dm=[0..1,0..1,0..1] then nv := 50; else nv := 100; fi; fi;
if not type(nv,posint) then error "numvectors must be a positive integer"; fi;

F := ICOSAHEDRON_FACES;
do # repeat
   E := map(centroid,F);
   if dm<>[-1..1,-1..1,-1..1] then E := select(inrange,E,dm) fi;
   if nops(E) >= iquo(nv,2) then break fi;
   F := map(subdivide,F);
od;

n := nops(E);
G := [seq( mvMultiply(A,v), v=map(VECTOR,E) )];
G := [seq( [v[1],v[2],v[3]], v=G )]; # use lists for speed
if sc then G := [seq(v/sqrt(NORM(v)),v=G)] fi; # SCALE

S := G+E; # zip(`+`,G,E);
s := seq(S[i][1],i=1..n); (a,b) := (min(-1,s),max(1,s));
s := seq(S[i][2],i=1..n); (c,d) := (min(-1,s),max(1,s));
s := seq(S[i][3],i=1..n); (e,f) := (min(-1,s),max(1,s));
domain := [a..b,c..d,e..f];

H := zip( proc(u,v) vectorplot3d(u,v, 'view'=domain, arrowoptions,
       'color'=COLOR(RGB,abs(u[1]),abs(u[2]),abs(u[3]))) end, E, G ):

# Strip off VIEW from all vectors - just keep the POLYGONS objects
H := map( proc(v) select(type,v,specfunc(anything,POLYGONS)) end, H );

if dm=[0..1,0..1,0..1] then
   S := plot3d( [cos(t)*sin(u),sin(t)*sin(u),cos(u)], t=0..Pi/2, u=0..Pi/2, sphereoptions );
elif dm=[0..1,-1..1,-1..1] then
   S := plot3d( [cos(t)*sin(u),sin(t)*sin(u),cos(u)], t=-Pi/2..Pi/2, u=0..Pi, sphereoptions );
elif dm=[-1..0,-1..1,-1..1] then
   S := plot3d( [cos(t)*sin(u),sin(t)*sin(u),cos(u)], t=Pi/2..3*Pi/2, u=0..Pi, sphereoptions );
elif dm=[-1..1,-1..1,-1..0] then
   S := plot3d( [cos(t)*sin(u),sin(t)*sin(u),cos(u)], t=-Pi..Pi, u=Pi/2..Pi, sphereoptions );
elif dm=[-1..1,-1..1,0..1] then
   S := plot3d( [cos(t)*sin(u),sin(t)*sin(u),cos(u)], t=-Pi..Pi, u=0..Pi/2, sphereoptions );
elif dm=[-1..1,0..1,-1..1] then
   S := plot3d( [cos(t)*sin(u),cos(u),sin(t)*sin(u)], t=-Pi..Pi, u=0..Pi/2, sphereoptions );
elif dm=[-1..1,-1..0,-1..1] then
   S := plot3d( [cos(t)*sin(u),cos(u),sin(t)*sin(u)], t=-Pi..Pi, u=Pi/2..Pi, sphereoptions );
else 
   S := plot3d( [cos(t)*sin(u),sin(t)*sin(u),cos(u)], t=-Pi..Pi, u=0..Pi, sphereoptions );
fi;

if ei then # generate text for eigenvalues and eigenvectors
   E,V := LinearAlgebra:-Eigenvectors(AA);
   for i to 3 do
       lambda := realfix(E[i]);
       M[i] := cat( M[i], "  lambda=", sprintf("%a",fix(lambda,D)) );
       if assigned(StringTools) then 
          M[i] := StringTools:-SubstituteAll(M[i],"*I","I")
       fi;
   od:
   l := max(length(M[1]),length(M[2]),length(M[3]));
   for i to 3 do
       v := map(realfix, LinearAlgebra:-Column(V,i));
       if member( [v[1],v[2],v[3]], [ [0,0,0], [0.0,0.0,0.0] ] ) then next fi; 
       M[i] := cat( M[i], " "$(l-length(M[i])), "  v=", basisinfo(v,3,D) );
       if assigned(StringTools) then 
          M[i] := StringTools:-SubstituteAll(M[i],"*I","I")
       fi;
   od;
fi;

if se then
   E,V := realeigen(A);
   vp := NULL;
   for i to nops(E) do
       lambda,v := E[i],V[i];
       u := v/NORM(v);
       s := abs(lambda);
       if sc then s := sqrt(s) fi;
       s := 1.1*s; # The 1.1 is to make the eigenvectors prominent
       v := s*v;
       if dm <> [-1..1,-1..1,-1..1] then
          v := signum(lambda)*v;
          if inrange(u,dm) then
       vp := vp, vectorplot3d( u, v,'view'=domain,arrowoptions,'colour'=ec[i]); fi;
          if inrange(-u,dm) then
       vp := vp, vectorplot3d(-u,-v,'view'=domain,arrowoptions,'colour'=ec[i]); fi
       elif lambda<0.0 then
       vp := vp, vectorplot3d( u+v, -v,'view'=domain,arrowoptions,'colour'=ec[i]),
                 vectorplot3d(-(u+v),v,'view'=domain,arrowoptions,'colour'=ec[i]);
       else
       vp := vp, vectorplot3d( u, v,'view'=domain,arrowoptions,'colour'=ec[i]),
                 vectorplot3d(-u,-v,'view'=domain,arrowoptions,'colour'=ec[i]);
       fi;
   od;
   # Strip off VIEW from all eigenvectors
   V := map( proc(v) select(type,v,specfunc(anything,POLYGONS)) end, [vp] );
else V := [];
fi;

   if mi or ei then
      if hasoption(opts, 'title', 't', 'opts') then T := convert(t,string) else T := "" fi;
      if hasoption(opts, 'titlefont', 'tf', 'opts') then tf := `plot/font`(tf) 
      else tf := FONT('COURIER','DEFAULT',12); fi;
      d := max( length(M[1]),length(M[2]),length(M[3]) );
      for i to 3 do M[i] := cat(M[i]," "$(d-length(M[i]))) od;
      if T <> "" then T := cat(t,"\n") fi;
      T := cat(T, M[1],"\n",M[2],"\n",M[3]);
printf("%s\n",T);
      T := TITLE( T, tf );
   else
      T := NULL;
   fi;

# MBM: Commented out for now
T := NULL;


objects := [op(H),S,op(V)];
#plots[display3d]( objects, scaling=constrained, op(opts) );
PLOT3D( op(map(op,objects)), T, SCALING(CONSTRAINED), `plot3d/options3d`(op(opts)) );

end:

