# HG changeset patch
# User jwe
# Date 745102240 0
# Node ID 7806354a10d35116a56038e030b9c981b6ef239b
# Parent  6028dcac27efe55282cec599a67a9eff335fd3fd
[project @ 1993-08-11 20:48:00 by jwe]

diff -r 6028dcac27ef -r 7806354a10d3 src/Makefile.in
--- a/src/Makefile.in	Wed Aug 11 20:48:00 1993 +0000
+++ b/src/Makefile.in	Wed Aug 11 20:50:40 1993 +0000
@@ -52,11 +52,11 @@
 	fi
 
 INCLUDES = arith-ops.h builtins.h dynamic-ld.h defaults.h.in error.h \
-	f-balance.h f-colloc.h f-dassl.h f-det.h f-eig.h f-fft.h \
-	f-fsolve.h f-fsqp.h f-givens.h f-hess.h f-ifft.h f-inv.h \
-	f-lpsolve.h f-lsode.h f-lu.h f-npsol.h f-qpsol.h f-qr.h \
-	f-quad.h f-qzval.h f-rand.h f-schur.h f-svd.h f-syl.h \
-	file-io.h g-builtins.h gripes.h help.h \
+	f-balance.h f-colloc.h f-dassl.h f-det.h f-eig.h f-expm.h \
+	f-fft.h f-fsolve.h f-fsqp.h f-givens.h f-hess.h f-ifft.h \
+	f-inv.h f-lpsolve.h f-lsode.h f-lu.h f-npsol.h f-qpsol.h \
+	f-qr.h f-quad.h f-qzval.h f-rand.h f-schur.h f-svd.h \
+	f-syl.h file-io.h g-builtins.h gripes.h help.h \
 	idx-vector.h input.h lex.h mappers.h missing-math.h octave.h \
 	octave-hist.h pager.h parse.h pr-output.h procstream.h \
 	sighandlers.h statdefs.h symtab.h sysdep.h t-builtins.h \
@@ -64,15 +64,15 @@
 	utils.h variables.h version.h xdiv.h xpow.h SLStack.h Stack.h
 
 SOURCES = arith-ops.cc builtins.cc dynamic-ld.cc error.cc \
-	f-colloc.cc f-balance.cc f-dassl.cc f-det.cc \
-	f-eig.cc tc-extras.cc f-fft.cc f-fsolve.cc f-fsqp.cc \
-	f-givens.cc f-hess.cc f-ifft.cc f-inv.cc f-lpsolve.cc \
-	f-lsode.cc f-lu.cc f-npsol.cc f-qpsol.cc f-qr.cc f-quad.cc \
-	f-qzval.cc f-rand.cc f-schur.cc f-svd.cc f-syl.cc file-io.cc \
-	g-builtins.cc gripes.cc help.cc idx-vector.cc input.cc lex.l \
-	mappers.cc octave.cc octave-hist.cc pager.cc parse.y \
-	pr-output.cc procstream.cc sighandlers.cc symtab.cc \
-	sysdep.cc t-builtins.cc tc-assign.cc tc-index.cc \
+	f-colloc.cc f-balance.cc f-dassl.cc f-det.cc f-eig.cc \
+	f-expm.cc f-fft.cc f-fsolve.cc f-fsqp.cc f-givens.cc \
+	f-hess.cc f-ifft.cc f-inv.cc f-lpsolve.cc f-lsode.cc f-lu.cc \
+	f-npsol.cc f-qpsol.cc f-qr.cc f-quad.cc f-qzval.cc f-rand.cc \
+	f-schur.cc f-svd.cc f-syl.cc file-io.cc	g-builtins.cc \
+	gripes.cc help.cc idx-vector.cc input.cc lex.l mappers.cc \
+	octave.cc octave-hist.cc pager.cc parse.y pr-output.cc \
+	procstream.cc sighandlers.cc symtab.cc sysdep.cc \
+	t-builtins.cc tc-assign.cc tc-extras.cc tc-index.cc \
 	tc-inlines.cc tree.cc tree-const.cc tree-plot.cc \
 	unwind-prot.cc user-prefs.cc utils.cc variables.cc xdiv.cc \
 	xpow.cc
@@ -82,9 +82,10 @@
 MAKEDEPS = $(patsubst %.cc, %.d, $(DEP_SOURCES))
 
 DLD_OBJECTS = f-balance.o f-colloc.o f-dassl.o f-det.o f-eig.o \
-	f-fft.o f-fsolve.o f-fsqp.o f-givens.o f-hess.o f-ifft.o \
-	f-inv.o f-lpsolve.o f-lsode.o f-lu.o f-npsol.o f-qpsol.o \
-	f-qr.o f-quad.o f-qzval.o f-rand.o f-schur.o f-svd.o f-syl.o
+	f-expm.o f-fft.o f-fsolve.o f-fsqp.o f-givens.o f-hess.o \
+	f-ifft.o f-inv.o f-lpsolve.o f-lsode.o f-lu.o f-npsol.o \
+	f-qpsol.o f-qr.o f-quad.o f-qzval.o f-rand.o f-schur.o \
+	f-svd.o f-syl.o 
 
 OBJECTS = arith-ops.o builtins.o error.o file-io.o g-builtins.o \
 	gripes.o help.o idx-vector.o input.o lex.o mappers.o \
