Mercurial > hg > octave-terminal
changeset 519:b9284136189a
[project @ 1994-07-19 14:40:20 by jwe]
author | jwe |
---|---|
date | Tue, 19 Jul 1994 14:42:19 +0000 |
parents | 2349d5721cd9 |
children | 40d30877f838 |
files | liboctave/idx-vector.cc src/SLStack.cc src/Stack.cc src/balance.cc src/chol.cc src/colloc.cc src/dassl.cc src/det.cc src/eig.cc src/expm.cc src/fft.cc src/find.cc src/fsolve.cc src/fsqp.cc src/givens.cc src/hess.cc src/ifft.cc src/inv.cc src/log.cc src/lpsolve.cc src/lsode.cc src/lu.cc src/minmax.cc src/npsol.cc src/qpsol.cc src/qr.cc src/quad.cc src/qzval.cc src/rand.cc src/schur.cc src/sort.cc src/svd.cc src/syl.cc |
diffstat | 33 files changed, 764 insertions(+), 609 deletions(-) [+] |
line wrap: on
line diff
--- a/liboctave/idx-vector.cc +++ b/liboctave/idx-vector.cc @@ -1,4 +1,4 @@ -// Very simple integer vectors for indexing -*- C++ -*- +// idx-vector.cc -*- C++ -*- /* Copyright (C) 1992, 1993, 1994 John W. Eaton
--- a/src/SLStack.cc +++ b/src/SLStack.cc @@ -1,4 +1,4 @@ -// Template stack class -*- C++ -*- +// SLStack.cc -*- C++ -*- /* Copyright (C) 1993, 1994 John W. Eaton
--- a/src/Stack.cc +++ b/src/Stack.cc @@ -1,4 +1,4 @@ -// Template stack class -*- C++ -*- +// Stack.cc -*- C++ -*- /* Copyright (C) 1993, 1994 John W. Eaton
--- a/src/balance.cc +++ b/src/balance.cc @@ -1,4 +1,4 @@ -// tc-balance.cc -*- C++ -*- +// f-balance.cc -*- C++ -*- /* Copyright (C) 1993, 1994 John W. Eaton @@ -39,25 +39,40 @@ #include "user-prefs.h" #include "gripes.h" #include "error.h" -#include "f-balance.h" +#include "defun-dld.h" -#ifdef WITH_DLD -Octave_object -builtin_balance_2 (const Octave_object& args, int nargout) +DEFUN_DLD ("balance", Fbalance, Sbalance, 4, 4, + "AA = balance (A [, OPT]) or [[DD,] AA] = balance (A [, OPT])\n\ +\n\ +generalized eigenvalue problem:\n\ +\n\ + [cc, dd, aa, bb] = balance (a, b [, opt])\n\ +\n\ +where OPT is an optional single character argument as follows: \n\ +\n\ + N: no balancing; arguments copied, transformation(s) set to identity\n\ + P: permute argument(s) to isolate eigenvalues where possible\n\ + S: scale to improve accuracy of computed eigenvalues\n\ + B: (default) permute and scale, in that order. Rows/columns\n\ + of a (and b) that are isolated by permutation are not scaled\n\ +\n\ +[DD, AA] = balance (A, OPT) returns aa = dd\a*dd,\n\ +\n\ +[CC, DD, AA, BB] = balance (A, B, OPT) returns AA (BB) = CC*A*DD (CC*B*DD)") { - return balance (args, nargout); -} -#endif - -Octave_object -balance (const Octave_object& args, int nargout) -{ - char *bal_job; - int my_nargin; // # args w/o optional string arg Octave_object retval; int nargin = args.length (); + if (nargin < 2 || nargin > 4 || nargout < 0 || nargout > 4) + { + print_usage ("balance"); + return retval; + } + + char *bal_job; + int my_nargin; // # args w/o optional string arg + // determine if balancing option is listed // set my_nargin to the number of matrix inputs if (args(nargin-1).const_type () == tree_constant_rep::string_constant)
--- a/src/chol.cc +++ b/src/chol.cc @@ -32,24 +32,22 @@ #include "user-prefs.h" #include "gripes.h" #include "error.h" -#include "f-chol.h" +#include "defun-dld.h" -#ifdef WITH_DLD -Octave_object* -builtin_chol_2 (const Octave_object& args, int nargout) +DEFUN_DLD ("chol", Fchol, Schol, 2, 1, + "R = chol (X): cholesky factorization") { - Octave_object retval (1); - retval(0) = chol (args(1)); - return retval; -} -#endif + Octave_object retval; + + int nargin = args.length (); -tree_constant -chol (const tree_constant& a) -{ - tree_constant retval; + if (nargin != 2 || nargout > 1) + { + print_usage ("chol"); + return retval; + } - tree_constant tmp = a.make_numeric ();; + tree_constant tmp = args(1).make_numeric (); int nr = tmp.rows (); int nc = tmp.columns (); @@ -61,8 +59,8 @@ { if (flag < 0) gripe_empty_arg ("chol", 0); - Matrix m; - retval = m; + + retval.resize (1, Matrix ()); } else gripe_empty_arg ("chol", 1);
--- a/src/colloc.cc +++ b/src/colloc.cc @@ -30,23 +30,21 @@ #include "tree-const.h" #include "error.h" #include "utils.h" -#include "f-colloc.h" +#include "defun-dld.h" -#ifdef WITH_DLD -Octave_object -builtin_colloc_2 (const Octave_object& args, int nargout) -{ - return collocation_weights (args); -} -#endif - -Octave_object -collocation_weights (const Octave_object& args) +DEFUN_DLD ("colloc", Fcolloc, Scolloc, 7, 4, + "[R, A, B, Q] = colloc (N [, \"left\"] [, \"right\"]): collocation weights") { Octave_object retval; int nargin = args.length (); + if (nargin < 2 || nargin > 4) + { + print_usage ("colloc"); + return retval; + } + if (args(1).const_type () != tree_constant_rep::complex_scalar_constant && args(1).const_type () != tree_constant_rep::scalar_constant) { @@ -76,15 +74,13 @@ } char *s = args(i).string_value (); - if (s != (char *) NULL - && (((*s == 'R' || *s == 'r') && strlen (s) == 1) - || strcmp (s, "right") == 0)) + if (s && (((*s == 'R' || *s == 'r') && strlen (s) == 1) + || strcmp (s, "right") == 0)) { right = 1; } - else if (s != (char *) NULL - && (((*s == 'L' || *s == 'l') && strlen (s) == 1) - || strcmp (s, "left") == 0)) + else if (s && (((*s == 'L' || *s == 'l') && strlen (s) == 1) + || strcmp (s, "left") == 0)) { left = 1; }
--- a/src/dassl.cc +++ b/src/dassl.cc @@ -35,25 +35,11 @@ #include "error.h" #include "utils.h" #include "pager.h" -#include "f-dassl.h" +#include "defun-dld.h" // Global pointer for user defined function required by dassl. static tree_fvc *dassl_fcn; -#ifdef WITH_DLD -Octave_object -builtin_dassl_2 (const Octave_object& args, int nargout) -{ - return dassl (args, nargout); -} - -Octave_object -builtin_dassl_options_2 (const Octave_object& args, int nargout) -{ - return dassl_options (args, nargout); -} -#endif - static ODE_options dassl_opts; ColumnVector @@ -94,7 +80,7 @@ args(2) = deriv; } - if (dassl_fcn != (tree_fvc *) NULL) + if (dassl_fcn) { Octave_object tmp = dassl_fcn->eval (0, 1, args); @@ -118,18 +104,29 @@ return retval; } -Octave_object -dassl (const Octave_object& args, int nargout) +DEFUN_DLD ("dassl", Fdassl, Sdassl, 5, 1, + "dassl (\"function_name\", x_0, xdot_0, t_out)\n\ +dassl (F, X_0, XDOT_0, T_OUT, T_CRIT)\n\ +\n\ +The first argument is the name of the function to call to\n\ +compute the vector of residuals. It must have the form\n\ +\n\ + res = f (x, xdot, t)\n\ +\n\ +where x, xdot, and res are vectors, and t is a scalar.") { -// Assumes that we have been given the correct number of arguments. - Octave_object retval; int nargin = args.length (); + if (nargin < 5 || nargin > 6) + { + print_usage ("dassl"); + return retval; + } + dassl_fcn = is_valid_function (args(1), "dassl", 1); - if (dassl_fcn == (tree_fvc *) NULL - || takes_correct_nargs (dassl_fcn, 4, "dassl", 1) != 1) + if (! dassl_fcn || takes_correct_nargs (dassl_fcn, 4, "dassl", 1) != 1) return retval; ColumnVector state = args(2).to_vector (); @@ -187,33 +184,33 @@ static DAE_OPTIONS dassl_option_table [] = { { "absolute tolerance", - { "absolute", "tolerance", NULL, NULL, }, + { "absolute", "tolerance", 0, 0, }, { 1, 0, 0, 0, }, 1, ODE_options::set_absolute_tolerance, ODE_options::absolute_tolerance, }, { "initial step size", - { "initial", "step", "size", NULL, }, + { "initial", "step", "size", 0, }, { 1, 0, 0, 0, }, 1, ODE_options::set_initial_step_size, ODE_options::initial_step_size, }, { "maximum step size", - { "maximum", "step", "size", NULL, }, + { "maximum", "step", "size", 0, }, { 2, 0, 0, 0, }, 1, ODE_options::set_maximum_step_size, ODE_options::maximum_step_size, }, { "relative tolerance", - { "relative", "tolerance", NULL, NULL, }, + { "relative", "tolerance", 0, 0, }, { 1, 0, 0, 0, }, 1, ODE_options::set_relative_tolerance, ODE_options::relative_tolerance, }, - { NULL, - { NULL, NULL, NULL, NULL, }, + { 0, + { 0, 0, 0, 0, }, { 0, 0, 0, 0, }, 0, - NULL, NULL, }, + 0, 0, }, }; static void @@ -231,7 +228,7 @@ DAE_OPTIONS *list = dassl_option_table; char *keyword; - while ((keyword = list->keyword) != (char *) NULL) + while ((keyword = list->keyword) != 0) { output_buf.form (" %-40s ", keyword); @@ -254,7 +251,7 @@ { DAE_OPTIONS *list = dassl_option_table; - while (list->keyword != (char *) NULL) + while (list->keyword != 0) { if (keyword_almost_match (list->kw_tok, list->min_len, keyword, list->min_toks_to_match, MAX_TOKENS)) @@ -269,15 +266,20 @@ warning ("dassl_options: no match for `%s'", keyword); } -Octave_object -dassl_options (const Octave_object& args, int nargout) +DEFUN_DLD ("dassl_options", Fdassl_options, Sdassl_options, -1, 1, + "dassl_options (KEYWORD, VALUE)\n\ +\n\ +Set or show options for dassl. Keywords may be abbreviated\n\ +to the shortest match.") { Octave_object retval; int nargin = args.length (); if (nargin == 1) - print_dassl_option_list (); + { + print_dassl_option_list (); + } else if (nargin == 3) { if (args(1).is_string_type ())
--- a/src/det.cc +++ b/src/det.cc @@ -32,24 +32,22 @@ #include "user-prefs.h" #include "gripes.h" #include "error.h" -#include "f-det.h" +#include "defun-dld.h" -#ifdef WITH_DLD -Octave_object -builtin_det_2 (const Octave_object& args, int nargout) +DEFUN_DLD ("det", Fdet, Sdet, 2, 1, + "det (X): determinant of a square matrix") { - Octave_object retval (1); - retval(0) = determinant (args(1)); - return retval; -} -#endif + Octave_object retval; + + int nargin = args.length (); -tree_constant -determinant (const tree_constant& a) -{ - tree_constant retval; + if (nargin != 2) + { + print_usage ("det"); + return retval; + } - tree_constant tmp = a.make_numeric ();; + tree_constant tmp = args(1).make_numeric ();; int nr = tmp.rows (); int nc = tmp.columns ();
--- a/src/eig.cc +++ b/src/eig.cc @@ -31,21 +31,21 @@ #include "user-prefs.h" #include "gripes.h" #include "error.h" -#include "f-eig.h" +#include "defun-dld.h" -#ifdef WITH_DLD -Octave_object -builtin_eig_2 (const Octave_object& args, int nargout) -{ - return eig (args, nargout); -} -#endif - -Octave_object -eig (const Octave_object& args, int nargout) +DEFUN_DLD ("eig", Feig, Seig, 2, 1, + "eig (X) or [V, D] = eig (X): compute eigenvalues and eigenvectors of X") { Octave_object retval; + int nargin = args.length (); + + if (nargin != 2 || nargout > 2) + { + print_usage ("eig"); + return retval; + } + tree_constant arg = args(1).make_numeric (); int a_nr = arg.rows ();
--- a/src/expm.cc +++ b/src/expm.cc @@ -1,4 +1,4 @@ -// tc-expm.cc -*- C++ -*- +// f-expm.cc -*- C++ -*- /* Copyright (C) 1993, 1994 John W. Eaton @@ -40,17 +40,7 @@ #include "user-prefs.h" #include "gripes.h" #include "error.h" -#include "f-expm.h" - -#ifdef WITH_DLD -Octave_object -builtin_matrix_exp_2 (const Octave_object& args, int nargout) -{ - Octave_object retval (1); - retval(0) = matrix_exp (args(1)); - return retval; -} -#endif +#include "defun-dld.h" extern "C" { @@ -61,11 +51,20 @@ const Complex*, const int*, double*); } -tree_constant -matrix_exp (const tree_constant& a) +DEFUN_DLD ("expm", Fexpm, Sexpm, 2, 1, + "expm (X): matrix exponential, e^A") { - tree_constant retval; - tree_constant tmp = a.make_numeric (); + Octave_object retval; + + int nargin = args.length (); + + if (nargin != 2) + { + print_usage ("expm"); + return retval; + } + + tree_constant tmp = args(1).make_numeric (); // Constants for matrix exponential calculation. @@ -88,8 +87,8 @@ { if (flag < 0) gripe_empty_arg ("expm", 0); - Matrix m; - retval = m; + + retval.resize (1, Matrix ()); } else gripe_empty_arg ("expm", 1); }
--- a/src/fft.cc +++ b/src/fft.cc @@ -32,24 +32,22 @@ #include "user-prefs.h" #include "gripes.h" #include "error.h" -#include "f-fft.h" +#include "defun-dld.h" -#ifdef WITH_DLD -Octave_object -builtin_fft_2 (const Octave_object& args, int nargout) +DEFUN_DLD ("fft", Ffft, Sfft, 2, 1, + "fft (X): fast fourier transform of a vector") { - Octave_object retval (1); - retval(0) = fft (args(1)); - return retval; -} -#endif + Octave_object retval; + + int nargin = args.length (); -tree_constant -fft (const tree_constant& a) -{ - tree_constant retval; + if (nargin != 2) + { + print_usage ("fft"); + return retval; + } - tree_constant tmp = a.make_numeric ();; + tree_constant tmp = args(1).make_numeric ();; if (tmp.rows () == 0 || tmp.columns () == 0) { @@ -58,8 +56,8 @@ { if (flag < 0) gripe_empty_arg ("fft", 0); - Matrix m; - retval = m; + + retval.resize (1, Matrix ()); } else gripe_empty_arg ("fft", 1);
--- a/src/find.cc +++ b/src/find.cc @@ -27,7 +27,7 @@ #include "tree-const.h" #include "error.h" -#include "f-find.h" +#include "defun-dld.h" static Octave_object find_to_fortran_idx (const ColumnVector i_idx, const ColumnVector j_idx, @@ -148,15 +148,24 @@ return find_to_fortran_idx (i_idx, j_idx, tmp, m_nr, m_nc, nargout); } -Octave_object -find_nonzero_elem_idx (const tree_constant& a, int nargout) +DEFUN_DLD ("find", Ffind, Sfind, 2, 3, + "find (X) or [I, J, V] = find (X): Return indices of nonzero elements") { - Matrix result; + Octave_object retval; + + int nargin = args.length (); + + if (nargin != 2 || nargout > 3) + { + print_usage ("find"); + return retval; + } nargout = (nargout == 0) ? 1 : nargout; - Octave_object retval (nargout, result); - tree_constant tmp = a.make_numeric (); + retval.resize (nargout, Matrix ()); + + tree_constant tmp = args(1).make_numeric (); switch (tmp.const_type ()) {
--- a/src/fsolve.cc +++ b/src/fsolve.cc @@ -35,25 +35,11 @@ #include "error.h" #include "utils.h" #include "pager.h" -#include "f-fsolve.h" +#include "defun-dld.h" // Global pointer for user defined function required by hybrd1. static tree_fvc *fsolve_fcn; -#ifdef WITH_DLD -Octave_object -builtin_fsolve_2 (const Octave_object& args, int nargout) -{ - return fsolve (args, nargout); -} - -Octave_object -builtin_fsolve_options (const Octave_object& args, int nargout) -{ - return fsolve_options (args, nargout); -} -#endif - static NLEqn_options fsolve_opts; int @@ -110,7 +96,7 @@ args(1) = vars; } - if (fsolve_fcn != (tree_fvc *) NULL) + if (fsolve_fcn) { Octave_object tmp = fsolve_fcn->eval (0, 1, args); if (tmp.length () > 0 && tmp(0).is_defined ()) @@ -127,18 +113,30 @@ return retval; } -Octave_object -fsolve (const Octave_object& args, int nargout) +DEFUN_DLD ("fsolve", Ffsolve, Sfsolve, 5, 1, + "Solve nonlinear equations using Minpack. Usage:\n\ +\n\ + [X, INFO] = fsolve (F, X0)\n\ +\n\ +Where the first argument is the name of the function to call to\n\ +compute the vector of function values. It must have the form\n\ +\n\ + y = f (x) +\n\ +where y and x are vectors.") { -// Assumes that we have been given the correct number of arguments. - Octave_object retval; int nargin = args.length (); + if (nargin < 3 || nargin > 7 || nargout > 3) + { + print_usage ("fsolve"); + return retval; + } + fsolve_fcn = is_valid_function (args(1), "fsolve", 1); - if (fsolve_fcn == (tree_fvc *) NULL - || takes_correct_nargs (fsolve_fcn, 2, "fsolve", 1) != 1) + if (! fsolve_fcn || takes_correct_nargs (fsolve_fcn, 2, "fsolve", 1) != 1) return retval; ColumnVector x = args(2).to_vector (); @@ -185,15 +183,15 @@ static NLEQN_OPTIONS fsolve_option_table [] = { { "tolerance", - { "tolerance", NULL, }, + { "tolerance", 0, }, { 1, 0, }, 1, NLEqn_options::set_tolerance, NLEqn_options::tolerance, }, - { NULL, - { NULL, NULL, }, + { 0, + { 0, 0, }, { 0, 0, }, 0, - NULL, NULL, }, + 0, 0, }, }; static void @@ -211,7 +209,7 @@ NLEQN_OPTIONS *list = fsolve_option_table; char *keyword; - while ((keyword = list->keyword) != (char *) NULL) + while ((keyword = list->keyword) != 0) { output_buf.form (" %-40s ", keyword); @@ -234,7 +232,7 @@ { NLEQN_OPTIONS *list = fsolve_option_table; - while (list->keyword != (char *) NULL) + while (list->keyword != 0) { if (keyword_almost_match (list->kw_tok, list->min_len, keyword, list->min_toks_to_match, MAX_TOKENS)) @@ -249,15 +247,20 @@ warning ("fsolve_options: no match for `%s'", keyword); } -Octave_object -fsolve_options (const Octave_object& args, int nargout) +DEFUN_DLD ("fsolve_options", Ffsolve_options, Sfsolve_options, -1, 1, + "fsolve_options (KEYWORD, VALUE)\n\ +\n\ +Set or show options for fsolve. Keywords may be abbreviated\n\ +to the shortest match.") { Octave_object retval; int nargin = args.length (); if (nargin == 1) - print_fsolve_option_list (); + { + print_fsolve_option_list (); + } else if (nargin == 3) { if (args(1).is_string_type ())
--- a/src/fsqp.cc +++ b/src/fsqp.cc @@ -31,26 +31,12 @@ #include "tree-const.h" #include "error.h" -#include "f-fsqp.h" +#include "defun-dld.h" // Global pointers for user defined functions required by fsqp. // static tree *fsqp_objective; // static tree *fsqp_constraints; -#ifdef WITH_DLD -Octave_object -builtin_fsqp_2 (const Octave_object& args, int nargout) -{ - return fsqp (args nargout); -} - -Octave_object -builtin_fsqp_options_2 (const Octave_object& args, int nargout) -{ - return fsqp_options (args, nargout); -} -#endif - double fsqp_objective_function (const ColumnVector& x) { @@ -64,8 +50,18 @@ return retval; } -Octave_object -fsqp (const Octave_object& args, int nargout) +#if defined (FSQP_MISSING) +DEFUN_DLD ("fsqp", Ffsqp, Sfsqp, 11, 3, + "This function requires FSQP, which is not freely\n\ +redistributable. For more information, read the file\n\ +libcruft/fsqp/README.MISSING in the source distribution.") +#else +DEFUN_DLD ("fsqp", Ffsqp, Sfsqp, 11, 3, + "[X, PHI] = fsqp (X, PHI [, LB, UB] [, LB, A, UB] [, LB, G, UB])\n\ +\n\ +Groups of arguments surrounded in `[]' are optional, but\n\ +must appear in the same relative order shown above.") +#endif { /* @@ -82,20 +78,30 @@ */ -// Assumes that we have been given the correct number of arguments. + Octave_object retval; - Octave_object retval; error ("fsqp: not implemented yet"); + return retval; } -Octave_object -fsqp_options (const Octave_object& args, int nargout) +#if defined (FSQP_MISSING) +DEFUN_DLD ("fsqp_options", Ffsqp_options, Sfsqp_options, -1, 1, + "This function requires FSQP, which is not freely\n\ +redistributable. For more information, read the file\n\ +libcruft/fsqp/README.MISSING in the source distribution.") +#else +DEFUN_DLD ("fsqp_options", Ffsqp_options, Sfsqp_options, -1, 1, + "fsqp_options (KEYWORD, VALUE)\n\ +\n\ +Set or show options for fsqp. Keywords may be abbreviated\n\ +to the shortest match.") +#endif { -// Assumes that we have been given the correct number of arguments. + Octave_object retval; - Octave_object retval; error ("fsqp_options: not implemented yet"); + return retval; }
--- a/src/givens.cc +++ b/src/givens.cc @@ -1,4 +1,4 @@ -// tc-givens.cc -*- C++ -*- +// f-givens.cc -*- C++ -*- /* Copyright (C) 1993, 1994 John W. Eaton @@ -35,7 +35,7 @@ #include "user-prefs.h" #include "error.h" #include "gripes.h" -#include "f-givens.h" +#include "defun-dld.h" extern "C" { @@ -56,19 +56,23 @@ int*, long, long); #endif -#ifdef WITH_DLD -Octave_object -builtin_givens_2 (const Octave_object& args int nargout) +DEFUN_DLD ("givens", Fgivens, Sgivens, 3, 2, + "G = givens (X, Y)\n\ +\n\ +compute orthogonal matrix G = [c s; -conj (s) c]\n\ +such that G [x; y] = [*; 0] (x, y scalars)\n\ +\n\ +[c, s] = givens (x, y) returns the (c, s) values themselves.") { - return givens (args, nargout); -} -#endif + Octave_object retval; + + int nargin = args.length (); -Octave_object -givens (const Octave_object& args, int nargout) -{ - - Octave_object retval; + if (nargin != 3 || nargout > 2) + { + print_usage ("givens"); + return retval; + } tree_constant arga = args(1).make_numeric (); tree_constant argb = args(2).make_numeric ();
--- a/src/hess.cc +++ b/src/hess.cc @@ -32,21 +32,21 @@ #include "user-prefs.h" #include "error.h" #include "gripes.h" -#include "f-hess.h" +#include "defun-dld.h" -#ifdef WITH_DLD -Octave_object -builtin_hess_2 (const Octave_object& args, int nargout) -{ - return hess (args, nargout); -} -#endif - -Octave_object -hess (const Octave_object& args, int nargout) +DEFUN_DLD ("hess", Fhess, Shess, 2, 2, + "[P, H] = hess (A) or H = hess (A): Hessenberg decomposition") { Octave_object retval; + int nargin = args.length (); + + if (nargin != 2 || nargout > 2) + { + print_usage ("hess"); + return retval; + } + tree_constant arg = args(1).make_numeric (); int a_nr = arg.rows ();
--- a/src/ifft.cc +++ b/src/ifft.cc @@ -32,24 +32,22 @@ #include "user-prefs.h" #include "gripes.h" #include "error.h" -#include "f-ifft.h" +#include "defun-dld.h" -#ifdef WITH_DLD -Octave_object -builtin_ifft_2 (const Octave_object& args, int nargout) +DEFUN_DLD ("ifft", Fifft, Sifft,2, 1, + "ifft (X): inverse fast fourier transform of a vector") { - Octave_object retval (1); - retval(0) = ifft (args(1)); - return retval; -} -#endif + Octave_object retval; + + int nargin = args.length (); -tree_constant -ifft (const tree_constant& a) -{ - tree_constant retval; + if (nargin != 2) + { + print_usage ("ifft"); + return retval; + } - tree_constant tmp = a.make_numeric ();; + tree_constant tmp = args(1).make_numeric (); if (tmp.rows () == 0 || tmp.columns () == 0) { @@ -58,8 +56,8 @@ { if (flag < 0) gripe_empty_arg ("ifft", 0); - Matrix m; - retval = m; + + retval.resize (1, Matrix ()); } else gripe_empty_arg ("ifft", 1);
--- a/src/inv.cc +++ b/src/inv.cc @@ -32,24 +32,22 @@ #include "user-prefs.h" #include "gripes.h" #include "error.h" -#include "f-inv.h" +#include "defun-dld.h" -#ifdef WITH_DLD -Octave_object -builtin_inv_2 (const Octave_object& args, int nargout) +DEFUN_DLD ("inv", Finv, Sinv, 2, 1, + "inv (X): inverse of a square matrix") { - Octave_object retval (1); - retval(0) = inverse (args(1)); - return retval; -} -#endif + Octave_object retval; + + int nargin = args.length (); -tree_constant -inverse (const tree_constant& a) -{ - tree_constant retval; + if (nargin != 2) + { + print_usage ("inv"); + return retval; + } - tree_constant tmp = a.make_numeric (); + tree_constant tmp = args(1).make_numeric (); int nr = tmp.rows (); int nc = tmp.columns ();
--- a/src/log.cc +++ b/src/log.cc @@ -31,17 +31,24 @@ #include "user-prefs.h" #include "error.h" #include "gripes.h" -#include "f-log.h" +#include "defun-dld.h" + +// XXX FIXME XXX -- the next two functions should really be just one... -// XXX FIXME XXX -- the next two functions (and expm) should really be just -// one... +DEFUN_DLD ("logm", Flogm, Slogm, 2, 1, + "logm (X): matrix logarithm") +{ + Octave_object retval; -Octave_object -matrix_log (const tree_constant& a) -{ - Octave_object retval (1); + int nargin = args.length (); - tree_constant tmp = a.make_numeric ();; + if (nargin != 2) + { + print_usage ("logm"); + return retval; + } + + tree_constant tmp = args(1).make_numeric ();; if (tmp.rows () == 0 || tmp.columns () == 0) { @@ -50,8 +57,8 @@ { if (flag < 0) gripe_empty_arg ("logm", 0); - Matrix m; - retval(0) = m; + + retval.resize (1, Matrix ()); return retval; } else @@ -146,12 +153,20 @@ return retval; } -Octave_object -matrix_sqrt (const tree_constant& a) +DEFUN_DLD ("sqrtm", Fsqrtm, Ssqrtm, 2, 1, + "sqrtm (X): matrix sqrt") { - Octave_object retval (1); + Octave_object retval; + + int nargin = args.length (); - tree_constant tmp = a.make_numeric ();; + if (nargin != 2) + { + print_usage ("sqrtm"); + return retval; + } + + tree_constant tmp = args(1).make_numeric ();; if (tmp.rows () == 0 || tmp.columns () == 0) { @@ -160,8 +175,8 @@ { if (flag < 0) gripe_empty_arg ("sqrtm", 0); - Matrix m; - retval(0) = m; + + retval.resize (1, Matrix ()); return retval; } else
--- a/src/lpsolve.cc +++ b/src/lpsolve.cc @@ -29,39 +29,34 @@ #include "tree-const.h" #include "error.h" -#include "f-lpsolve.h" +#include "defun-dld.h" -#ifdef WITH_DLD -Octave_object -builtin_lpsolve_2 (const Octave_object& args, int nargout) -{ - return lpsolve (args, nargout); -} - -Octave_object -builtin_lpsolve_options_2 (const Octave_object& args, int nargout) +DEFUN_DLD ("lpsolve", Flpsolve, Slpsolve, 11, 3, + "lp_solve (): solve linear programs using lp_solve.") { - return lpsolve_options (args, nargout); -} -#endif + Octave_object retval; -Octave_object -lpsolve (const Octave_object& args, int nargout) -{ -// Assumes that we have been given the correct number of arguments. +// Force a bad value of inform, and empty matrices for x and phi. + Matrix m; + retval(2) = -1.0; + retval(1) = m; + retval(0) = m; - Octave_object retval; error ("lpsolve: not implemented yet"); + return retval; } -Octave_object -lpsolve_options (const Octave_object& args, int nargout) +DEFUN_DLD ("lpsolve_options", Flpsolve_options, Slpsolve_options, -1, 1, + "lp_solve_options (KEYWORD, VALUE)\n\ +\n\ +Set or show options for lp_solve. Keywords may be abbreviated\n\ +to the shortest match.") { -// Assumes that we have been given the correct number of arguments. + Octave_object retval; - Octave_object retval; error ("lpsolve_options: not implemented yet"); + return retval; }
--- a/src/lsode.cc +++ b/src/lsode.cc @@ -35,25 +35,11 @@ #include "error.h" #include "utils.h" #include "pager.h" -#include "f-lsode.h" +#include "defun-dld.h" // Global pointer for user defined function required by lsode. static tree_fvc *lsode_fcn; -#ifdef WITH_DLD -Octave_object -builtin_lsode_2 (const Octave_object& args int nargout) -{ - return lsode (args, nargout); -} - -Octave_object -builtin_lsode_options_2 (const Octave_object& args, int nargout) -{ - return lsode_options (args, nargout); -} -#endif - static ODE_options lsode_opts; ColumnVector @@ -83,7 +69,7 @@ args(1) = state; } - if (lsode_fcn != (tree_fvc *) NULL) + if (lsode_fcn) { Octave_object tmp = lsode_fcn->eval (0, 1, args); @@ -107,18 +93,28 @@ return retval; } -Octave_object -lsode (const Octave_object& args, int nargout) +DEFUN_DLD ("lsode", Flsode, Slsode, 6, 1, + "lsode (F, X0, T_OUT, T_CRIT)\n\ +\n\ +The first argument is the name of the function to call to\n\ +compute the vector of right hand sides. It must have the form\n\ +\n\ + xdot = f (x, t)\n\ +\n\ +where xdot and x are vectors and t is a scalar.\n") { -// Assumes that we have been given the correct number of arguments. - Octave_object retval; int nargin = args.length (); + if (nargin < 4 || nargin > 5 || nargout > 1) + { + print_usage ("lsode"); + return retval; + } + lsode_fcn = is_valid_function (args(1), "lsode", 1); - if (lsode_fcn == (tree_fvc *) NULL - || takes_correct_nargs (lsode_fcn, 3, "lsode", 1) != 1) + if (! lsode_fcn || takes_correct_nargs (lsode_fcn, 3, "lsode", 1) != 1) return retval; ColumnVector state = args(2).to_vector (); @@ -169,39 +165,39 @@ static ODE_OPTIONS lsode_option_table [] = { { "absolute tolerance", - { "absolute", "tolerance", NULL, NULL, }, + { "absolute", "tolerance", 0, 0, }, { 1, 0, 0, 0, }, 1, ODE_options::set_absolute_tolerance, ODE_options::absolute_tolerance, }, { "initial step size", - { "initial", "step", "size", NULL, }, + { "initial", "step", "size", 0, }, { 1, 0, 0, 0, }, 1, ODE_options::set_initial_step_size, ODE_options::initial_step_size, }, { "maximum step size", - { "maximum", "step", "size", NULL, }, + { "maximum", "step", "size", 0, }, { 2, 0, 0, 0, }, 1, ODE_options::set_maximum_step_size, ODE_options::maximum_step_size, }, { "minimum step size", - { "minimum", "step", "size", NULL, }, + { "minimum", "step", "size", 0, }, { 2, 0, 0, 0, }, 1, ODE_options::set_minimum_step_size, ODE_options::minimum_step_size, }, { "relative tolerance", - { "relative", "tolerance", NULL, NULL, }, + { "relative", "tolerance", 0, 0, }, { 1, 0, 0, 0, }, 1, ODE_options::set_relative_tolerance, ODE_options::relative_tolerance, }, - { NULL, - { NULL, NULL, NULL, NULL, }, + { 0, + { 0, 0, 0, 0, }, { 0, 0, 0, 0, }, 0, - NULL, NULL, }, + 0, 0, }, }; static void @@ -219,7 +215,7 @@ ODE_OPTIONS *list = lsode_option_table; char *keyword; - while ((keyword = list->keyword) != (char *) NULL) + while ((keyword = list->keyword) != 0) { output_buf.form (" %-40s ", keyword); @@ -242,7 +238,7 @@ { ODE_OPTIONS *list = lsode_option_table; - while (list->keyword != (char *) NULL) + while (list->keyword != 0) { if (keyword_almost_match (list->kw_tok, list->min_len, keyword, list->min_toks_to_match, MAX_TOKENS)) @@ -257,15 +253,20 @@ warning ("lsode_options: no match for `%s'", keyword); } -Octave_object -lsode_options (const Octave_object& args, int nargout) +DEFUN_DLD ("lsode_options", Flsode_options, Slsode_options, -1, 1, + "lsode_options (KEYWORD, VALUE)\n\ +\n\ +Set or show options for lsode. Keywords may be abbreviated\n\ +to the shortest match.") { Octave_object retval; int nargin = args.length (); if (nargin == 1) - print_lsode_option_list (); + { + print_lsode_option_list (); + } else if (nargin == 3) { if (args(1).is_string_type ())
--- a/src/lu.cc +++ b/src/lu.cc @@ -31,22 +31,22 @@ #include "tree-const.h" #include "user-prefs.h" #include "gripes.h" -#include "f-lu.h" +#include "defun-dld.h" -#ifdef WITH_DLD -Octave_object -builtin_lu_2 (const Octave_object& args, int nargout) +DEFUN_DLD ("lu", Flu, Slu, 2, 3, + "[L, U, P] = lu (A): LU factorization") { - return lu (args(1), nargout); -} -#endif + Octave_object retval; + + int nargin = args.length (); -Octave_object -lu (const tree_constant& a, int nargout) -{ - Octave_object retval (3); + if (nargin != 2 || nargout > 3) + { + print_usage ("lu"); + return retval; + } - tree_constant tmp = a.make_numeric ();; + tree_constant tmp = args(1).make_numeric ();; if (tmp.rows () == 0 || tmp.columns () == 0) { @@ -56,10 +56,7 @@ if (flag < 0) gripe_empty_arg ("lu", 0); - Matrix m; - retval(0) = m; - retval(1) = m; - retval(2) = m; + retval.resize (3, Matrix ()); return retval; } else @@ -81,15 +78,15 @@ { Matrix P = fact.P (); Matrix L = P.transpose () * fact.L (); + retval(1) = fact.U (); retval(0) = L; - retval(1) = fact.U (); } break; case 3: default: - retval(0) = fact.L (); + retval(2) = fact.P (); retval(1) = fact.U (); - retval(2) = fact.P (); + retval(0) = fact.L (); break; } } @@ -110,15 +107,15 @@ { ComplexMatrix P = fact.P (); ComplexMatrix L = P.transpose () * fact.L (); + retval(1) = fact.U (); retval(0) = L; - retval(1) = fact.U (); } break; case 3: default: - retval(0) = fact.L (); + retval(2) = fact.P (); retval(1) = fact.U (); - retval(2) = fact.P (); + retval(0) = fact.L (); break; } } @@ -129,17 +126,17 @@ case tree_constant_rep::scalar_constant: { double d = tmp.double_value (); - retval(0) = 1.0; + retval(2) = 1.0; retval(1) = d; - retval(2) = 1.0; + retval(0) = 1.0; } break; case tree_constant_rep::complex_scalar_constant: { Complex c = tmp.complex_value (); - retval(0) = 1.0; + retval(2) = 1.0; retval(1) = c; - retval(2) = 1.0; + retval(0) = 1.0; } break; default:
--- a/src/minmax.cc +++ b/src/minmax.cc @@ -29,7 +29,7 @@ #include "tree-const.h" #include "error.h" -#include "f-minmax.h" +#include "defun-dld.h" #ifndef MAX #define MAX(a,b) ((a) > (b) ? (a) : (b)) @@ -141,11 +141,20 @@ return result; } -Octave_object -column_min (const Octave_object& args, int nargout) + +DEFUN_DLD ("min", Fmin, Smin, 3, 2, + "min (X): minimum value(s) of a vector (matrix)") { Octave_object retval; + int nargin = args.length (); + + if (nargin == 1 || nargin > 3 || nargout > 2) + { + print_usage ("min"); + return retval; + } + tree_constant arg1; tree_constant arg2; tree_constant_rep::constant_type arg1_type = @@ -153,8 +162,6 @@ tree_constant_rep::constant_type arg2_type = tree_constant_rep::unknown_constant; - int nargin = args.length (); - switch (nargin) { case 3: @@ -314,11 +321,19 @@ return retval; } -Octave_object -column_max (const Octave_object& args, int nargout) +DEFUN_DLD ("max", Fmax, Smax, 3, 2, + "max (X): maximum value(s) of a vector (matrix)") { Octave_object retval; + int nargin = args.length (); + + if (nargin == 1 || nargin > 3 || nargout > 2) + { + print_usage ("max"); + return retval; + } + tree_constant arg1; tree_constant arg2; tree_constant_rep::constant_type arg1_type = @@ -326,8 +341,6 @@ tree_constant_rep::constant_type arg2_type = tree_constant_rep::unknown_constant; - int nargin = args.length (); - switch (nargin) { case 3:
--- a/src/npsol.cc +++ b/src/npsol.cc @@ -33,31 +33,16 @@ #include "tree-const.h" #include "variables.h" -#include "builtins.h" #include "gripes.h" #include "error.h" #include "pager.h" #include "utils.h" -#include "f-npsol.h" +#include "defun-dld.h" // Global pointers for user defined functions required by npsol. static tree_fvc *npsol_objective; static tree_fvc *npsol_constraints; -#ifdef WITH_DLD -Octave_object -builtin_npsol_2 (const Octave_object& args, int nargout) -{ - return npsol (args, nargout); -} - -Octave_object -builtin_npsol_options_2 (const Octave_object& args, int nargout) -{ - return npsol_options (args, nargout); -} -#endif - static NPSOL_options npsol_opts; double @@ -88,7 +73,7 @@ retval = 0.0; tree_constant objective_value; - if (npsol_objective != (tree_fvc *) NULL) + if (npsol_objective) { Octave_object tmp = npsol_objective->eval (0, 1, args); @@ -161,7 +146,7 @@ // args(0) = name; args(1) = decision_vars; - if (npsol_constraints != (tree_fvc *)NULL) + if (npsol_constraints) { Octave_object tmp = npsol_constraints->eval (0, 1, args); @@ -245,8 +230,32 @@ return ok; } -Octave_object -npsol (const Octave_object& args, int nargout) +#if defined (NPSOL_MISSING) +DEFUN_DLD ("npsol", Fnpsol, Snpsol, 11, 3, + "This function requires NPSOL, which is not freely\n\ +redistributable. For more information, read the file\n\ +libcruft/npsol/README.MISSING in the source distribution.") +#else +DEFUN_DLD ("npsol", Fnpsol, Snpsol, 11, 3, + "[X, OBJ, INFO, LAMBDA] = npsol (X, PHI [, LB, UB] [, LB, A, UB] [, LB, G, UB])\n\ +\n\ +Groups of arguments surrounded in `[]' are optional, but\n\ +must appear in the same relative order shown above.\n\ +\n\ +The second argument is a string containing the name of the objective\n\ +function to call. The objective function must be of the form\n\ +\n\ + y = phi (x)\n\ +\n\ +where x is a vector and y is a scalar.\n\ +\n\ +The argument G is a string containing the name of the function that +defines the nonlinear constraints. It must be of the form\n\ +\n\ + y = g (x)\n\ +\n\ +where x is a vector and y is a vector.") +#endif { /* @@ -263,12 +272,29 @@ */ -// Assumes that we have been given the correct number of arguments. - Octave_object retval; +#if defined (NPSOL_MISSING) + +// Force a bad value of inform, and empty matrices for x, phi, and lambda. + + retval.resize (4, Matrix ()); + + retval(2) = -1.0; + + print_usage ("npsol"); + +#else + int nargin = args.length (); + if (nargin < 3 || nargin == 4 || nargin == 7 || nargin == 10 + || nargin > 11 || nargout > 4) + { + print_usage ("npsol"); + return retval; + } + ColumnVector x = args(1).to_vector (); if (x.capacity () == 0) @@ -278,7 +304,7 @@ } npsol_objective = is_valid_function (args(2), "npsol", 1); - if (npsol_objective == (tree_fvc *) NULL + if (! npsol_objective || takes_correct_nargs (npsol_objective, 2, "npsol", 1) != 1) return retval; @@ -332,13 +358,13 @@ goto solved; } - npsol_constraints = (tree_fvc *) NULL; + npsol_constraints = 0; if (nargin == 6 || nargin == 8 || nargin == 9 || nargin == 11) npsol_constraints = is_valid_function (args(nargin-2), "npsol", 0); if (nargin == 8 || nargin == 6) { - if (npsol_constraints == (tree_fvc *) NULL) + if (! npsol_constraints) { ColumnVector lub = args(nargin-1).to_vector (); Matrix c = args(nargin-2).to_matrix (); @@ -411,7 +437,7 @@ if (nargin == 9 || nargin == 11) { - if (npsol_constraints == (tree_fvc *) NULL) + if (! npsol_constraints) { // Produce error message. is_valid_function (args(nargin-2), "npsol", 1); @@ -482,6 +508,8 @@ if (nargout > 3) retval(3) = lambda; +#endif + return retval; } @@ -507,129 +535,129 @@ static NPSOL_OPTIONS npsol_option_table [] = { { "central difference interval", - { "central", "difference", "interval", NULL, NULL, NULL, }, + { "central", "difference", "interval", 0, 0, 0, }, { 2, 0, 0, 0, 0, 0, }, 1, - NPSOL_options::set_central_difference_interval, NULL, - NPSOL_options::central_difference_interval, NULL, }, + NPSOL_options::set_central_difference_interval, 0, + NPSOL_options::central_difference_interval, 0, }, { "crash tolerance", - { "crash", "tolerance", NULL, NULL, NULL, NULL, }, + { "crash", "tolerance", 0, 0, 0, 0, }, { 2, 0, 0, 0, 0, 0, }, 1, - NPSOL_options::set_crash_tolerance, NULL, - NPSOL_options::crash_tolerance, NULL, }, + NPSOL_options::set_crash_tolerance, 0, + NPSOL_options::crash_tolerance, 0, }, { "derivative level", - { "derivative", "level", NULL, NULL, NULL, NULL, }, + { "derivative", "level", 0, 0, 0, 0, }, { 1, 0, 0, 0, 0, 0, }, 1, - NULL, NPSOL_options::set_derivative_level, - NULL, NPSOL_options::derivative_level, }, + 0, NPSOL_options::set_derivative_level, + 0, NPSOL_options::derivative_level, }, { "difference interval", - { "difference", "interval", NULL, NULL, NULL, NULL, }, + { "difference", "interval", 0, 0, 0, 0, }, { 3, 0, 0, 0, 0, 0, }, 1, - NPSOL_options::set_difference_interval, NULL, - NPSOL_options::difference_interval, NULL, }, + NPSOL_options::set_difference_interval, 0, + NPSOL_options::difference_interval, 0, }, { "function precision", - { "function", "precision", NULL, NULL, NULL, NULL, }, + { "function", "precision", 0, 0, 0, 0, }, { 2, 0, 0, 0, 0, 0, }, 1, - NPSOL_options::set_function_precision, NULL, - NPSOL_options::function_precision, NULL, }, + NPSOL_options::set_function_precision, 0, + NPSOL_options::function_precision, 0, }, { "infinite bound size", - { "infinite", "bound", "size", NULL, NULL, NULL, }, + { "infinite", "bound", "size", 0, 0, 0, }, { 1, 1, 0, 0, 0, 0, }, 2, - NPSOL_options::set_infinite_bound, NULL, - NPSOL_options::infinite_bound, NULL, }, + NPSOL_options::set_infinite_bound, 0, + NPSOL_options::infinite_bound, 0, }, { "infinite step size", - { "infinite", "step", "size", NULL, NULL, NULL, }, + { "infinite", "step", "size", 0, 0, 0, }, { 1, 1, 0, 0, 0, 0, }, 2, - NPSOL_options::set_infinite_step, NULL, - NPSOL_options::infinite_step, NULL, }, + NPSOL_options::set_infinite_step, 0, + NPSOL_options::infinite_step, 0, }, { "linear feasibility tolerance", - { "linear", "feasibility", "tolerance", NULL, NULL, NULL, }, + { "linear", "feasibility", "tolerance", 0, 0, 0, }, { 5, 0, 0, 0, 0, 0, }, 1, - NPSOL_options::set_linear_feasibility_tolerance, NULL, - NPSOL_options::linear_feasibility_tolerance, NULL, }, + NPSOL_options::set_linear_feasibility_tolerance, 0, + NPSOL_options::linear_feasibility_tolerance, 0, }, { "linesearch tolerance", - { "linesearch", "tolerance", NULL, NULL, NULL, NULL, }, + { "linesearch", "tolerance", 0, 0, 0, 0, }, { 5, 0, 0, 0, 0, 0, }, 1, - NPSOL_options::set_linesearch_tolerance, NULL, - NPSOL_options::linesearch_tolerance, NULL, }, + NPSOL_options::set_linesearch_tolerance, 0, + NPSOL_options::linesearch_tolerance, 0, }, { "major iteration limit", - { "major", "iteration", "limit", NULL, NULL, NULL, }, + { "major", "iteration", "limit", 0, 0, 0, }, { 2, 1, 0, 0, 0, 0, }, 2, - NULL, NPSOL_options::set_major_iteration_limit, - NULL, NPSOL_options::major_iteration_limit, }, + 0, NPSOL_options::set_major_iteration_limit, + 0, NPSOL_options::major_iteration_limit, }, { "minor iteration limit", - { "minor", "iteration", "limit", NULL, NULL, NULL, }, + { "minor", "iteration", "limit", 0, 0, 0, }, { 2, 1, 0, 0, 0, 0, }, 2, - NULL, NPSOL_options::set_minor_iteration_limit, - NULL, NPSOL_options::minor_iteration_limit, }, + 0, NPSOL_options::set_minor_iteration_limit, + 0, NPSOL_options::minor_iteration_limit, }, { "major print level", - { "major", "print", "level", NULL, NULL, NULL, }, + { "major", "print", "level", 0, 0, 0, }, { 2, 1, 0, 0, 0, 0, }, 2, - NULL, NPSOL_options::set_major_print_level, - NULL, NPSOL_options::major_print_level, }, + 0, NPSOL_options::set_major_print_level, + 0, NPSOL_options::major_print_level, }, { "minor print level", - { "minor", "print", "level", NULL, NULL, NULL, }, + { "minor", "print", "level", 0, 0, 0, }, { 2, 1, 0, 0, 0, 0, }, 2, - NULL, NPSOL_options::set_minor_print_level, - NULL, NPSOL_options::minor_print_level, }, + 0, NPSOL_options::set_minor_print_level, + 0, NPSOL_options::minor_print_level, }, { "nonlinear feasibility tolerance", - { "nonlinear", "feasibility", "tolerance", NULL, NULL, }, + { "nonlinear", "feasibility", "tolerance", 0, 0, }, { 1, 0, 0, 0, 0, 0, }, 1, - NPSOL_options::set_nonlinear_feasibility_tolerance, NULL, - NPSOL_options::nonlinear_feasibility_tolerance, NULL, }, + NPSOL_options::set_nonlinear_feasibility_tolerance, 0, + NPSOL_options::nonlinear_feasibility_tolerance, 0, }, { "optimality tolerance", - { "optimality", "tolerance", NULL, NULL, NULL, NULL, }, + { "optimality", "tolerance", 0, 0, 0, 0, }, { 1, 0, 0, 0, 0, 0, }, 1, - NPSOL_options::set_optimality_tolerance, NULL, - NPSOL_options::optimality_tolerance, NULL, }, + NPSOL_options::set_optimality_tolerance, 0, + NPSOL_options::optimality_tolerance, 0, }, { "start objective check at variable", - { "start", "objective", "check", "at", "variable", NULL, }, + { "start", "objective", "check", "at", "variable", 0, }, { 3, 1, 0, 0, 0, 0, }, 2, - NULL, NPSOL_options::set_start_objective_check, - NULL, NPSOL_options::start_objective_check, }, + 0, NPSOL_options::set_start_objective_check, + 0, NPSOL_options::start_objective_check, }, { "start constraint check at variable", - { "start", "constraint", "check", "at", "variable", NULL, }, + { "start", "constraint", "check", "at", "variable", 0, }, { 3, 1, 0, 0, 0, 0, }, 2, - NULL, NPSOL_options::set_start_constraint_check, - NULL, NPSOL_options::start_constraint_check, }, + 0, NPSOL_options::set_start_constraint_check, + 0, NPSOL_options::start_constraint_check, }, { "stop objective check at variable", - { "stop", "objective", "check", "at", "variable", NULL, }, + { "stop", "objective", "check", "at", "variable", 0, }, { 3, 1, 0, 0, 0, 0, }, 2, - NULL, NPSOL_options::set_stop_objective_check, - NULL, NPSOL_options::stop_objective_check, }, + 0, NPSOL_options::set_stop_objective_check, + 0, NPSOL_options::stop_objective_check, }, { "stop constraint check at variable", - { "stop", "constraint", "check", "at", "variable", NULL, }, + { "stop", "constraint", "check", "at", "variable", 0, }, { 3, 1, 0, 0, 0, 0, }, 2, - NULL, NPSOL_options::set_stop_constraint_check, - NULL, NPSOL_options::stop_constraint_check, }, + 0, NPSOL_options::set_stop_constraint_check, + 0, NPSOL_options::stop_constraint_check, }, { "verify level", - { "verify", "level", NULL, NULL, NULL, NULL, }, + { "verify", "level", 0, 0, 0, 0, }, { 1, 0, 0, 0, 0, 0, }, 1, - NULL, NPSOL_options::set_verify_level, - NULL, NPSOL_options::verify_level, }, + 0, NPSOL_options::set_verify_level, + 0, NPSOL_options::verify_level, }, - { NULL, - { NULL, NULL, NULL, NULL, NULL, NULL, }, + { 0, + { 0, 0, 0, 0, 0, 0, }, { 0, 0, 0, 0, 0, 0, }, 0, - NULL, NULL, NULL, NULL, }, + 0, 0, 0, 0, }, }; static void @@ -647,7 +675,7 @@ NPSOL_OPTIONS *list = npsol_option_table; char *keyword; - while ((keyword = list->keyword) != (char *) NULL) + while ((keyword = list->keyword) != 0) { output_buf.form (" %-40s ", keyword); if (list->d_get_fcn) @@ -679,7 +707,7 @@ { NPSOL_OPTIONS *list = npsol_option_table; - while (list->keyword != (char *) NULL) + while (list->keyword != 0) { if (keyword_almost_match (list->kw_tok, list->min_len, keyword, list->min_toks_to_match, MAX_TOKENS)) @@ -697,11 +725,27 @@ warning ("npsol_options: no match for `%s'", keyword); } -Octave_object -npsol_options (const Octave_object& args, int nargout) +#if defined (NPSOL_MISSING) +DEFUN_DLD ("npsol_options", Fnpsol_options, Snpsol_options, -1, 1, + "This function requires NPSOL, which is not freely\n\ +redistributable. For more information, read the file\n\ +libcruft/npsol/README.MISSING in the source distribution.") +#else +DEFUN_DLD ("npsol_options", Fnpsol_options, Snpsol_options, -1, 1, + "npsol_options (KEYWORD, VALUE)\n\ +\n\ +Set or show options for npsol. Keywords may be abbreviated\n\ +to the shortest match.") +#endif { Octave_object retval; +#if defined (NPSOL_MISSING) + + print_usage ("npsol_options"); + +#else + int nargin = args.length (); if (nargin == 1) @@ -724,6 +768,8 @@ print_usage ("npsol_options"); } +#endif + return retval; }
--- a/src/qpsol.cc +++ b/src/qpsol.cc @@ -37,7 +37,7 @@ #include "error.h" #include "utils.h" #include "pager.h" -#include "f-qpsol.h" +#include "defun-dld.h" // This should probably be defined in some shared file and declared in // a header file... @@ -46,24 +46,20 @@ const ColumnVector& lub, char *warn_for, int warn); -#ifdef WITH_DLD -Octave_object -builtin_qpsol_2 (const Octave_object& args, int nargout) -{ - return qpsol (args, nargout); -} - -Octave_object -builtin_qpsol_options_2 (const Octave_object& args, int nargout) -{ - return qpsol_options (args, nargout); -} -#endif - static QPSOL_options qpsol_opts; -Octave_object -qpsol (const Octave_object& args, int nargout) +#if defined (QPSOL_MISSING) +DEFUN_DLD ("qpsol", Fqpsol, Sqpsol, 9, 3, + "This function requires QPSOL, which is not freely\n\ +redistributable. For more information, read the file\n\ +libcruft/qpsol/README.MISSING in the source distribution.") +#else +DEFUN_DLD ("qpsol", Fqpsol, Sqpsol, 9, 3, + "[X, OBJ, INFO, LAMBDA] = qpsol (X, H, C [, LB, UB] [, LB, A, UB])\n\ +\n\ +Groups of arguments surrounded in `[]' are optional, but\n\ +must appear in the same relative order shown above.") +#endif { /* @@ -76,12 +72,29 @@ */ -// Assumes that we have been given the correct number of arguments. - Octave_object retval; +#if defined (QPSOL_MISSING) + +// Force a bad value of inform, and empty matrices for x, phi, and lambda. + + retval.resize (4, Matrix ()); + + retval(2) = -1.0; + + print_usage ("qpsol"); + +#else + int nargin = args.length (); + if (nargin < 4 || nargin == 5 || nargin == 8 || nargin > 9 + || nargout > 4) + { + print_usage ("qpsol"); + return retval; + } + ColumnVector x = args(1).to_vector (); if (x.capacity () == 0) { @@ -199,6 +212,8 @@ if (nargout > 3) retval(3) = lambda; +#endif + return retval; } @@ -224,33 +239,33 @@ static QPSOL_OPTIONS qpsol_option_table [] = { { "feasibility tolerance", - { "feasibility", "tolerance", NULL, }, + { "feasibility", "tolerance", 0, }, { 1, 0, 0, }, 1, - QPSOL_options::set_feasibility_tolerance, NULL, - QPSOL_options::feasibility_tolerance, NULL, }, + QPSOL_options::set_feasibility_tolerance, 0, + QPSOL_options::feasibility_tolerance, 0, }, { "infinite bound", - { "infinite", "bound", NULL, }, + { "infinite", "bound", 0, }, { 2, 0, 0, }, 1, - QPSOL_options::set_infinite_bound, NULL, - QPSOL_options::infinite_bound, NULL, }, + QPSOL_options::set_infinite_bound, 0, + QPSOL_options::infinite_bound, 0, }, { "iteration limit", - { "iteration", "limit", NULL, }, + { "iteration", "limit", 0, }, { 2, 0, 0, }, 1, - NULL, QPSOL_options::set_iteration_limit, - NULL, QPSOL_options::iteration_limit, }, + 0, QPSOL_options::set_iteration_limit, + 0, QPSOL_options::iteration_limit, }, { "print level", - { "print", "level", NULL, }, + { "print", "level", 0, }, { 1, 0, 0, }, 1, - NULL, QPSOL_options::set_print_level, - NULL, QPSOL_options::print_level, }, + 0, QPSOL_options::set_print_level, + 0, QPSOL_options::print_level, }, - { NULL, - { NULL, NULL, NULL, }, + { 0, + { 0, 0, 0, }, { 0, 0, 0, }, 0, - NULL, NULL, NULL, NULL, }, + 0, 0, 0, 0, }, }; static void @@ -268,7 +283,7 @@ QPSOL_OPTIONS *list = qpsol_option_table; char *keyword; - while ((keyword = list->keyword) != (char *) NULL) + while ((keyword = list->keyword) != 0) { output_buf.form (" %-40s ", keyword); if (list->d_get_fcn) @@ -300,7 +315,7 @@ { QPSOL_OPTIONS *list = qpsol_option_table; - while (list->keyword != (char *) NULL) + while (list->keyword != 0) { if (keyword_almost_match (list->kw_tok, list->min_len, keyword, list->min_toks_to_match, MAX_TOKENS)) @@ -318,11 +333,27 @@ warning ("qpsol_options: no match for `%s'", keyword); } -Octave_object -qpsol_options (const Octave_object& args, int nargout) +#if defined (QPSOL_MISSING) +DEFUN_DLD ("qpsol_options", Fqpsol_options, Sqpsol_options, -1, 1, + "This function requires QPSOL, which is not freely\n\ +redistributable. For more information, read the file\n\ +libcruft/qpsol/README.MISSING in the source distribution.") +#else +DEFUN_DLD ("qpsol_options", Fqpsol_options, Sqpsol_options, -1, 1, + "qpsol_options (KEYWORD, VALUE)\n +\n\ +Set or show options for qpsol. Keywords may be abbreviated\n\ +to the shortest match.") +#endif { Octave_object retval; +#if defined (QPSOL_MISSING) + + print_usage ("qpsol"); + +#else + int nargin = args.length (); if (nargin == 1) @@ -345,6 +376,8 @@ print_usage ("qpsol_options"); } +#endif + return retval; }
--- a/src/qr.cc +++ b/src/qr.cc @@ -31,22 +31,22 @@ #include "tree-const.h" #include "user-prefs.h" #include "gripes.h" -#include "f-qr.h" +#include "defun-dld.h" -#ifdef WITH_DLD -Octave_object -builtin_qr_2 (const Octave_object& args, int nargout) +DEFUN_DLD ("qr", Fqr, Sqr, 2, 2, + "[Q, R] = qr (X): form QR factorization of X") { - return qr (args(1), nargout); -} -#endif + Octave_object retval; + + int nargin = args.length (); -Octave_object -qr (const tree_constant& a, int nargout) -{ - Octave_object retval (2); + if (nargin != 2 || nargout > 2) + { + print_usage ("qr"); + return retval; + } - tree_constant tmp = a.make_numeric ();; + tree_constant tmp = args(1).make_numeric (); int nr = tmp.rows (); int nc = tmp.columns (); @@ -59,8 +59,8 @@ if (flag < 0) gripe_empty_arg ("qr", 0); Matrix m; + retval(1) = m; retval(0) = m; - retval(1) = m; } else gripe_empty_arg ("qr", 1); @@ -74,30 +74,30 @@ { Matrix m = tmp.matrix_value (); QR fact (m); + retval(1) = fact.R (); retval(0) = fact.Q (); - retval(1) = fact.R (); } break; case tree_constant_rep::complex_matrix_constant: { ComplexMatrix m = tmp.complex_matrix_value (); ComplexQR fact (m); + retval(1) = fact.R (); retval(0) = fact.Q (); - retval(1) = fact.R (); } break; case tree_constant_rep::scalar_constant: { double d = tmp.double_value (); + retval(1) = d; retval(0) = 1.0; - retval(1) = d; } break; case tree_constant_rep::complex_scalar_constant: { Complex c = tmp.complex_value (); + retval(1) = c; retval(0) = 1.0; - retval(1) = c; } break; default:
--- a/src/quad.cc +++ b/src/quad.cc @@ -36,25 +36,11 @@ #include "error.h" #include "utils.h" #include "pager.h" -#include "f-quad.h" +#include "defun-dld.h" // Global pointer for user defined function required by quadrature functions. static tree_fvc *quad_fcn; -#ifdef WITH_DLD -Octave_object -builtin_quad_2 (const Octave_object& args, int nargout) -{ - return do_quad (args, nargout); -} - -Octave_object -builtin_quad_options_2 (const Octave_object& args, int nargout) -{ - return quad_options (args, nargout); -} -#endif - static Quad_options quad_opts; double @@ -67,7 +53,7 @@ // args(0) = name; args(1) = x; - if (quad_fcn != (tree_fvc *) NULL) + if (quad_fcn) { Octave_object tmp = quad_fcn->eval (0, 1, args); @@ -90,18 +76,33 @@ return retval; } -Octave_object -do_quad (const Octave_object& args, int nargout) +DEFUN_DLD ("quad", Fquad, Squad, 6, 3, + "[V, IER, NFUN] = quad (F, A, B [, TOL] [, SING])\n\ +\n\ +Where the first argument is the name of the function to call to\n\ +compute the value of the integrand. It must have the form\n\ +\n\ + y = f (x) +\n\ +where y and x are scalars.\n\ +\n\ +The second and third arguments are limits of integration. Either or\n\ +both may be infinite. The optional argument TOL specifies the desired\n\ +accuracy of the result. The optional argument SING is a vector of\n\ +at which the integrand is singular.") { -// Assumes that we have been given the correct number of arguments. - Octave_object retval; int nargin = args.length (); + if (nargin < 4 || nargin > 6 || nargout > 4) + { + print_usage ("quad"); + return retval; + } + quad_fcn = is_valid_function (args(1), "fsolve", 1); - if (quad_fcn == (tree_fvc *) NULL - || takes_correct_nargs (quad_fcn, 2, "fsolve", 1) != 1) + if (! quad_fcn || takes_correct_nargs (quad_fcn, 2, "fsolve", 1) != 1) return retval; double a = args(2).to_scalar (); @@ -216,21 +217,21 @@ static QUAD_OPTIONS quad_option_table [] = { { "absolute tolerance", - { "absolute", "tolerance", NULL, }, + { "absolute", "tolerance", 0, }, { 1, 0, 0, }, 1, Quad_options::set_absolute_tolerance, Quad_options::absolute_tolerance, }, { "relative tolerance", - { "relative", "tolerance", NULL, }, + { "relative", "tolerance", 0, }, { 1, 0, 0, }, 1, Quad_options::set_relative_tolerance, Quad_options::relative_tolerance, }, - { NULL, - { NULL, NULL, NULL, }, + { 0, + { 0, 0, 0, }, { 0, 0, 0, }, 0, - NULL, NULL, }, + 0, 0, }, }; static void @@ -248,7 +249,7 @@ QUAD_OPTIONS *list = quad_option_table; char *keyword; - while ((keyword = list->keyword) != (char *) NULL) + while ((keyword = list->keyword) != 0) { output_buf.form (" %-40s ", keyword); @@ -271,7 +272,7 @@ { QUAD_OPTIONS *list = quad_option_table; - while (list->keyword != (char *) NULL) + while (list->keyword != 0) { if (keyword_almost_match (list->kw_tok, list->min_len, keyword, list->min_toks_to_match, MAX_TOKENS)) @@ -286,8 +287,11 @@ warning ("quad_options: no match for `%s'", keyword); } -Octave_object -quad_options (const Octave_object& args, int nargout) +DEFUN_DLD ("quad_options", Fquad_options, Squad_options, -1, 1, + "quad_options (KEYWORD, VALUE)\n\ +\n\ +Set or show options for quad. Keywords may be abbreviated\n\ +to the shortest match.") { Octave_object retval;
--- a/src/qzval.cc +++ b/src/qzval.cc @@ -1,4 +1,4 @@ -// tc-qzval.cc -*- C++ -*- +// f-qzval.cc -*- C++ -*- /* Copyright (C) 1993, 1994 John W. Eaton @@ -38,7 +38,7 @@ #include "user-prefs.h" #include "gripes.h" #include "error.h" -#include "f-qzval.h" +#include "defun-dld.h" extern "C" { @@ -52,19 +52,22 @@ double*, double*, double*, const long*, double*); } -#ifdef WITH_DLD -Octave_object -builtin_qzvalue_2 (const Octave_object& args, int nargout) -{ - return qzvalue (args, nargout); -} -#endif - -Octave_object -qzvalue (const Octave_object& args, int nargout) +DEFUN_DLD ("qzvalue", Fqzvalue, Sqzvalue, 3, 1, + "X = qzval (A, B)\n\ +\n\ +compute generalized eigenvalues of the matrix pencil (A - lambda B).\n\ +A and B must be real matrices.") { Octave_object retval; + int nargin = args.length (); + + if (nargin != 3 || nargout > 1) + { + print_usage ("qzvalue"); + return retval; + } + tree_constant arga = args(1).make_numeric (); tree_constant argb = args(2).make_numeric();
--- a/src/rand.cc +++ b/src/rand.cc @@ -25,11 +25,13 @@ #include "config.h" #endif +#include <time.h> + #include "tree-const.h" #include "f77-uscore.h" #include "error.h" #include "utils.h" -#include "f-rand.h" +#include "defun-dld.h" // Possible distributions of random numbers. enum rand_dist { uniform, normal }; @@ -45,14 +47,6 @@ int *F77_FCN (getsd) (int*, int*); } -#ifdef WITH_DLD -Octave_object -builtin_rand_2 (const Octave_object& args, int nargout) -{ - return rand_internal (args, nargout); -} -#endif - static double curr_rand_seed (void) { @@ -98,19 +92,31 @@ else { panic_impossible (); - return (char *) NULL; + return 0; } } -Octave_object -rand_internal (const Octave_object& args, int nargout) +DEFUN_DLD ("rand", Frand, Srand, 2, 1, + "rand -- generate a random value\n\ +\n\ +rand (N) -- generate N x N matrix\n\ +rand (A) -- generate matrix the size of A\n\ +rand (N, M) -- generate N x M matrix\n\ +rand (\"dist\") -- get current distribution\n\ +rand (DISTRIBUTION) -- set distribution type (\"normal\" or \"uniform\"\n\ +rand (SEED) -- get current seed\n\ +rand (SEED, N) -- set seed") { -// Assumes that we have been given the correct number of arguments. - Octave_object retval; int nargin = args.length (); + if (nargin > 3 || nargout > 1) + { + print_usage ("rand"); + return retval; + } + static int initialized = 0; if (! initialized) {
--- a/src/schur.cc +++ b/src/schur.cc @@ -32,23 +32,31 @@ #include "user-prefs.h" #include "error.h" #include "gripes.h" -#include "f-schur.h" +#include "defun-dld.h" -#ifdef WITH_DLD -Octave_object -builtin_schur_2 (const Octave_object& args, int nargout) -{ - return schur (args, nargout); -} -#endif - -Octave_object -schur (const Octave_object& args, int nargout) +DEFUN_DLD ("schur", Fschur, Sschur, 3, 2, + "[U, S] = schur (A) or S = schur (A)\n\ +\n\ +or, for ordered Schur:\n\ +\n\ + [U, S] = schur (A, TYPE) or S = schur (A, TYPE)\n\ +where TYPE is a string that begins with one of the following\n\ +characters:\n\ +\n\ + A = continuous time poles\n\ + D = discrete time poles\n\ + U = unordered schur (default)") { Octave_object retval; int nargin = args.length (); + if (nargin == 1 || nargin > 3 || nargout > 2) + { + print_usage ("schur"); + return retval; + } + tree_constant arg = args(1).make_numeric (); char *ord;
--- a/src/sort.cc +++ b/src/sort.cc @@ -26,7 +26,7 @@ #endif #include "tree-const.h" -#include "f-sort.h" +#include "defun-dld.h" static void mx_sort (Matrix& m, Matrix& idx, int return_idx) @@ -162,12 +162,20 @@ } } -Octave_object -sort (const Octave_object& args, int nargout) +DEFUN_DLD ("sort", Fsort, Ssort, 2, 2, + "[S, I] = sort (X)\n\ +\n\ +sort the columns of X, optionally return sort index") { -// Assumes that we have been given the correct number of arguments. + Octave_object retval; + + int nargin = args.length (); - Octave_object retval; + if (nargin != 2) + { + print_usage ("sort"); + return retval; + } int return_idx = nargout > 1; if (return_idx)
--- a/src/svd.cc +++ b/src/svd.cc @@ -32,21 +32,23 @@ #include "user-prefs.h" #include "gripes.h" #include "error.h" -#include "f-svd.h" +#include "defun-dld.h" -#ifdef WITH_DLD -Octave_object -builtin_svd_2 (const Octave_object& args, int nargout) -{ - return svd (args, nargout); -} -#endif - -Octave_object -svd (const Octave_object& args, int nargout) +DEFUN_DLD ("svd", Fsvd, Ssvd, 2, 3, + "S = svd (X) or [U, S, V] = svd (X)\n\ +\n\ +compute the singular value decomposition of X") { Octave_object retval; + int nargin = args.length (); + + if (nargin != 2 || nargout == 2 || nargout > 3) + { + print_usage ("svd"); + return retval; + } + tree_constant arg = args(1).make_numeric (); if (arg.rows () == 0 || arg.columns () == 0)
--- a/src/syl.cc +++ b/src/syl.cc @@ -1,4 +1,4 @@ -// tc-syl.cc -*- C++ -*- +// f-syl.cc -*- C++ -*- /* Copyright (C) 1993, 1994 John W. Eaton @@ -37,7 +37,7 @@ #include "user-prefs.h" #include "gripes.h" #include "error.h" -#include "f-syl.h" +#include "defun-dld.h" extern "C" { @@ -54,19 +54,19 @@ long, long); } -#ifdef WITH_DLD -Octave_object -builtin_syl_2 (const Octave_object& args, int nargout) -{ - return syl (args, nargout); -} -#endif - -Octave_object -syl (const Octave_object& args, int nargout) +DEFUN_DLD ("syl", Fsyl, Ssyl, 4, 1, + "X = syl (A, B, C): solve the Sylvester equation A X + X B + C = 0") { Octave_object retval; + int nargin = args.length (); + + if (nargin != 4 || nargout > 1) + { + print_usage ("syl"); + return retval; + } + tree_constant arga = args(1).make_numeric (); tree_constant argb = args(2).make_numeric (); tree_constant argc = args(3).make_numeric ();