Mercurial > octave-nkf
changeset 51:7806354a10d3
[project @ 1993-08-11 20:48:00 by jwe]
| author | jwe |
|---|---|
| date | Wed, 11 Aug 1993 20:50:40 +0000 |
| parents | 6028dcac27ef |
| children | 9eda1009cf95 |
| files | src/Makefile.in src/g-builtins.cc src/pt-const.h src/tc-extras.cc |
| diffstat | 4 files changed, 25 insertions(+), 125 deletions(-) [+] |
line wrap: on
line diff
--- 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 \
--- 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)");
--- 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);
--- 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];