diff -r 6028dcac27ef -r 7806354a10d3 src/g-builtins.cc
--- a/src/g-builtins.cc	Wed Aug 11 20:48:00 1993 +0000
+++ b/src/g-builtins.cc	Wed Aug 11 20:50:40 1993 +0000
@@ -51,6 +51,7 @@
 #include "f-dassl.h"
 #include "f-det.h"
 #include "f-eig.h"
+#include "f-expm.h"
 #include "f-fft.h"
 #include "f-fsolve.h"
 #include "f-fsqp.h"
@@ -481,7 +482,11 @@
   tree_constant *retval = NULL_TREE_CONST;
 
   if (nargin == 2)
-    retval = matrix_exp (args[1]);
+    DLD_BUILTIN (args, nargin, nargout, matrix_exp,
+		 {
+		   retval = new tree_constant [2];
+		   retval[0] = matrix_exp (args[1]);
+		 })
   else
     usage ("expm (A)");
 
diff -r 6028dcac27ef -r 7806354a10d3 src/pt-const.h
--- a/src/pt-const.h	Wed Aug 11 20:48:00 1993 +0000
+++ b/src/pt-const.h	Wed Aug 11 20:50:40 1993 +0000
@@ -476,7 +476,6 @@
 
   friend tree_constant find_nonzero_elem_idx (tree_constant& a);
 
-  friend tree_constant *matrix_exp (tree_constant& a);
   friend tree_constant *matrix_log (tree_constant& a);
   friend tree_constant *matrix_sqrt (tree_constant& a);
 
diff -r 6028dcac27ef -r 7806354a10d3 src/tc-extras.cc
--- a/src/tc-extras.cc	Wed Aug 11 20:48:00 1993 +0000
+++ b/src/tc-extras.cc	Wed Aug 11 20:50:40 1993 +0000
@@ -326,115 +326,10 @@
   return retval;
 }
 
-// XXX FIXME XXX -- the next three functions should really be just
+// XXX FIXME XXX -- the next two functions (and expm) should really be just
 // one...
 
 tree_constant *
-matrix_exp (tree_constant& a)
-{
-  tree_constant *retval = new tree_constant [2];
-
-  tree_constant tmp = a.make_numeric ();;
-    
-  if (tmp.rows () == 0 || tmp.columns () == 0)
-    {
-      int flag = user_pref.propagate_empty_matrices;
-      if (flag != 0)
-	{
-	  if (flag < 0)
-	    gripe_empty_arg ("expm", 0);
-	  Matrix m;
-	  retval = new tree_constant [2];
-	  retval[0] = tree_constant (m);
-	  return retval;
-	}
-      else
-	gripe_empty_arg ("expm", 1);
-    }
-
-  switch (tmp.const_type ())
-    {
-    case tree_constant_rep::matrix_constant:
-      {
-	Matrix m = tmp.matrix_value ();
-
-	int nr = m.rows ();
-	int nc = m.columns ();
-
-	if (nr == 0 || nc == 0 || nr != nc)
-	  gripe_square_matrix_required ("expm");
-	else
-	  {
-	    EIG m_eig (m);
-	    ComplexColumnVector lambda (m_eig.eigenvalues ());
-	    ComplexMatrix Q (m_eig.eigenvectors ());
-
-	    for (int i = 0; i < nr; i++)
-	      {
-		Complex elt = lambda.elem (i);
-		if (imag (elt) == 0.0)
-		  lambda.elem (i) = exp (real (elt));
-		else
-		  lambda.elem (i) = exp (elt);
-	      }
-
-	    ComplexDiagMatrix D (lambda);
-	    ComplexMatrix result = Q * D * Q.inverse ();
-
-	    retval[0] = tree_constant (result);
-	  }
-      }
-      break;
-    case tree_constant_rep::complex_matrix_constant:
-      {
-	ComplexMatrix m = tmp.complex_matrix_value ();
-
-	int nr = m.rows ();
-	int nc = m.columns ();
-
-	if (nr == 0 || nc == 0 || nr != nc)
-	  gripe_square_matrix_required ("expm");
-	else
-	  {
-	    EIG m_eig (m);
-	    ComplexColumnVector lambda (m_eig.eigenvalues ());
-	    ComplexMatrix Q (m_eig.eigenvectors ());
-
-	    for (int i = 0; i < nr; i++)
-	      {
-		Complex elt = lambda.elem (i);
-		if (imag (elt) == 0.0)
-		  lambda.elem (i) = exp (real (elt));
-		else
-		  lambda.elem (i) = exp (elt);
-	      }
-
-	    ComplexDiagMatrix D (lambda);
-	    ComplexMatrix result = Q * D * Q.inverse ();
-
-	    retval[0] = tree_constant (result);
-	  }
-      }
-      break;
-    case tree_constant_rep::scalar_constant:
-      {
-	double d = tmp.double_value ();
-	retval[0] = tree_constant (exp (d));
-      }
-      break;
-    case tree_constant_rep::complex_scalar_constant:
-      {
-	Complex c = tmp.complex_value ();
-	retval[0] = tree_constant (exp (c));
-      }
-      break;
-    default:
-      break;
-    }
-  return retval;
-}
-
-tree_constant *
 matrix_log (tree_constant& a)
 {
   tree_constant *retval = new tree_constant [2];