Mercurial > hg > octave-lyh
changeset 3998:f6df65db67f9
[project @ 2002-07-24 18:10:39 by jwe]
line wrap: on
line diff
--- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2002-07-19 John W. Eaton <jwe@bevo.che.wisc.edu> + + * mk-opts.pl: New file. + * Makefile.in (DISTFILES): Add it to the list. + 2002-07-12 John W. Eaton <jwe@bevo.che.wisc.edu> * configure.in (AC_CONFIG_FILES): Add libcruft/dasrt/Makefile to
--- a/liboctave/CMatrix.cc +++ b/liboctave/CMatrix.cc @@ -179,16 +179,16 @@ ComplexMatrix::ComplexMatrix (const boolMatrix& a) : MArray2<Complex> (a.rows (), a.cols (), 0.0) { - for (int i = 0; i < a.cols (); i++) - for (int j = 0; j < a.rows (); j++) + for (int i = 0; i < a.rows (); i++) + for (int j = 0; j < a.cols (); j++) elem (i, j) = a.elem (i, j); } ComplexMatrix::ComplexMatrix (const charMatrix& a) : MArray2<Complex> (a.rows (), a.cols (), 0.0) { - for (int i = 0; i < a.cols (); i++) - for (int j = 0; j < a.rows (); j++) + for (int i = 0; i < a.rows (); i++) + for (int j = 0; j < a.cols (); j++) elem (i, j) = a.elem (i, j); }
--- a/liboctave/ChangeLog +++ b/liboctave/ChangeLog @@ -1,3 +1,30 @@ +2002-07-22 John W. Eaton <jwe@bevo.che.wisc.edu> + + * CMatrix.cc (ComplexMatrix::ComplexMatrix (const boolMatrix&)): + Get rows and columns right in loop. + (ComplexMatrix::ComplexMatrix (const charMatrix&)): Likewise. + +2002-07-19 John W. Eaton <jwe@bevo.che.wisc.edu> + + * DASPK.cc (DASPK::do_integrate): Allow array tolerances. + * DASRT.cc (DASRT::integrate): Likewise. + * DASSL.cc (DASSL::do_integrate): Likewise. + + * Quad.cc: Don't pass tolerances in constructors. + + * DASPK-opts.in, DASRT-opts.in, DASSL-opts.in, LSODE-opts.in, + NLeqn-opts.in, ODESSA-opts.in, Quad-opts.in: New files. + * DASPK-opts.h, DASRT-opts.h, DASSL-opts.h, LSODE-opts.h, + NLeqn-opts.h, ODESSA-opts.h, Quad-opts.h: Generate automatically + from corresponding .in files. + * LSODE.h, Quad.h: Replace options class definitions with included + file. + * Makefile.in (OPTS_INC_SRC, OPTS_INC): New variables, new rule to + create OPTS_INC files from OPTS_INC_SRC files. + (stamp-prereq): New target. + (libraries): Depend on stamp-prereq. + Include stamp-prereq along with $(MAKEDEPS). + 2002-07-17 John W. Eaton <jwe@bevo.che.wisc.edu> * base-de.h (base_diff_eqn::istate): New data member.
new file mode 100644 --- /dev/null +++ b/liboctave/DASPK-opts.in @@ -0,0 +1,62 @@ +CLASS = "DASPK" + +OPTION + NAME = "absolute tolerance" + TYPE = "Array<double>" + SET_ARG_TYPE = "const $TYPE&" + INIT_BODY + $OPTVAR.resize (1); + $OPTVAR(0) = ::sqrt (DBL_EPSILON); + END_INIT_BODY + SET_CODE + void set_$OPT (double val) + { + $OPTVAR.resize (1); + $OPTVAR(0) = (val > 0.0) ? val : ::sqrt (DBL_EPSILON); + } + + void set_$OPT (const $TYPE& val) + { $OPTVAR = val; } + END_SET_CODE +END_OPTION + +OPTION + NAME = "relative tolerance" + TYPE = "Array<double>" + SET_ARG_TYPE = "const $TYPE&" + INIT_BODY + $OPTVAR.resize (1); + $OPTVAR(0) = ::sqrt (DBL_EPSILON); + END_INIT_BODY + SET_CODE + void set_$OPT (double val) + { + $OPTVAR.resize (1); + $OPTVAR(0) = (val > 0.0) ? val : ::sqrt (DBL_EPSILON); + } + + void set_$OPT (const $TYPE& val) + { $OPTVAR = val; } + END_SET_CODE +END_OPTION + +OPTION + NAME = "initial step size" + TYPE = "double" + INIT_VALUE = "-1.0" + SET_EXPR = "(val >= 0.0) ? val : -1.0" +END_OPTION + +OPTION + NAME = "maximum step size" + TYPE = "double" + INIT_VALUE = "-1.0" + SET_EXPR = "(val >= 0.0) ? val : -1.0" +END_OPTION + +OPTION + NAME = "minimum step size" + TYPE = "double" + INIT_VALUE = "0.0" + SET_EXPR = "(val >= 0.0) ? val : 0.0" +END_OPTION
--- a/liboctave/DASPK.cc +++ b/liboctave/DASPK.cc @@ -53,7 +53,7 @@ extern "C" int F77_FUNC (ddaspk, DDASPK) (daspk_fcn_ptr, const int&, double&, double*, double*, double&, const int*, - const double&, const double&, int&, + const double*, const double*, int&, double*, const int&, int*, const int&, const double*, const int*, daspk_jac_ptr, daspk_psol_ptr); @@ -240,8 +240,28 @@ else info.elem (3) = 0; - double abs_tol = absolute_tolerance (); - double rel_tol = relative_tolerance (); + Array<double> abs_tol = absolute_tolerance (); + Array<double> rel_tol = relative_tolerance (); + + int abs_tol_len = abs_tol.length (); + int rel_tol_len = rel_tol.length (); + + if (abs_tol_len == 1 && rel_tol_len == 1) + { + info.elem (1) = 0; + } + else if (abs_tol_len == n && rel_tol_len == n) + { + info.elem (1) = 1; + } + else + { + (*current_liboctave_error_handler) + ("dassl: inconsistent sizes for tolerance arrays"); + + integration_error = true; + return retval; + } if (initial_step_size () >= 0.0) { @@ -265,11 +285,13 @@ int *pinfo = info.fortran_vec (); int *piwork = iwork.fortran_vec (); double *prwork = rwork.fortran_vec (); + double *pabs_tol = abs_tol.fortran_vec (); + double *prel_tol = rel_tol.fortran_vec (); // again: F77_XFCN (ddaspk, DDASPK, (ddaspk_f, n, t, px, pxdot, tout, pinfo, - rel_tol, abs_tol, istate, prwork, lrw, + prel_tol, pabs_tol, istate, prwork, lrw, piwork, liw, dummy, idummy, ddaspk_j, ddaspk_psol));
--- a/liboctave/DASPK.h +++ b/liboctave/DASPK.h @@ -32,79 +32,7 @@ #include "DAE.h" -class -DASPK_options -{ -public: - - DASPK_options (void) { init (); } - - DASPK_options (const DASPK_options& opt) { copy (opt); } - - DASPK_options& operator = (const DASPK_options& opt) - { - if (this != &opt) - copy (opt); - - return *this; - } - - ~DASPK_options (void) { } - - void init (void) - { - double sqrt_eps = ::sqrt (DBL_EPSILON); - x_absolute_tolerance = sqrt_eps; - x_initial_step_size = -1.0; - x_maximum_step_size = -1.0; - x_minimum_step_size = 0.0; - x_relative_tolerance = sqrt_eps; - } - - void copy (const DASPK_options& opt) - { - x_absolute_tolerance = opt.x_absolute_tolerance; - x_initial_step_size = opt.x_initial_step_size; - x_maximum_step_size = opt.x_maximum_step_size; - x_minimum_step_size = opt.x_minimum_step_size; - x_relative_tolerance = opt.x_relative_tolerance; - } - - void set_default_options (void) { init (); } - - void set_absolute_tolerance (double val) - { x_absolute_tolerance = (val > 0.0) ? val : ::sqrt (DBL_EPSILON); } - - void set_initial_step_size (double val) - { x_initial_step_size = (val >= 0.0) ? val : -1.0; } - - void set_maximum_step_size (double val) - { x_maximum_step_size = (val >= 0.0) ? val : -1.0; } - - void set_minimum_step_size (double val) - { x_minimum_step_size = (val >= 0.0) ? val : 0.0; } - - void set_relative_tolerance (double val) - { x_relative_tolerance = (val > 0.0) ? val : ::sqrt (DBL_EPSILON); } - - double absolute_tolerance (void) { return x_absolute_tolerance; } - - double initial_step_size (void) { return x_initial_step_size; } - - double maximum_step_size (void) { return x_maximum_step_size; } - - double minimum_step_size (void) { return x_minimum_step_size; } - - double relative_tolerance (void) { return x_relative_tolerance; } - -private: - - double x_absolute_tolerance; - double x_initial_step_size; - double x_maximum_step_size; - double x_minimum_step_size; - double x_relative_tolerance; -}; +#include "DASPK-opts.h" class DASPK : public DAE, public DASPK_options
new file mode 100644 --- /dev/null +++ b/liboctave/DASRT-opts.in @@ -0,0 +1,69 @@ +CLASS = "DASRT" + +OPTION + NAME = "absolute tolerance" + TYPE = "Array<double>" + SET_ARG_TYPE = "const $TYPE&" + INIT_BODY + $OPTVAR.resize (1); + $OPTVAR(0) = ::sqrt (DBL_EPSILON); + END_INIT_BODY + SET_CODE + void set_$OPT (double val) + { + $OPTVAR.resize (1); + $OPTVAR(0) = (val > 0.0) ? val : ::sqrt (DBL_EPSILON); + } + + void set_$OPT (const $TYPE& val) + { $OPTVAR = val; } + END_SET_CODE +END_OPTION + +OPTION + NAME = "relative tolerance" + TYPE = "Array<double>" + SET_ARG_TYPE = "const $TYPE&" + INIT_BODY + $OPTVAR.resize (1); + $OPTVAR(0) = ::sqrt (DBL_EPSILON); + END_INIT_BODY + SET_CODE + void set_$OPT (double val) + { + $OPTVAR.resize (1); + $OPTVAR(0) = (val > 0.0) ? val : ::sqrt (DBL_EPSILON); + } + + void set_$OPT (const $TYPE& val) + { $OPTVAR = val; } + END_SET_CODE +END_OPTION + +OPTION + NAME = "initial step size" + TYPE = "double" + INIT_VALUE = "-1.0" + SET_EXPR = "(val >= 0.0) ? val : -1.0" +END_OPTION + +OPTION + NAME = "maximum step size" + TYPE = "double" + INIT_VALUE = "-1.0" + SET_EXPR = "(val >= 0.0) ? val : -1.0" +END_OPTION + +OPTION + NAME = "minimum step size" + TYPE = "double" + INIT_VALUE = "0.0" + SET_EXPR = "(val >= 0.0) ? val : 0.0" +END_OPTION + +OPTION + NAME = "step limit" + TYPE = "int" + INIT_VALUE = "-1" + SET_EXPR = "(val >= 0) ? val : -1" +END_OPTION
--- a/liboctave/DASRT.cc +++ b/liboctave/DASRT.cc @@ -65,7 +65,7 @@ extern "C" int F77_FUNC (ddasrt, DASRT) (dasrt_fcn_ptr, const int&, double&, double*, double*, const double&, int*, - double*, double*, int&, double*, + const double*, const double*, int&, double*, const int&, int*, const int&, double*, int*, dasrt_jac_ptr, dasrt_constr_ptr, const int&, int*); @@ -265,6 +265,26 @@ abs_tol = absolute_tolerance (); rel_tol = relative_tolerance (); + int abs_tol_len = abs_tol.length (); + int rel_tol_len = rel_tol.length (); + + if (abs_tol_len == 1 && rel_tol_len == 1) + { + info.elem (1) = 0; + } + else if (abs_tol_len == n && rel_tol_len == n) + { + info.elem (1) = 1; + } + else + { + (*current_liboctave_error_handler) + ("dassl: inconsistent sizes for tolerance arrays"); + + integration_error = true; + return; + } + if (initial_step_size () >= 0.0) { rwork(2) = initial_step_size (); @@ -291,6 +311,8 @@ pinfo = info.fortran_vec (); piwork = iwork.fortran_vec (); + pabs_tol = abs_tol.fortran_vec (); + prel_tol = rel_tol.fortran_vec (); prwork = rwork.fortran_vec (); pjroot = jroot.fortran_vec (); @@ -316,7 +338,7 @@ int *idummy = 0; F77_XFCN (ddasrt, DASRT, (ddasrt_f, n, t, px, pxdot, tout, pinfo, - &rel_tol, &abs_tol, istate, prwork, lrw, + prel_tol, pabs_tol, istate, prwork, lrw, piwork, liw, dummy, idummy, ddasrt_j, ddasrt_g, ng, pjroot));
--- a/liboctave/DASRT.h +++ b/liboctave/DASRT.h @@ -32,87 +32,7 @@ #include "DAERT.h" -class -DASRT_options -{ -public: - - DASRT_options (void) { init (); } - - DASRT_options (const DASRT_options& opt) { copy (opt); } - - DASRT_options& operator = (const DASRT_options& opt) - { - if (this != &opt) - copy (opt); - - return *this; - } - - ~DASRT_options (void) { } - - void init (void) - { - double sqrt_eps = ::sqrt (DBL_EPSILON); - x_absolute_tolerance = sqrt_eps; - x_initial_step_size = -1.0; - x_maximum_step_size = -1.0; - x_minimum_step_size = 0.0; - x_relative_tolerance = sqrt_eps; - x_step_limit = -1; - } - - void copy (const DASRT_options& opt) - { - x_absolute_tolerance = opt.x_absolute_tolerance; - x_initial_step_size = opt.x_initial_step_size; - x_maximum_step_size = opt.x_maximum_step_size; - x_minimum_step_size = opt.x_minimum_step_size; - x_relative_tolerance = opt.x_relative_tolerance; - x_step_limit = opt.x_step_limit; - } - - void set_default_options (void) { init (); } - - void set_absolute_tolerance (double val) - { x_absolute_tolerance = (val > 0.0) ? val : ::sqrt (DBL_EPSILON); } - - void set_initial_step_size (double val) - { x_initial_step_size = (val >= 0.0) ? val : -1.0; } - - void set_maximum_step_size (double val) - { x_maximum_step_size = (val >= 0.0) ? val : -1.0; } - - void set_minimum_step_size (double val) - { x_minimum_step_size = (val >= 0.0) ? val : 0.0; } - - void set_relative_tolerance (double val) - { x_relative_tolerance = (val > 0.0) ? val : ::sqrt (DBL_EPSILON); } - - void set_step_limit (int val) - { x_step_limit = (val >= 0) ? val : -1; } - - double absolute_tolerance (void) { return x_absolute_tolerance; } - - double initial_step_size (void) { return x_initial_step_size; } - - double maximum_step_size (void) { return x_maximum_step_size; } - - double minimum_step_size (void) { return x_minimum_step_size; } - - double relative_tolerance (void) { return x_relative_tolerance; } - - int step_limit (void) { return x_step_limit; } - -private: - - double x_absolute_tolerance; - double x_initial_step_size; - double x_maximum_step_size; - double x_minimum_step_size; - double x_relative_tolerance; - int x_step_limit; -}; +#include "DASRT-opts.h" class DASRT_result @@ -190,11 +110,13 @@ Array<double> rwork; - double abs_tol; - double rel_tol; + Array<double> abs_tol; + Array<double> rel_tol; double *px; double *pxdot; + double *pabs_tol; + double *prel_tol; int *pinfo; int *piwork; double *prwork;
new file mode 100644 --- /dev/null +++ b/liboctave/DASSL-opts.in @@ -0,0 +1,62 @@ +CLASS = "DASSL" + +OPTION + NAME = "absolute tolerance" + TYPE = "Array<double>" + SET_ARG_TYPE = "const $TYPE&" + INIT_BODY + $OPTVAR.resize (1); + $OPTVAR(0) = ::sqrt (DBL_EPSILON); + END_INIT_BODY + SET_CODE + void set_$OPT (double val) + { + $OPTVAR.resize (1); + $OPTVAR(0) = (val > 0.0) ? val : ::sqrt (DBL_EPSILON); + } + + void set_$OPT (const $TYPE& val) + { $OPTVAR = val; } + END_SET_CODE +END_OPTION + +OPTION + NAME = "relative tolerance" + TYPE = "Array<double>" + SET_ARG_TYPE = "const $TYPE&" + INIT_BODY + $OPTVAR.resize (1); + $OPTVAR(0) = ::sqrt (DBL_EPSILON); + END_INIT_BODY + SET_CODE + void set_$OPT (double val) + { + $OPTVAR.resize (1); + $OPTVAR(0) = (val > 0.0) ? val : ::sqrt (DBL_EPSILON); + } + + void set_$OPT (const $TYPE& val) + { $OPTVAR = val; } + END_SET_CODE +END_OPTION + +OPTION + NAME = "initial step size" + TYPE = "double" + INIT_VALUE = "-1.0" + SET_EXPR = "(val >= 0.0) ? val : -1.0" +END_OPTION + +OPTION + NAME = "maximum step size" + TYPE = "double" + INIT_VALUE = "-1.0" + SET_EXPR = "(val >= 0.0) ? val : -1.0" +END_OPTION + +OPTION + NAME = "minimum step size" + TYPE = "double" + INIT_VALUE = "0.0" + SET_EXPR = "(val >= 0.0) ? val : 0.0" +END_OPTION
--- a/liboctave/DASSL.cc +++ b/liboctave/DASSL.cc @@ -44,7 +44,7 @@ extern "C" int F77_FUNC (ddassl, DDASSL) (dassl_fcn_ptr, const int&, double&, double*, double*, double&, const int*, - const double&, const double&, int&, + const double*, const double*, int&, double*, const int&, int*, const int&, const double*, const int*, dassl_jac_ptr); @@ -214,8 +214,28 @@ else info.elem (3) = 0; - double abs_tol = absolute_tolerance (); - double rel_tol = relative_tolerance (); + Array<double> abs_tol = absolute_tolerance (); + Array<double> rel_tol = relative_tolerance (); + + int abs_tol_len = abs_tol.length (); + int rel_tol_len = rel_tol.length (); + + if (abs_tol_len == 1 && rel_tol_len == 1) + { + info.elem (1) = 0; + } + else if (abs_tol_len == n && rel_tol_len == n) + { + info.elem (1) = 1; + } + else + { + (*current_liboctave_error_handler) + ("dassl: inconsistent sizes for tolerance arrays"); + + integration_error = true; + return retval; + } if (initial_step_size () >= 0.0) { @@ -239,11 +259,13 @@ int *pinfo = info.fortran_vec (); int *piwork = iwork.fortran_vec (); double *prwork = rwork.fortran_vec (); + double *pabs_tol = abs_tol.fortran_vec (); + double *prel_tol = rel_tol.fortran_vec (); // again: F77_XFCN (ddassl, DDASSL, (ddassl_f, n, t, px, pxdot, tout, pinfo, - rel_tol, abs_tol, istate, prwork, lrw, + prel_tol, pabs_tol, istate, prwork, lrw, piwork, liw, dummy, idummy, ddassl_j)); if (f77_exception_encountered)
--- a/liboctave/DASSL.h +++ b/liboctave/DASSL.h @@ -32,79 +32,7 @@ #include "DAE.h" -class -DASSL_options -{ -public: - - DASSL_options (void) { init (); } - - DASSL_options (const DASSL_options& opt) { copy (opt); } - - DASSL_options& operator = (const DASSL_options& opt) - { - if (this != &opt) - copy (opt); - - return *this; - } - - ~DASSL_options (void) { } - - void init (void) - { - double sqrt_eps = ::sqrt (DBL_EPSILON); - x_absolute_tolerance = sqrt_eps; - x_initial_step_size = -1.0; - x_maximum_step_size = -1.0; - x_minimum_step_size = 0.0; - x_relative_tolerance = sqrt_eps; - } - - void copy (const DASSL_options& opt) - { - x_absolute_tolerance = opt.x_absolute_tolerance; - x_initial_step_size = opt.x_initial_step_size; - x_maximum_step_size = opt.x_maximum_step_size; - x_minimum_step_size = opt.x_minimum_step_size; - x_relative_tolerance = opt.x_relative_tolerance; - } - - void set_default_options (void) { init (); } - - void set_absolute_tolerance (double val) - { x_absolute_tolerance = (val > 0.0) ? val : ::sqrt (DBL_EPSILON); } - - void set_initial_step_size (double val) - { x_initial_step_size = (val >= 0.0) ? val : -1.0; } - - void set_maximum_step_size (double val) - { x_maximum_step_size = (val >= 0.0) ? val : -1.0; } - - void set_minimum_step_size (double val) - { x_minimum_step_size = (val >= 0.0) ? val : 0.0; } - - void set_relative_tolerance (double val) - { x_relative_tolerance = (val > 0.0) ? val : ::sqrt (DBL_EPSILON); } - - double absolute_tolerance (void) { return x_absolute_tolerance; } - - double initial_step_size (void) { return x_initial_step_size; } - - double maximum_step_size (void) { return x_maximum_step_size; } - - double minimum_step_size (void) { return x_minimum_step_size; } - - double relative_tolerance (void) { return x_relative_tolerance; } - -private: - - double x_absolute_tolerance; - double x_initial_step_size; - double x_maximum_step_size; - double x_minimum_step_size; - double x_relative_tolerance; -}; +#include "DASSL-opts.h" class DASSL : public DAE, public DASSL_options
new file mode 100644 --- /dev/null +++ b/liboctave/LSODE-opts.in @@ -0,0 +1,72 @@ +CLASS = "LSODE" + +OPTION + NAME = "absolute tolerance" + TYPE = "Array<double>" + SET_ARG_TYPE = "const $TYPE&" + INIT_BODY + $OPTVAR.resize (1); + $OPTVAR(0) = ::sqrt (DBL_EPSILON); + END_INIT_BODY + SET_CODE + void set_$OPT (double val) + { + $OPTVAR.resize (1); + $OPTVAR(0) = (val > 0.0) ? val : ::sqrt (DBL_EPSILON); + } + + void set_$OPT (const $TYPE& val) + { $OPTVAR = val; } + END_SET_CODE +END_OPTION + +OPTION + NAME = "integration method" + TYPE = "std::string" + SET_ARG_TYPE = "const $TYPE&" + INIT_VALUE = ""stiff"" + SET_BODY + if (val == "stiff" || val == "bdf") + $OPTVAR = "stiff"; + else if (val == "non-stiff" || val == "adams") + $OPTVAR = "non-stiff"; + else + (*current_liboctave_error_handler) + ("lsode_options: method must be \"stiff\", \"bdf\", \"non-stiff\", or \"adams\""); + END_SET_BODY +END_OPTION + +OPTION + NAME = "initial step size" + TYPE = "double" + INIT_VALUE = "-1.0" + SET_EXPR = "(val >= 0.0) ? val : -1.0" +END_OPTION + +OPTION + NAME = "maximum step size" + TYPE = "double" + INIT_VALUE = "-1.0" + SET_EXPR = "(val >= 0.0) ? val : -1.0" +END_OPTION + +OPTION + NAME = "minimum step size" + TYPE = "double" + INIT_VALUE = "0.0" + SET_EXPR = "(val >= 0.0) ? val : 0.0" +END_OPTION + +OPTION + NAME = "relative tolerance" + TYPE = "double" + INIT_VALUE = "::sqrt (DBL_EPSILON)" + SET_EXPR = "(val > 0.0) ? val : ::sqrt (DBL_EPSILON)" +END_OPTION + +OPTION + NAME = "step limit" + TYPE = "int" + INIT_VALUE = "100000" + SET_EXPR = "val" +END_OPTION
--- a/liboctave/LSODE.cc +++ b/liboctave/LSODE.cc @@ -37,18 +37,6 @@ #include "f77-fcn.h" #include "lo-error.h" -void -LSODE_options::set_integration_method (const std::string& val) -{ - if (val == "stiff" || val == "bdf") - x_integration_method = "stiff"; - else if (val == "non-stiff" || val == "adams") - x_integration_method = "non-stiff"; - else - (*current_liboctave_error_handler) - ("lsode_options: method must be \"stiff\", \"bdf\", \"non-stiff\", or \"adams\""); -} - typedef int (*lsode_fcn_ptr) (const int&, const double&, double*, double*, int&);
--- a/liboctave/LSODE.h +++ b/liboctave/LSODE.h @@ -32,113 +32,7 @@ #include "ODE.h" -class -LSODE_options -{ -public: - - LSODE_options (void) { init (); } - - LSODE_options (const LSODE_options& opt) { copy (opt); } - - LSODE_options& operator = (const LSODE_options& opt) - { - if (this != &opt) - copy (opt); - - return *this; - } - - ~LSODE_options (void) { } - - void init (void) - { - double sqrt_eps = ::sqrt (DBL_EPSILON); - x_absolute_tolerance.resize (1); - x_absolute_tolerance(0) = sqrt_eps; - x_initial_step_size = -1.0; - x_integration_method = "stiff"; - x_maximum_step_size = -1.0; - x_minimum_step_size = 0.0; - x_relative_tolerance = sqrt_eps; - - // This is consistent with earlier versions of Octave, and is - // much larger than the default of 500 specified in the LSODE - // sources. - x_step_limit = 100000; - } - - void copy (const LSODE_options& opt) - { - x_absolute_tolerance = opt.x_absolute_tolerance; - x_initial_step_size = opt.x_initial_step_size; - x_integration_method = opt.x_integration_method; - x_maximum_step_size = opt.x_maximum_step_size; - x_minimum_step_size = opt.x_minimum_step_size; - x_relative_tolerance = opt.x_relative_tolerance; - x_step_limit = opt.x_step_limit; - } - - void set_default_options (void) { init (); } - - void set_absolute_tolerance (double val) - { - x_absolute_tolerance.resize (1); - x_absolute_tolerance(0) = (val > 0.0) ? val : ::sqrt (DBL_EPSILON); - } - - void set_absolute_tolerance (const Array<double>& val) - { x_absolute_tolerance = val; } - - void set_initial_step_size (double val) - { x_initial_step_size = (val >= 0.0) ? val : -1.0; } - - void set_integration_method (const std::string& val); - - void set_maximum_step_size (double val) - { x_maximum_step_size = (val >= 0.0) ? val : -1.0; } - - void set_minimum_step_size (double val) - { x_minimum_step_size = (val >= 0.0) ? val : 0.0; } - - void set_relative_tolerance (double val) - { x_relative_tolerance = (val > 0.0) ? val : ::sqrt (DBL_EPSILON); } - - void set_step_limit (int val) - { x_step_limit = val; } - - Array<double> absolute_tolerance (void) const - { return x_absolute_tolerance; } - - double initial_step_size (void) const - { return x_initial_step_size; } - - std::string integration_method (void) const - { return x_integration_method; } - - double maximum_step_size (void) const - { return x_maximum_step_size; } - - double minimum_step_size (void) const - { return x_minimum_step_size; } - - double relative_tolerance (void) const - { return x_relative_tolerance; } - - int step_limit (void) const - { return x_step_limit; } - -private: - - Array<double> x_absolute_tolerance; - double x_initial_step_size; - std::string x_integration_method; - double x_maximum_step_size; - double x_minimum_step_size; - double x_relative_tolerance; - - int x_step_limit; -}; +#include "LSODE-opts.h" class LSODE : public ODE, public LSODE_options
--- a/liboctave/Makefile.in +++ b/liboctave/Makefile.in @@ -44,6 +44,11 @@ vx-rv-cs.h vx-s-ccv.h vx-s-crv.h \ vx-rv-crv.h vx-cv-ccv.h vx-crv-rv.h vx-ccv-cv.h +OPTS_INC_DATA := DASPK-opts.in DASRT-opts.in DASSL-opts.in \ + LSODE-opts.in NLEqn-opts.in ODESSA-opts.in Quad-opts.in + +OPTS_INC := $(OPTS_INC_DATA:.in=.h) + INCLUDES := Bounds.h CollocWt.h DAE.h DAEFunc.h DAERT.h DAERTFunc.h \ DASPK.h DASRT.h DASSL.h FEGrid.h LinConst.h \ LP.h LPsolve.h LSODE.h NLConst.h NLEqn.h NLFunc.h NLP.h \ @@ -57,6 +62,7 @@ oct-rl-hist.h oct-shlib.h oct-syscalls.h oct-time.h \ pathlen.h pathsearch.h prog-args.h statdefs.h str-vec.h\ sun-utils.h sysdir.h systime.h syswait.h \ + $(OPTS_INC) \ $(MATRIX_INC) \ $(MX_OP_INC) \ $(VX_OP_INC) @@ -129,7 +135,8 @@ INCLUDES_FOR_INSTALL := $(INCLUDES) $(TEMPLATE_SRC) $(EXTRAS) -DISTFILES := Makefile.in ChangeLog $(SOURCES) $(INCLUDES) $(EXTRAS) +DISTFILES := Makefile.in ChangeLog $(SOURCES) $(INCLUDES) $(EXTRAS) \ + $(OPTS_INC_SRC) ifeq ($(SHARED_LIBS), true) BINDISTLIBS = liboctave/liboctave @@ -184,14 +191,19 @@ mkdir pic; \ fi +stamp-prereq: $(OPTS_INC) + touch stamp-prereq + ifeq ($(SHARED_LIBS), true) ifeq ($(STATIC_LIBS), true) libraries: \ + stamp-prereq \ liboctave.$(LIBEXT) liboctave.$(SHLEXT) \ liboct-readline.$(LIBEXT) liboct-readline.$(SHLEXT) \ liboct-pathsearch.$(LIBEXT) liboct-pathsearch.$(SHLEXT) else libraries: \ + stamp-prereq \ liboctave.$(SHLEXT) \ liboct-readline.$(SHLEXT) \ liboct-pathsearch.$(SHLEXT) @@ -199,11 +211,12 @@ else ifeq ($(STATIC_LIBS), true) libraries: \ + stamp-prereq \ liboctave.$(LIBEXT) \ liboct-readline.$(LIBEXT) \ liboct-pathsearch.$(LIBEXT) else - libraries: + libraries: stamp-prereq endif endif .PHONY: libraries @@ -365,6 +378,16 @@ fi .PHONY: bin-dist +$(OPTS_INC) : %.h : %.in $(top_srcdir)/mk-opts.pl + @echo making $@ from $< + @perl $(top_srcdir)/mk-opts.pl --opt-class-header $< > $@.t + @$(top_srcdir)/move-if-change $@.t $@ + +# If missing, GNU make attempts to create them in the reverse of the +# order in which they are listed here. We rely on that fact to ensure +# that defaults.h is created before trying to create the .d files. +# Hmm. I wonder if we can count on that... + ifndef omit_deps --include $(MAKEDEPS) +-include $(MAKEDEPS) stamp-prereq endif
new file mode 100644 --- /dev/null +++ b/liboctave/NLEqn-opts.in @@ -0,0 +1,18 @@ +CLASS = "NLEqn" + +FCN_NAME = "fsolve" + +DOC_STRING +When called with two arguments, this function allows you set options +parameters for the function @code{fsolve}. Given one argument, +@code{fsolve_options} returns the value of the corresponding option. If +no arguments are supplied, the names of all the available options and +their current values are displayed. +END_DOC_STRING + +OPTION + NAME = "tolerance" + TYPE = "double" + INIT_VALUE = "::sqrt (DBL_EPSILON)" + SET_EXPR = "(val > 0.0) ? val : ::sqrt (DBL_EPSILON)" +END_OPTION
--- a/liboctave/NLEqn.h +++ b/liboctave/NLEqn.h @@ -33,41 +33,7 @@ #include "dColVector.h" #include "NLFunc.h" -class -NLEqn_options -{ -public: - - NLEqn_options (void) - : x_tolerance (::sqrt (DBL_EPSILON)) { } - - NLEqn_options (const NLEqn_options& opt) - : x_tolerance (opt.x_tolerance) { } - - NLEqn_options& operator = (const NLEqn_options& opt) - { - if (this != &opt) - x_tolerance = opt.x_tolerance; - - return *this; - } - - ~NLEqn_options (void) { } - - void set_default_options (void) { x_tolerance = ::sqrt (DBL_EPSILON); } - - void set_options (const NLEqn_options& opt) - { x_tolerance = opt.x_tolerance; } - - void set_tolerance (double val) - { x_tolerance = (val > 0.0) ? val : ::sqrt (DBL_EPSILON); } - - double tolerance (void) { return x_tolerance; } - -private: - - double x_tolerance; -}; +#include "NLEqn-opts.h" class NLEqn : public NLFunc, public NLEqn_options
new file mode 100644 --- /dev/null +++ b/liboctave/ODESSA-opts.in @@ -0,0 +1,73 @@ +CLASS = "ODESSA" + +OPTION + NAME = "absolute tolerance" + TYPE = "Array<double>" + SET_ARG_TYPE = "const $TYPE&" + INIT_BODY + $OPTVAR.resize (1); + $OPTVAR(0) = ::sqrt (DBL_EPSILON); + END_INIT_BODY + SET_CODE + void set_$OPT (double val) + { + $OPTVAR.resize (1); + $OPTVAR(0) = (val > 0.0) ? val : ::sqrt (DBL_EPSILON); + } + + void set_$OPT (const $TYPE& val) + { $OPTVAR = val; } + END_SET_CODE +END_OPTION + +OPTION + NAME = "integration method" + TYPE = "std::string" + SET_ARG_TYPE = "const $TYPE&" + INIT_VALUE = {"stiff"} + SET_BODY + if (val == "stiff" || val == "bdf") + $OPTVAR = "stiff"; + else if (val == "non-stiff" || val == "adams") + $OPTVAR = "non-stiff"; + else + (*current_liboctave_error_handler) + ("lsode_options: method must be \"stiff\", \"bdf\", \"non-stiff\", or \"adams\""); + END_SET_BODY +END_OPTION + +OPTION + NAME = "initial step size" + TYPE = "double" + INIT_VALUE = "-1.0" + SET_EXPR = "(val >= 0.0) ? val : -1.0" +END_OPTION + +OPTION + NAME = "maximum step size" + TYPE = "double" + INIT_VALUE = "-1.0" + SET_EXPR = "(val >= 0.0) ? val : -1.0" +END_OPTION + +OPTION + NAME = "minimum step size" + TYPE = "double" + INIT_VALUE = "0.0" + SET_EXPR = "(val >= 0.0) ? val : 0.0" +END_OPTION + +OPTION + NAME = "relative tolerance" + TYPE = "double" + INIT_VALUE = "::sqrt (DBL_EPSILON)" + SET_EXPR = "(val > 0.0) ? val : ::sqrt (DBL_EPSILON)" +END_OPTION + +OPTION + NAME = "step limit" + TYPE = "int" + INIT_VALUE = "100000" + SET_EXPR = "val" +END_OPTION +
--- a/liboctave/ODESSA.cc +++ b/liboctave/ODESSA.cc @@ -51,21 +51,6 @@ #include "utils.h" #include "variables.h" -#ifndef F77_FUNC -#define F77_FUNC(x, X) F77_FCN (x, X) -#endif -void -ODESSA_options::set_integration_method (const std::string& val) -{ - if (val == "stiff" || val == "bdf") - x_integration_method = "stiff"; - else if (val == "non-stiff" || val == "adams") - x_integration_method = "non-stiff"; - else - (*current_liboctave_error_handler) - ("odessa_options: method must be \"stiff\", \"bdf\", \"non-stiff\", or \"adams\""); -} - typedef int (*odessa_fcn_ptr) (int*, const double&, double*, double*, double*);
--- a/liboctave/ODESSA.h +++ b/liboctave/ODESSA.h @@ -32,115 +32,7 @@ #include "ODES.h" -class -ODESSA_options -{ -public: - - ODESSA_options (void) { init (); } - - ODESSA_options (const ODESSA_options& opt) { copy (opt); } - - ODESSA_options& operator = (const ODESSA_options& opt) - { - if (this != &opt) - copy (opt); - - return *this; - } - - ~ODESSA_options (void) { } - - void init (void) - { - double sqrt_eps = ::sqrt (DBL_EPSILON); - x_absolute_tolerance.resize (1); - x_absolute_tolerance(0) = sqrt_eps; - x_initial_step_size = -1.0; - x_integration_method = "stiff"; - x_maximum_step_size = -1.0; - x_minimum_step_size = 0.0; - x_relative_tolerance = sqrt_eps; - - // This is consistent with earlier versions of Octave, and is - // much larger than the default of 500 specified in the LSODE - // sources. - x_step_limit = 100000; - } - - void copy (const ODESSA_options& opt) - { - x_absolute_tolerance = opt.x_absolute_tolerance; - x_initial_step_size = opt.x_initial_step_size; - x_integration_method = opt.x_integration_method; - x_maximum_step_size = opt.x_maximum_step_size; - x_minimum_step_size = opt.x_minimum_step_size; - x_relative_tolerance = opt.x_relative_tolerance; - x_step_limit = opt.x_step_limit; - } - - void set_default_options (void) { init (); } - - void set_absolute_tolerance (double val) - { - x_absolute_tolerance.resize (1); - x_absolute_tolerance(0) = (val > 0.0) ? val : ::sqrt (DBL_EPSILON); - } - - void set_absolute_tolerance (const Array<double>& val) - { x_absolute_tolerance = val; } - - void set_initial_step_size (double val) - { x_initial_step_size = (val >= 0.0) ? val : -1.0; } - - void set_integration_method (const std::string& val); - - - void set_maximum_step_size (double val) - { x_maximum_step_size = (val >= 0.0) ? val : -1.0; } - - void set_minimum_step_size (double val) - { x_minimum_step_size = (val >= 0.0) ? val : 0.0; } - - void set_relative_tolerance (double val) - { x_relative_tolerance = (val > 0.0) ? val : ::sqrt (DBL_EPSILON); } - - void set_step_limit (int val) - { x_step_limit = val; } - - Array<double> absolute_tolerance (void) const - { return x_absolute_tolerance; } - - double initial_step_size (void) const - { return x_initial_step_size; } - - std::string integration_method (void) const - { return x_integration_method; } - - double maximum_step_size (void) const - { return x_maximum_step_size; } - - double minimum_step_size (void) const - { return x_minimum_step_size; } - - double relative_tolerance (void) const - { return x_relative_tolerance; } - - int step_limit (void) const - { return x_step_limit; } - -private: - - Array<double> x_absolute_tolerance; - double x_initial_step_size; - std::string x_integration_method; - double x_maximum_step_size; - double x_minimum_step_size; - double x_relative_tolerance; - - int x_step_limit; -}; - +#include "ODESSA-opts.h" class ODESSA_result
new file mode 100644 --- /dev/null +++ b/liboctave/Quad-opts.in @@ -0,0 +1,15 @@ +CLASS = "Quad" + +OPTION + NAME = "absolute tolerance" + TYPE = "double" + INIT_VALUE = "::sqrt (DBL_EPSILON)" + SET_EXPR = "val" +END_OPTION + +OPTION + NAME = "relative tolerance" + TYPE = "double" + INIT_VALUE = "::sqrt (DBL_EPSILON)" + SET_EXPR = "val" +END_OPTION
--- a/liboctave/Quad.h +++ b/liboctave/Quad.h @@ -45,59 +45,7 @@ // function, and the user wants us to quit. extern int quad_integration_error; -class -Quad_options -{ - public: - - Quad_options (void) { init (); } - - // XXX FIXME XXX -- check for invalid values? - Quad_options (double abs, double rel) - : x_absolute_tolerance (abs), x_relative_tolerance (rel) { } - - Quad_options (const Quad_options& opt) - : x_absolute_tolerance (opt.x_absolute_tolerance), - x_relative_tolerance (opt.x_relative_tolerance) { } - - Quad_options& operator = (const Quad_options& opt) - { - if (this != &opt) - set_options (opt); - - return *this; - } - - ~Quad_options (void) { } - - void init (void) - { - double sqrt_eps = ::sqrt (DBL_EPSILON); - - x_absolute_tolerance = sqrt_eps; - x_relative_tolerance = sqrt_eps; - } - - void set_default_options (void) { init (); } - - void set_options (const Quad_options& opt) - { - x_absolute_tolerance = opt.x_absolute_tolerance; - x_relative_tolerance = opt.x_relative_tolerance; - } - - // XXX FIXME XXX -- check for invalid values? - void set_absolute_tolerance (double val) { x_absolute_tolerance = val; } - void set_relative_tolerance (double val) { x_relative_tolerance = val; } - - double absolute_tolerance (void) { return x_absolute_tolerance; } - double relative_tolerance (void) { return x_relative_tolerance; } - - private: - - double x_absolute_tolerance; - double x_relative_tolerance; -}; +#include "Quad-opts.h" class Quad : public Quad_options @@ -107,9 +55,6 @@ Quad (integrand_fcn fcn) : Quad_options (), f (fcn) { } - Quad (integrand_fcn fcn, double abs, double rel) - : Quad_options (abs, rel), f (fcn) { } - virtual ~Quad (void) { } virtual double integrate (void) @@ -155,30 +100,15 @@ DefQuad (integrand_fcn fcn, double ll, double ul) : Quad (fcn), lower_limit (ll), upper_limit (ul), singularities () { } - DefQuad (integrand_fcn fcn, double ll, double ul, double abs, - double rel) - : Quad (fcn, abs, rel), lower_limit (ll), upper_limit (ul), - singularities () { } - DefQuad (integrand_fcn fcn, double ll, double ul, const ColumnVector& sing) : Quad (fcn), lower_limit (ll), upper_limit (ul), singularities (sing) { } - DefQuad (integrand_fcn fcn, const ColumnVector& sing, double abs, - double rel) - : Quad (fcn, abs, rel), lower_limit (0.0), upper_limit (1.0), - singularities (sing) { } - DefQuad (integrand_fcn fcn, const ColumnVector& sing) : Quad (fcn), lower_limit (0.0), upper_limit (1.0), singularities (sing) { } - DefQuad (integrand_fcn fcn, double ll, double ul, const ColumnVector& sing, - double abs, double rel) - : Quad (fcn, abs, rel), lower_limit (ll), upper_limit (ul), - singularities (sing) { } - ~DefQuad (void) { } double do_integrate (int& ier, int& neval, double& abserr); @@ -204,13 +134,6 @@ IndefQuad (integrand_fcn fcn, double b, IntegralType t) : Quad (fcn), bound (b), type (t) { } - IndefQuad (integrand_fcn fcn, double b, IntegralType t, double abs, - double rel) - : Quad (fcn, abs, rel), bound (b), type (t) { } - - IndefQuad (integrand_fcn fcn, double abs, double rel) - : Quad (fcn, abs, rel), bound (0.0), type (bound_to_inf) { } - ~IndefQuad (void) { } double do_integrate (int& ier, int& neval, double& abserr);
new file mode 100644 --- /dev/null +++ b/mk-opts.pl @@ -0,0 +1,944 @@ +#! /usr/bin/perl + +# Generate option handling code from a simpler input files for +# Octave's functions like lsode, dassl, etc. + +# Input file format: +# +# CLASS = string +# FCN_NAME = string +# DOC_STRING doc END_DOC_STRING +# OPTION +# NAME = string +# TYPE = string +# SET_ARG_TYPE = string (optional, defaults to TYPE) +# INIT_VALUE = string | INIT_BODY code END_INIT_BODY +# SET_EXPR = string | SET_BODY code END_SET_BODY | SET_CODE code END_SET_CODE +# END_OPTION +# +# END_* must appear at beginning of line (whitespace ignored). + +use Getopt::Long; + +$opt_emit_opt_class_header = 0; +$opt_emit_opt_handler_fcns = 0; +$opt_debug = 0; + +GetOptions ("opt-class-header" => \$opt_emit_opt_class_header, + "opt-handler-fcns" => \$opt_emit_opt_handler_fcns, + "debug" => \$opt_debug); + +if (@ARGV == 1) + { + $INFILE = shift @ARGV; + open (INFILE) || die "unable to open input file $INFILE"; + } +else + { + die "usage: mk-opts.pl [options] FILE"; + } + +$opt_num = 0; + +&parse_input; + +&process_data; + +FOO: + { + $opt_emit_opt_class_header && do { &emit_opt_class_header; last FOO; }; + + $opt_emit_opt_handler_fcns && do { &emit_opt_handler_fcns; last FOO; }; + + $opt_debug && do { &emit_options_debug; last FOO; }; + } + +sub parse_input +{ + local ($have_doc_string); + + while (<INFILE>) + { + next if (/^\s*$/); + + if (/^\s*OPTION\s*$/) + { + &parse_option_block; + } + elsif (/^\s*CLASS\s*=\s*"(\w+)"\s*$/) + { + die "duplicate CLASS" if ($class ne ""); + $CLASS = $1; + $class_name = "${CLASS}_options"; + $struct_name = "${class_name}_struct"; + $static_table_name = "${class_name}_table"; + } + elsif (/^\s*FCN_NAME\s*=\s*"(\w+)"\s*$/) + { + die "duplicate FCN_NAME" if ($fcn_name ne ""); + $fcn_name = $1; + } + elsif (/^\s*DOC_STRING\s*$/) + { + die "duplicate DOC_STRING" if ($have_doc_string); + &parse_doc_string; + $have_doc_string = 1; + } + } +} + +sub parse_option_block +{ + local ($have_init_body, $have_set_body, $have_set_code); + + while (<INFILE>) + { + next if (/^\s*$/); + + die "missing END_OPTION" if (/^\s*OPTION\s*$/); + + last if (/^\s*END_OPTION\s*$/); + + if (/^\s*NAME\s*=\s*"(.*)"\s*$/) + { + die "duplicate NAME" if ($name[$opt_num] ne ""); + $name[$opt_num] = $1; + ($opt[$opt_num] = $name[$opt_num]) =~ s/\s+/_/g; + $optvar[$opt_num] = "x_$opt[$opt_num]"; + $kw_tok[$opt_num] = [ split (/\s+/, $name[$opt_num]) ]; + $n_toks[$opt_num] = @{$kw_tok[$opt_num]}; + } + elsif (/^\s*TYPE\s*=\s*"(.*)"\s*$/) + { + die "duplicate TYPE" if ($type[$opt_num] ne ""); + $type[$opt_num] = $1; + } + elsif (/^\s*SET_ARG_TYPE\s*=\s*"(.*)"\s*$/) + { + die "duplicate SET_ARG_TYPE" if ($set_arg_type[$opt_num] ne ""); + $set_arg_type[$opt_num] = $1; + } + elsif (/^\s*INIT_VALUE\s*=\s*"(.*)"\s*$/) + { + die "duplicate INIT_VALUE" if ($init_value[$opt_num] ne ""); + $init_value[$opt_num] = $1; + } + elsif (/^\s*SET_EXPR\s*=\s*"(.*)"\s*$/) + { + die "duplicate SET_EXPR" if ($set_expr[$opt_num] ne ""); + $set_expr[$opt_num] = $1; + } + elsif (/^\s*INIT_BODY\s*$/) + { + die "duplicate INIT_BODY" if ($have_init_body); + &parse_init_body; + $have_init_body = 1; + } + elsif (/^\s*SET_BODY\s*$/) + { + die "duplicate SET_BODY" if ($have_set_body); + &parse_set_body; + $have_set_body = 1; + } + elsif (/^\s*SET_CODE\s*$/) + { + die "duplicate SET_CODE" if ($have_set_code); + &parse_set_code; + $have_set_code = 1; + } + } + + if ($set_arg_type[$opt_num] eq "") + { + $set_arg_type[$opt_num] = $type[$opt_num] + } + else + { + $set_arg_type[$opt_num] + = &substopt ($set_arg_type[$opt_num], $optvar[$opt_num], + $opt[$opt_num], $type[$opt_num]); + } + + $opt_num++; +} + +sub process_data +{ + @uniq_types = &get_uniq_types (@type); + @uniq_set_arg_types = &get_uniq_types (@set_arg_type); + + @get_type_num = &get_uniq_type_num (*type, *uniq_types); + @set_type_num = &get_uniq_type_num (*set_arg_type, *uniq_set_arg_types); + + $max_tokens = &max (@n_toks); + + &get_min_match_len_info ($max_tokens); + + $fcn_name = lc ($CLASS) if ($fcn_name eq ""); + + $opt_fcn_name = "${fcn_name}_options" if ($opt_fcn_name eq ""); + + $static_object_name = "${fcn_name}_opts"; + + if ($doc_string eq "") + { + $doc_string = "When called with two arguments, this function\\n\\ +allows you set options parameters for the function \@code{$fcn_name}.\\n\\ +Given one argument, \@code{$opt_fcn_name} returns the value of the\\n\\ +corresponding option. If no arguments are supplied, the names of all\\n\\ +the available options and their current values are displayed.\\n\\\n"; + } +} + +sub get_uniq_types +{ + local ($k, $i, @retval, %u); + + $k = 0; + + for ($i = 0; $i < $opt_num; $i++) + { + local ($x); + $x = $_[$i]; + $u{$x}++; + $retval[$k++] = $x if ($u{$x} == 1); + } + + @retval; +} + +sub get_uniq_type_num +{ + local (*t, *ut) = @_; + + local ($k, $i, @retval); + + for ($i = 0; $i < $opt_num; $i++) + { + for $k (0 .. $#ut) + { + $retval[$i] = $k if ($t[$i] eq $ut[$k]); + } + } + + @retval; +} + +sub get_min_match_len_info +{ + local ($max_tokens) = @_; + + local ($i, $j, $k); + + for ($i = 0; $i < $opt_num; $i++) + { + for ($j = 0; $j < $max_tokens; $j++) + { + $min_tok_len_to_match[$i][$j] = 0; + } + + $min_toks_to_match[$i] = 1; + + L1: for ($k = 0; $k < $opt_num; $k++) + { + local ($duplicate) = 1; + + if ($i != $k) + { + L2: for ($j = 0; $j < $max_tokens; $j++) + { + if ($j < $n_toks[$i]) + { + if ($kw_tok[$i][$j] eq $kw_tok[$k][$j]) + { + if ($min_tok_len_to_match[$i][$j] == 0) + { + $min_tok_len_to_match[$i][$j] = 1; + } + + $min_toks_to_match[$i]++; + } + else + { + $duplicate = 0; + + if ($min_tok_len_to_match[$i][$j] == 0) + { + $min_tok_len_to_match[$i][$j] = 1; + } + + local (@s) = split (//, $kw_tok[$i][$j]); + local (@t) = split (//, $kw_tok[$k][$j]); + + local ($n, $ii); + $n = scalar (@s); + $n = scalar (@t) if (@t < $n); + + for ($ii = 0; $ii < $n; $ii++) + { + if ("$s[$ii]" eq "$t[$ii]") + { + if ($ii + 2 > $min_tok_len_to_match[$i][$j]) + { + $min_tok_len_to_match[$i][$j]++; + } + } + else + { + last L2; + } + } + + last L1; + } + } + else + { + die "ambiguous options \"$name[$i]\" and \"$name[$k]\"" if ($duplicate); + } + } + } + } + } +} + +sub parse_doc_string +{ + while (<INFILE>) + { + last if (/^\s*END_DOC_STRING\s*$/); + + $doc_string .= $_; + } + + $doc_string =~ s/\n/\\n\\\n/g; +} + +sub parse_init_body +{ + while (<INFILE>) + { + last if (/^\s*END_INIT_BODY\s*$/); + + $init_body[$opt_num] .= $_; + } +} + +sub parse_set_body +{ + while (<INFILE>) + { + last if (/^\s*END_SET_BODY\s*$/); + + $set_body[$opt_num] .= $_; + } +} + +sub parse_set_code +{ + while (<INFILE>) + { + last if (/^\s*END_SET_CODE\s*$/); + + $set_code[$opt_num] .= $_; + } +} + +sub emit_opt_class_header +{ + local ($i, $s); + + print "// DO NOT EDIT! +// Generated automatically from $INFILE. + +#if !defined (octave_${class_name}_h) +#define octave_${class_name}_h 1 + +#include <cfloat> +#include <cmath> + +class +${class_name} +{ +public: + + ${class_name} (void) { init (); } + + ${class_name} (const ${class_name}& opt) { copy (opt); } + + ${class_name}& operator = (const ${class_name}& opt) + { + if (this != &opt) + copy (opt); + + return *this; + } + + ~${class_name} (void) { }\n"; + + print "\n void init (void)\n {\n"; + + for ($i = 0; $i < $opt_num; $i++) + { + if ($init_value[$i]) + { + print " $optvar[$i] = $init_value[$i];\n"; + } + elsif ($init_body[$i]) + { + $s = &substopt ($init_body[$i], $optvar[$i], $opt[$i], $type[$i]); + chop ($s); + $s =~ s/^\s*/ /g; + $s =~ s/\n\s*/\n /g; + print "$s\n"; + } + } + + print " }\n"; + + print "\n void copy (const ${class_name}& opt)\n {\n"; + + for ($i = 0; $i < $opt_num; $i++) + { + print " $optvar[$i] = opt.$optvar[$i];\n"; + } + + print " }\n"; + + print "\n void set_default_options (void) { init (); }\n"; + + for ($i = 0; $i < $opt_num; $i++) + { + if ($set_expr[$i]) + { + &emit_set_decl ($i); + + print "\n { $optvar[$i] = $set_expr[$i]; }\n"; + } + elsif ($set_body[$i]) + { + &emit_set_decl ($i); + + $s = &substopt ($set_body[$i], $optvar[$i], $opt[$i], $type[$i]); + chop ($s); + $s =~ s/^/ /g; + $s =~ s/\n/\n /g; + print "\n {\n$s\n }\n"; + } + elsif ($set_code[$i]) + { + $s = &substopt ($set_code[$i], $optvar[$i], $opt[$i], $type[$i]); + chop ($s); + $s =~ s/^ //g; + $s =~ s/\n /\n/g; + print "\n$s\n"; + } + } + + for ($i = 0; $i < $opt_num; $i++) + { + print " $type[$i] $opt[$i] (void) const\n { return $optvar[$i]; }\n\n"; + } + + print "private:\n\n"; + + for ($i = 0; $i < $opt_num; $i++) + { + print " $type[$i] $optvar[$i];\n"; + } + + print "};\n\n#endif\n"; +} + +sub emit_set_decl +{ + local ($i) = @_; + + print " + void set_$opt[$i] ($set_arg_type[$i] val)"; +} + +sub emit_opt_handler_fcns +{ + local ($i); + + print "// DO NOT EDIT!\n// Generated automatically from $INFILE.\n\n"; + + print "#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#include <iomanip> +#include <iostream> + +#include \"defun-dld.h\" +#include \"pr-output.h\" + +static ${class_name} ${static_object_name};\n\n"; + + &emit_set_mf_typedefs (@uniq_set_arg_types); + + &emit_get_mf_typedefs (@uniq_types); + + &emit_struct_decl; + + &emit_struct_def; + + &emit_print_function; + + &emit_set_functions; + + &emit_show_function; + + &emit_options_function; +} + +sub emit_set_mf_typedefs +{ + local ($k) = 0; + + foreach (@_) + { + print "typedef void (${class_name}::*set_opt_mf_$k) ($_[$k]);\n"; + $k++; + } + + print "\n"; +} + +sub emit_get_mf_typedefs +{ + local ($k) = 0; + + foreach (@_) + { + print "typedef $_[$k] (${class_name}::*get_opt_mf_$k) (void) const;\n"; + $k++; + } + + print "\n"; +} + +sub emit_struct_decl +{ + local ($i); + + print "#define MAX_TOKENS $max_tokens\n\n"; + + print "struct ${struct_name}\n{\n"; + + print " const char *keyword;\n"; + print " const char *kw_tok[MAX_TOKENS + 1];\n"; + print " int min_len[MAX_TOKENS + 1];\n"; + print " int min_toks_to_match;\n"; + + foreach $i (0 .. $#uniq_set_arg_types) + { + print " set_opt_mf_$i set_fcn_$i;\n"; + } + + foreach $i (0 .. $#uniq_set_arg_types) + { + print " get_opt_mf_$i get_fcn_$i;\n"; + } + + print "};\n\n"; +} + +sub emit_struct_def +{ + local ($i); + + print "#define NUM_OPTIONS $opt_num\n\n"; + + print "static ${struct_name} ${static_table_name} [] =\n{\n"; + + for ($i = 0; $i < $opt_num; $i++) + { + &emit_option_table_entry ($i, 0); + + if ($i < $opt_num - 1) + { + print "\n"; + } + } + + &emit_option_table_entry ($i, 1); + + print "};\n\n"; +} + +sub emit_option_table_entry +{ + local ($i, $empty) = @_; + + local ($k); + + if ($empty) + { + print " { 0,\n"; + } + else + { + print " { \"$name[$i]\",\n"; + } + + local ($n) = scalar $#{$kw_tok[$i]}; + print " {"; + for $k (0 .. $max_tokens) + { + if ($empty || $k > $n) + { + print " 0,"; + } + else + { + print " \"$kw_tok[$i][$k]\","; + } + } + print " },\n"; + + print " {"; + for $k (0 .. $max_tokens) + { + if ($empty || $k > $n) + { + print " 0,"; + } + else + { + print " $min_tok_len_to_match[$i][$k],"; + } + } + print " }, $min_toks_to_match[$i], "; + + print " "; + for $k (0 .. $#uniq_set_arg_types) + { + if ($empty || $k != $set_type_num[$i]) + { + print "0, "; + } + else + { + print "&${class_name}::set_$opt[$i], "; + } + } + + print "\n "; + for $k (0 .. $#uniq_types) + { + if ($empty || $k != $get_type_num[$i]) + { + print "0, "; + } + else + { + print "&${class_name}::$opt[$i], "; + } + } + + print "},\n"; +} + +sub emit_print_function +{ + local ($i); + + print "static void +print_${class_name} (std::ostream& os) +{ + print_usage (\"$opt_fcn_name\", 1); + + os << \"\\n\" + << \"Options for $CLASS include:\\n\\n\" + << \" keyword value\\n\" + << \" ------- -----\\n\"; + + $struct_name *list = $static_table_name;\n\n"; + + for ($i = 0; $i < $opt_num; $i++) + { + print " {\n os << \" \" + << std::setiosflags (std::ios::left) << std::setw (40) + << list[$i].keyword + << std::resetiosflags (std::ios::left) + << \" \";\n\n"; + + if ($type[$i] eq "double") + { + print " double val = $static_object_name.$opt[$i] ();\n\n"; + print " os << val << \"\\n\";\n"; + } + elsif ($type[$i] eq "int") + { + print " int val = $static_object_name.$opt[$i] ();\n\n"; + print " os << val << \"\\n\";\n"; + } + elsif ($type[$i] eq "std::string") + { + print " os << $static_object_name.$opt[$i] () << \"\\n\";\n"; + } + elsif ($type[$i] eq "Array<double>") + { + print " Array<double> val = $static_object_name.$opt[$i] ();\n\n"; + print " if (val.length () == 1) + { + os << val(0) << \"\\n\"; + } + else + { + os << \"\\n\\n\"; + Matrix tmp = Matrix (ColumnVector (val)); + octave_print_internal (os, tmp, false, 2); + os << \"\\n\\n\"; + }\n"; + } + else + { + die ("unknown type $type[$i]"); + } + + print " }\n\n"; + } + + print " os << \"\\n\";\n}\n\n"; +} + +sub emit_set_functions +{ + print "static void +set_${class_name} (const std::string& keyword, const octave_value& val) +{ + $struct_name *list = $static_table_name;\n\n"; + + $iftok = "if"; + + for ($i = 0; $i < $opt_num; $i++) + { + $iftok = "else if" if ($i > 0); + + print " $iftok (keyword_almost_match (list[$i].kw_tok, list[$i].min_len, + keyword, list[$i].min_toks_to_match, MAX_TOKENS)) + {\n"; + + if ($type[$i] eq "double") + { + print " double tmp = val.double_value ();\n\n"; + print " if (! error_state) + $static_object_name.set_$opt[$i] (tmp);\n"; + } + elsif ($type[$i] eq "int") + { + print " int tmp = val.int_value ();\n\n"; + print " if (! error_state) + $static_object_name.set_$opt[$i] (tmp);\n"; + } + elsif ($type[$i] eq "std::string") + { + print " std::string tmp = val.string_value ();\n\n"; + print " if (! error_state) + $static_object_name.set_$opt[$i] (tmp);\n"; + } + elsif ($type[$i] eq "Array<double>") + { + print " Array<double> tmp = val.vector_value ();\n\n"; + print " if (! error_state) + $static_object_name.set_$opt[$i] (tmp);\n"; + } + else + { + die ("unknown type $type[$i]"); + } + + print " }\n"; + } + + print " else + { + warning (\"$opt_fcn_name: no match for `%s'\", keyword.c_str ()); + } +}\n\n"; +} + +sub emit_show_function +{ + local ($i, $iftok); + + print "static octave_value_list +show_${class_name} (const std::string& keyword) +{ + octave_value retval; + + $struct_name *list = $static_table_name;\n\n"; + + $iftok = "if"; + + for ($i = 0; $i < $opt_num; $i++) + { + $iftok = "else if" if ($i > 0); + + print " $iftok (keyword_almost_match (list[$i].kw_tok, list[$i].min_len, + keyword, list[$i].min_toks_to_match, MAX_TOKENS)) + {\n"; + + if ($type[$i] eq "double") + { + print " double val = $static_object_name.$opt[$i] ();\n\n"; + print " retval = val;\n"; + } + elsif ($type[$i] eq "int") + { + print " int val = $static_object_name.$opt[$i] ();\n\n"; + print " retval = static_cast<double> (val);\n"; + } + elsif ($type[$i] eq "std::string") + { + print " retval = $static_object_name.$opt[$i] ();\n"; + } + elsif ($type[$i] eq "Array<double>") + { + print " Array<double> val = $static_object_name.$opt[$i] ();\n\n"; + print " if (val.length () == 1) + { + retval = val(0); + } + else + { + retval = ColumnVector (val); + }\n"; + } + else + { + die ("unknown type $type[$i]"); + } + + print " }\n"; + } + + print " else + { + warning (\"$opt_fcn_name: no match for `%s'\", keyword.c_str ()); + } + + return retval;\n}\n\n"; +} + +sub emit_options_function +{ + print "DEFUN_DLD ($opt_fcn_name, args, , + \"-*- texinfo -*-\\n\\ +\@deftypefn {Loadable Function} {} $opt_fcn_name (\@var{opt}, \@var{val})\\n\\ +$doc_string\@end deftypefn\") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 0) + { + print_${class_name} (octave_stdout); + } + else if (nargin == 1 || nargin == 2) + { + std::string keyword = args(0).string_value (); + + if (! error_state) + { + if (nargin == 1) + retval = show_${class_name} (keyword); + else + set_${class_name} (keyword, args(1)); + } + else + error (\"$opt_fcn_name: expecting keyword as first argument\"); + } + else + print_usage (\"$opt_fcn_name\"); + + return retval; +}"; +} + +sub emit_options_debug +{ + print "CLASS = \"$class\"\n"; + + for ($i = 0; $i < $opt_num; $i++) + { + $NAME = $name[$i]; + ($OPT = $NAME) =~ s/\s+/_/g; + $OPTVAR = "x_$OPT"; + $TYPE = $type[$i]; + print "\n"; + print "OPTION\n"; + print " NAME = \"$NAME\"\n"; + print " TYPE = \"$TYPE\"\n"; + if ($set_arg_type[$i]) + { + print eval ("\" SET_ARG_TYPE = \\\"$set_arg_type[$i]\\\"\"") . "\n"; + } + if ($init_value[$i]) + { + print " INIT_VALUE = \"$init_value[$i]\"\n"; + } + if ($init_body[$i]) + { + print " INIT_BODY\n"; + print &substopt ($init_body[$i]); + print " END_INIT_BODY\n"; + } + if ($set_expr[$i]) + { + print " SET_EXPR = \"$set_expr[$i]\"\n"; + } + if ($set_body[$i]) + { + print " SET_BODY\n"; + print &substopt ($set_body[$i]); + print " END_SET_BODY\n"; + } + if ($set_code[$i]) + { + print " SET_CODE\n"; + print &substopt ($set_code[$i]); + print " END_SET_CODE\n"; + } + print "END_OPTION\n"; + } +} + +sub substopt +{ + local ($string, $OPTVAR, $OPT, $TYPE) = @_; + + $string =~ s/\$OPTVAR/$OPTVAR/g; + $string =~ s/\$OPT/$OPT/g; + $string =~ s/\$TYPE/$TYPE/g; + + $string; +} + +sub print_assoc_array +{ + local (%t) = @_; + + local ($k); + + foreach $k (keys (%t)) + { + print "$k: $t{$k}\n"; + } +} + +sub max +{ + local ($max) = shift; + + foreach (@_) + { + $max = $_ if $max < $_; + } + + $max; +}
--- a/octMakefile.in +++ b/octMakefile.in @@ -27,8 +27,8 @@ BUGS COPYING FLEX.patch INSTALL INSTALL.OCTAVE NEWS NEWS.[0-9] \ PROJECTS README README.Linux README.Windows README.MachTen ROADMAP \ SENDING-PATCHES THANKS move-if-change octave-sh octave-bug.in \ - octave-config.in install-octave.in mkinstalldirs mkoctfile.in \ - texi2dvi ChangeLog ChangeLog.[0-9] + octave-config.in install-octave.in mk-opts.pl mkinstalldirs \ + mkoctfile.in texi2dvi ChangeLog ChangeLog.[0-9] # Complete directory trees to distribute. DISTDIRS = glob kpathsea # plplot
--- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,22 @@ +2002-07-24 John W. Eaton <jwe@bevo.che.wisc.edu> + + * Makefile.in (OPT_HANDLERS): New targets. + + * DLD-FUNCTIONS/daspk.cc, DLD-FUNCTIONS/dasrt.cc, + DLD-FUNCTIONS/dassl.cc, DLD-FUNCTIONS/fsolve.cc, + DLD-FUNCTIONS/lsode.cc, DLD-FUNCTIONS/odessa.cc + DLD-FUNCTIONS/quad.cc: Replace option handling code with include + directive. + +2002-07-22 John W. Eaton <jwe@bevo.che.wisc.edu> + + * pt-loop.cc (tree_simple_for_command::eval): Once we know the RHS + is a matrix type check for real_type, not real_matrix. + +2002-07-19 John W. Eaton <jwe@bevo.che.wisc.edu> + + * DLD-FUNCTIONS/quad.cc (quad): Cope with changes to Quad constructors. + 2002-07-17 John W. Eaton <jwe@bevo.che.wisc.edu> * DLD-FUNCTIONS/daspk.cc (Fdaspk): Also return istate and error
--- a/src/DLD-FUNCTIONS/daspk.cc +++ b/src/DLD-FUNCTIONS/daspk.cc @@ -41,11 +41,11 @@ #include "utils.h" #include "variables.h" +#include "DASPK-opts.cc" + // Global pointer for user defined function required by daspk. static octave_function *daspk_fcn; -static DASPK_options daspk_opts; - // Is this a recursive call? static int call_depth = 0; @@ -275,180 +275,6 @@ return retval; } -typedef void (DASPK_options::*d_set_opt_mf) (double); -typedef double (DASPK_options::*d_get_opt_mf) (void); - -#define MAX_TOKENS 3 - -struct DASPK_OPTIONS -{ - const char *keyword; - const char *kw_tok[MAX_TOKENS + 1]; - int min_len[MAX_TOKENS + 1]; - int min_toks_to_match; - d_set_opt_mf d_set_fcn; - d_get_opt_mf d_get_fcn; -}; - -static DASPK_OPTIONS daspk_option_table [] = -{ - { "absolute tolerance", - { "absolute", "tolerance", 0, 0, }, - { 1, 0, 0, 0, }, 1, - &DASPK_options::set_absolute_tolerance, - &DASPK_options::absolute_tolerance, }, - - { "initial step size", - { "initial", "step", "size", 0, }, - { 1, 0, 0, 0, }, 1, - &DASPK_options::set_initial_step_size, - &DASPK_options::initial_step_size, }, - - { "maximum step size", - { "maximum", "step", "size", 0, }, - { 2, 0, 0, 0, }, 1, - &DASPK_options::set_maximum_step_size, - &DASPK_options::maximum_step_size, }, - - { "relative tolerance", - { "relative", "tolerance", 0, 0, }, - { 1, 0, 0, 0, }, 1, - &DASPK_options::set_relative_tolerance, - &DASPK_options::relative_tolerance, }, - - { 0, - { 0, 0, 0, 0, }, - { 0, 0, 0, 0, }, 0, - 0, 0, }, -}; - -static void -print_daspk_option_list (std::ostream& os) -{ - print_usage ("daspk_options", 1); - - os << "\n" - << "Options for daspk include:\n\n" - << " keyword value\n" - << " ------- -----\n\n"; - - DASPK_OPTIONS *list = daspk_option_table; - - const char *keyword; - while ((keyword = list->keyword) != 0) - { - os << " " - << std::setiosflags (std::ios::left) << std::setw (40) - << keyword - << std::resetiosflags (std::ios::left) - << " "; - - double val = (daspk_opts.*list->d_get_fcn) (); - if (val < 0.0) - os << "computed automatically"; - else - os << val; - - os << "\n"; - list++; - } - - os << "\n"; -} - -static void -set_daspk_option (const std::string& keyword, double val) -{ - DASPK_OPTIONS *list = daspk_option_table; - - while (list->keyword != 0) - { - if (keyword_almost_match (list->kw_tok, list->min_len, keyword, - list->min_toks_to_match, MAX_TOKENS)) - { - (daspk_opts.*list->d_set_fcn) (val); - - return; - } - list++; - } - - warning ("daspk_options: no match for `%s'", keyword.c_str ()); -} - -static octave_value_list -show_daspk_option (const std::string& keyword) -{ - octave_value retval; - - DASPK_OPTIONS *list = daspk_option_table; - - while (list->keyword != 0) - { - if (keyword_almost_match (list->kw_tok, list->min_len, keyword, - list->min_toks_to_match, MAX_TOKENS)) - { - double val = (daspk_opts.*list->d_get_fcn) (); - if (val < 0.0) - retval = "computed automatically"; - else - retval = val; - - return retval; - } - list++; - } - - warning ("daspk_options: no match for `%s'", keyword.c_str ()); - - return retval; -} - -DEFUN_DLD (daspk_options, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} daspk_options (@var{opt}, @var{val})\n\ -When called with two arguments, this function allows you set options\n\ -parameters for the function @code{lsode}. Given one argument,\n\ -@code{daspk_options} returns the value of the corresponding option. If\n\ -no arguments are supplied, the names of all the available options and\n\ -their current values are displayed.\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 0) - { - print_daspk_option_list (octave_stdout); - return retval; - } - else if (nargin == 1 || nargin == 2) - { - std::string keyword = args(0).string_value (); - - if (! error_state) - { - if (nargin == 1) - return show_daspk_option (keyword); - else - { - double val = args(1).double_value (); - - if (! error_state) - { - set_daspk_option (keyword, val); - return retval; - } - } - } - } - - print_usage ("daspk_options"); - - return retval; -} - /* ;;; Local Variables: *** ;;; mode: C++ ***
--- a/src/DLD-FUNCTIONS/dasrt.cc +++ b/src/DLD-FUNCTIONS/dasrt.cc @@ -42,13 +42,13 @@ #include "utils.h" #include "variables.h" +#include "DASRT-opts.cc" + // Global pointers for user defined function required by dassl. static octave_function *dasrt_f; static octave_function *dasrt_j; static octave_function *dasrt_cf; -static DASRT_options dasrt_opts; - // Is this a recursive call? static int call_depth = 0; @@ -476,219 +476,6 @@ return retval; } -typedef void (DASRT_options::*d_set_opt_mf) (double); -typedef void (DASRT_options::*i_set_opt_mf) (int); -typedef double (DASRT_options::*d_get_opt_mf) (void); -typedef int (DASRT_options::*i_get_opt_mf) (void); - -#define MAX_TOKENS 3 - -struct DASRT_OPTIONS -{ - const char *keyword; - const char *kw_tok[MAX_TOKENS + 1]; - int min_len[MAX_TOKENS + 1]; - int min_toks_to_match; - d_set_opt_mf d_set_fcn; - i_set_opt_mf i_set_fcn; - d_get_opt_mf d_get_fcn; - i_get_opt_mf i_get_fcn; -}; - -static DASRT_OPTIONS dasrt_option_table [] = -{ - { "absolute tolerance", - { "absolute", "tolerance", 0, 0, }, - { 1, 0, 0, 0, }, 1, - &DASRT_options::set_absolute_tolerance, 0, - &DASRT_options::absolute_tolerance, 0, }, - - { "initial step size", - { "initial", "step", "size", 0, }, - { 1, 0, 0, 0, }, 1, - &DASRT_options::set_initial_step_size, 0, - &DASRT_options::initial_step_size, 0, }, - - { "maximum step size", - { "maximum", "step", "size", 0, }, - { 2, 0, 0, 0, }, 1, - &DASRT_options::set_maximum_step_size, 0, - &DASRT_options::maximum_step_size, 0, }, - - { "minimum step size", - { "minimum", "step", "size", 0, }, - { 2, 0, 0, 0, }, 1, - &DASRT_options::set_minimum_step_size, 0, - &DASRT_options::minimum_step_size, 0, }, - - { "relative tolerance", - { "relative", "tolerance", 0, 0, }, - { 1, 0, 0, 0, }, 1, - &DASRT_options::set_relative_tolerance, 0, - &DASRT_options::relative_tolerance, 0, }, - - { "step limit", - { "step", "limit", 0, 0, }, - { 1, 0, 0, 0, }, 1, - 0, &DASRT_options::set_step_limit, - 0, &DASRT_options::step_limit, }, - - { 0, - { 0, 0, 0, 0, }, - { 0, 0, 0, 0, }, 0, - 0, 0, 0, 0, }, -}; - -static void -print_dasrt_option_list (ostream& os) -{ - print_usage ("dasrt_options", 1); - - os << "\n" - << "Options for dasrt include:\n\n" - << " keyword value\n" - << " ------- -----\n\n"; - - DASRT_OPTIONS *list = dasrt_option_table; - - const char *keyword; - while ((keyword = list->keyword) != 0) - { - os.form (" %-40s ", keyword); - - if (list->d_get_fcn) - { - double val = (dasrt_opts.*list->d_get_fcn) (); - if (val < 0.0) - os << "computed automatically"; - else - os << val; - } - else - { - int val = (dasrt_opts.*list->i_get_fcn) (); - if (val < 0) - os << "computed automatically"; - else - os << val; - } - os << "\n"; - list++; - } - - os << "\n"; -} - -static void -set_dasrt_option (const string& keyword, double val) -{ - DASRT_OPTIONS *list = dasrt_option_table; - - while (list->keyword != 0) - { - if (keyword_almost_match (list->kw_tok, list->min_len, keyword, - list->min_toks_to_match, MAX_TOKENS)) - { - if (list->d_set_fcn) - (dasrt_opts.*list->d_set_fcn) (val); - else - { - if (xisnan (val)) - { - error ("dasrt_options: %s: expecting integer, found NaN", - keyword.c_str ()); - } - else - (dasrt_opts.*list->i_set_fcn) (NINT (val)); - } - return; - } - list++; - } - - warning ("dasrt_options: no match for `%s'", keyword.c_str ()); -} - -static octave_value_list -show_dasrt_option (const string& keyword) -{ - octave_value retval; - - DASRT_OPTIONS *list = dasrt_option_table; - - while (list->keyword != 0) - { - if (keyword_almost_match (list->kw_tok, list->min_len, keyword, - list->min_toks_to_match, MAX_TOKENS)) - { - if (list->d_get_fcn) - { - double val = (dasrt_opts.*list->d_get_fcn) (); - if (val < 0.0) - retval = "computed automatically"; - else - retval = val; - } - else - { - int val = (dasrt_opts.*list->i_get_fcn) (); - if (val < 0) - retval = "computed automatically"; - else - retval = static_cast<double> (val); - } - - return retval; - } - list++; - } - - warning ("dasrt_options: no match for `%s'", keyword.c_str ()); - - return retval; -} - -DEFUN_DLD (dasrt_options, args, , - "dasrt_options (KEYWORD, VALUE)\n\ -\n\ -Set or show options for dasrt. Keywords may be abbreviated\n\ -to the shortest match.") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 0) - { - print_dasrt_option_list (octave_stdout); - return retval; - } - else if (nargin == 1 || nargin == 2) - { - string keyword = args(0).string_value (); - - if (! error_state) - { - if (nargin == 1) - return show_dasrt_option (keyword); - else - { - double val = args(1).double_value (); - - if (! error_state) - { - set_dasrt_option (keyword, val); - return retval; - } - } - } - } - - print_usage ("dasrt_options"); - - return retval; -} - /* ;;; Local Variables: *** ;;; mode: C++ ***
--- a/src/DLD-FUNCTIONS/dassl.cc +++ b/src/DLD-FUNCTIONS/dassl.cc @@ -41,14 +41,14 @@ #include "utils.h" #include "variables.h" +#include "DASSL-opts.cc" + // Global pointer for user defined function required by dassl. static octave_function *dassl_fcn; // Global pointer for optional user defined jacobian function. static octave_function *dassl_jac; -static DASSL_options dassl_opts; - // Is this a recursive call? static int call_depth = 0; @@ -380,180 +380,6 @@ return retval; } -typedef void (DASSL_options::*d_set_opt_mf) (double); -typedef double (DASSL_options::*d_get_opt_mf) (void); - -#define MAX_TOKENS 3 - -struct DASSL_OPTIONS -{ - const char *keyword; - const char *kw_tok[MAX_TOKENS + 1]; - int min_len[MAX_TOKENS + 1]; - int min_toks_to_match; - d_set_opt_mf d_set_fcn; - d_get_opt_mf d_get_fcn; -}; - -static DASSL_OPTIONS dassl_option_table [] = -{ - { "absolute tolerance", - { "absolute", "tolerance", 0, 0, }, - { 1, 0, 0, 0, }, 1, - &DASSL_options::set_absolute_tolerance, - &DASSL_options::absolute_tolerance, }, - - { "initial step size", - { "initial", "step", "size", 0, }, - { 1, 0, 0, 0, }, 1, - &DASSL_options::set_initial_step_size, - &DASSL_options::initial_step_size, }, - - { "maximum step size", - { "maximum", "step", "size", 0, }, - { 2, 0, 0, 0, }, 1, - &DASSL_options::set_maximum_step_size, - &DASSL_options::maximum_step_size, }, - - { "relative tolerance", - { "relative", "tolerance", 0, 0, }, - { 1, 0, 0, 0, }, 1, - &DASSL_options::set_relative_tolerance, - &DASSL_options::relative_tolerance, }, - - { 0, - { 0, 0, 0, 0, }, - { 0, 0, 0, 0, }, 0, - 0, 0, }, -}; - -static void -print_dassl_option_list (std::ostream& os) -{ - print_usage ("dassl_options", 1); - - os << "\n" - << "Options for dassl include:\n\n" - << " keyword value\n" - << " ------- -----\n\n"; - - DASSL_OPTIONS *list = dassl_option_table; - - const char *keyword; - while ((keyword = list->keyword) != 0) - { - os << " " - << std::setiosflags (std::ios::left) << std::setw (40) - << keyword - << std::resetiosflags (std::ios::left) - << " "; - - double val = (dassl_opts.*list->d_get_fcn) (); - if (val < 0.0) - os << "computed automatically"; - else - os << val; - - os << "\n"; - list++; - } - - os << "\n"; -} - -static void -set_dassl_option (const std::string& keyword, double val) -{ - DASSL_OPTIONS *list = dassl_option_table; - - while (list->keyword != 0) - { - if (keyword_almost_match (list->kw_tok, list->min_len, keyword, - list->min_toks_to_match, MAX_TOKENS)) - { - (dassl_opts.*list->d_set_fcn) (val); - - return; - } - list++; - } - - warning ("dassl_options: no match for `%s'", keyword.c_str ()); -} - -static octave_value_list -show_dassl_option (const std::string& keyword) -{ - octave_value retval; - - DASSL_OPTIONS *list = dassl_option_table; - - while (list->keyword != 0) - { - if (keyword_almost_match (list->kw_tok, list->min_len, keyword, - list->min_toks_to_match, MAX_TOKENS)) - { - double val = (dassl_opts.*list->d_get_fcn) (); - if (val < 0.0) - retval = "computed automatically"; - else - retval = val; - - return retval; - } - list++; - } - - warning ("dassl_options: no match for `%s'", keyword.c_str ()); - - return retval; -} - -DEFUN_DLD (dassl_options, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} dassl_options (@var{opt}, @var{val})\n\ -When called with two arguments, this function allows you set options\n\ -parameters for the function @code{dassl}. Given one argument,\n\ -@code{dassl_options} returns the value of the corresponding option. If\n\ -no arguments are supplied, the names of all the available options and\n\ -their current values are displayed.\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 0) - { - print_dassl_option_list (octave_stdout); - return retval; - } - else if (nargin == 1 || nargin == 2) - { - std::string keyword = args(0).string_value (); - - if (! error_state) - { - if (nargin == 1) - return show_dassl_option (keyword); - else - { - double val = args(1).double_value (); - - if (! error_state) - { - set_dassl_option (keyword, val); - return retval; - } - } - } - } - - print_usage ("dassl_options"); - - return retval; -} - /* ;;; Local Variables: *** ;;; mode: C++ ***
--- a/src/DLD-FUNCTIONS/fsolve.cc +++ b/src/DLD-FUNCTIONS/fsolve.cc @@ -41,11 +41,11 @@ #include "utils.h" #include "variables.h" +#include "NLEqn-opts.cc" + // Global pointer for user defined function required by hybrd1. static octave_function *fsolve_fcn; -static NLEqn_options fsolve_opts; - // Is this a recursive call? static int call_depth = 0; @@ -193,7 +193,7 @@ NLFunc nleqn_fcn (fsolve_user_function); NLEqn nleqn (x, nleqn_fcn); - nleqn.set_options (fsolve_opts); + nleqn.copy (fsolve_opts); int info; ColumnVector soln = nleqn.solve (info); @@ -224,162 +224,6 @@ return retval; } -typedef void (NLEqn_options::*d_set_opt_mf) (double); -typedef double (NLEqn_options::*d_get_opt_mf) (void); - -#define MAX_TOKENS 1 - -struct NLEQN_OPTIONS -{ - const char *keyword; - const char *kw_tok[MAX_TOKENS + 1]; - int min_len[MAX_TOKENS + 1]; - int min_toks_to_match; - d_set_opt_mf d_set_fcn; - d_get_opt_mf d_get_fcn; -}; - -static NLEQN_OPTIONS fsolve_option_table [] = -{ - { "tolerance", - { "tolerance", 0, }, - { 1, 0, }, 1, - &NLEqn_options::set_tolerance, - &NLEqn_options::tolerance, }, - - { 0, - { 0, 0, }, - { 0, 0, }, 0, - 0, 0, }, -}; - -static void -print_fsolve_option_list (std::ostream& os) -{ - print_usage ("fsolve_options", 1); - - os << "\n" - << "Options for fsolve include:\n\n" - << " keyword value\n" - << " ------- -----\n\n"; - - NLEQN_OPTIONS *list = fsolve_option_table; - - const char *keyword; - while ((keyword = list->keyword) != 0) - { - os << " " - << std::setiosflags (std::ios::left) << std::setw (40) - << keyword - << std::resetiosflags (std::ios::left) - << " "; - - double val = (fsolve_opts.*list->d_get_fcn) (); - if (val < 0.0) - os << "computed automatically"; - else - os << val; - - os << "\n"; - list++; - } - - os << "\n"; -} - -static void -set_fsolve_option (const std::string& keyword, double val) -{ - NLEQN_OPTIONS *list = fsolve_option_table; - - while (list->keyword != 0) - { - if (keyword_almost_match (list->kw_tok, list->min_len, keyword, - list->min_toks_to_match, MAX_TOKENS)) - { - (fsolve_opts.*list->d_set_fcn) (val); - - return; - } - list++; - } - - warning ("fsolve_options: no match for `%s'", keyword.c_str ()); -} - -static octave_value_list -show_fsolve_option (const std::string& keyword) -{ - octave_value retval; - - NLEQN_OPTIONS *list = fsolve_option_table; - - while (list->keyword != 0) - { - if (keyword_almost_match (list->kw_tok, list->min_len, keyword, - list->min_toks_to_match, MAX_TOKENS)) - { - double val = (fsolve_opts.*list->d_get_fcn) (); - if (val < 0.0) - retval = "computed automatically"; - else - retval = val; - - return retval; - } - list++; - } - - warning ("fsolve_options: no match for `%s'", keyword.c_str ()); - - return retval; -} - -DEFUN_DLD (fsolve_options, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} fsolve_options (@var{opt}, @var{val})\n\ -When called with two arguments, this function allows you set options\n\ -parameters for the function @code{fsolve}. Given one argument,\n\ -@code{fsolve_options} returns the value of the corresponding option. If\n\ -no arguments are supplied, the names of all the available options and\n\ -their current values are displayed.\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 0) - { - print_fsolve_option_list (octave_stdout); - return retval; - } - else if (nargin == 1 || nargin == 2) - { - std::string keyword = args(0).string_value (); - - if (! error_state) - { - if (nargin == 1) - return show_fsolve_option (keyword); - else - { - double val = args(1).double_value (); - - if (! error_state) - { - set_fsolve_option (keyword, val); - return retval; - } - } - } - } - - print_usage ("fsolve_options"); - - return retval; -} - /* ;;; Local Variables: *** ;;; mode: C++ ***
--- a/src/DLD-FUNCTIONS/lsode.cc +++ b/src/DLD-FUNCTIONS/lsode.cc @@ -43,14 +43,14 @@ #include "utils.h" #include "variables.h" +#include "LSODE-opts.cc" + // Global pointer for user defined function required by lsode. static octave_function *lsode_fcn; // Global pointer for optional user defined jacobian function used by lsode. static octave_function *lsode_jac; -static LSODE_options lsode_opts; - // Is this a recursive call? static int call_depth = 0; @@ -313,354 +313,6 @@ return retval; } -typedef void (LSODE_options::*da_set_opt_mf) (const Array<double>&); -typedef void (LSODE_options::*d_set_opt_mf) (double); -typedef void (LSODE_options::*i_set_opt_mf) (int); -typedef void (LSODE_options::*s_set_opt_mf) (const std::string&); - -typedef Array<double> (LSODE_options::*da_get_opt_mf) (void) const; -typedef double (LSODE_options::*d_get_opt_mf) (void) const; -typedef int (LSODE_options::*i_get_opt_mf) (void) const; -typedef std::string (LSODE_options::*s_get_opt_mf) (void) const; - -#define MAX_TOKENS 3 - -struct LSODE_OPTIONS -{ - const char *keyword; - const char *kw_tok[MAX_TOKENS + 1]; - int min_len[MAX_TOKENS + 1]; - int min_toks_to_match; - da_set_opt_mf da_set_fcn; - d_set_opt_mf d_set_fcn; - i_set_opt_mf i_set_fcn; - s_set_opt_mf s_set_fcn; - da_get_opt_mf da_get_fcn; - d_get_opt_mf d_get_fcn; - i_get_opt_mf i_get_fcn; - s_get_opt_mf s_get_fcn; -}; - -static LSODE_OPTIONS lsode_option_table [] = -{ - { "absolute tolerance", - { "absolute", "tolerance", 0, 0, }, - { 1, 0, 0, 0, }, 1, - &LSODE_options::set_absolute_tolerance, 0, 0, 0, - &LSODE_options::absolute_tolerance, 0, 0, 0, }, - - { "initial step size", - { "initial", "step", "size", 0, }, - { 3, 0, 0, 0, }, 1, - 0, &LSODE_options::set_initial_step_size, 0, 0, - 0, &LSODE_options::initial_step_size, 0, 0, }, - - { "integration method", - { "integration", "method", 0, 0, }, - { 3, 0, 0, 0, }, 1, - 0, 0, 0, &LSODE_options::set_integration_method, - 0, 0, 0, &LSODE_options::integration_method, }, - - { "maximum step size", - { "maximum", "step", "size", 0, }, - { 2, 0, 0, 0, }, 1, - 0, &LSODE_options::set_maximum_step_size, 0, 0, - 0, &LSODE_options::maximum_step_size, 0, 0, }, - - { "minimum step size", - { "minimum", "step", "size", 0, }, - { 2, 0, 0, 0, }, 1, - 0, &LSODE_options::set_minimum_step_size, 0, 0, - 0, &LSODE_options::minimum_step_size, 0, 0, }, - - { "relative tolerance", - { "relative", "tolerance", 0, 0, }, - { 1, 0, 0, 0, }, 1, - 0, &LSODE_options::set_relative_tolerance, 0, 0, - 0, &LSODE_options::relative_tolerance, 0, 0, }, - - { "step limit", - { "step", "limit", 0, 0, }, - { 1, 0, 0, 0, }, 1, - 0, 0, &LSODE_options::set_step_limit, 0, - 0, 0, &LSODE_options::step_limit, 0, }, - - { 0, - { 0, 0, 0, 0, }, - { 0, 0, 0, 0, }, 0, - 0, 0, 0, 0, - 0, 0, 0, 0, }, -}; - -static void -print_lsode_option_list (std::ostream& os) -{ - print_usage ("lsode_options", 1); - - os << "\n" - << "Options for lsode include:\n\n" - << " keyword value\n" - << " ------- -----\n\n"; - - LSODE_OPTIONS *list = lsode_option_table; - - const char *keyword; - while ((keyword = list->keyword) != 0) - { - os << " " - << std::setiosflags (std::ios::left) << std::setw (40) - << keyword - << std::resetiosflags (std::ios::left) - << " "; - - if (list->da_get_fcn) - { - Array<double> val = (lsode_opts.*list->da_get_fcn) (); - if (val.length () == 1) - { - if (val(0) < 0.0) - os << "computed automatically"; - else - os << val(0); - } - else - { - os << "\n\n"; - // XXX FIXME XXX - Matrix tmp = Matrix (ColumnVector (val)); - octave_print_internal (os, tmp, false, 2); - os << "\n"; - } - } - else if (list->d_get_fcn) - { - double val = (lsode_opts.*list->d_get_fcn) (); - if (val < 0.0) - os << "computed automatically"; - else - os << val; - } - else if (list->i_get_fcn) - { - int val = (lsode_opts.*list->i_get_fcn) (); - if (val < 0) - os << "infinite"; - else - os << val; - } - else if (list->s_get_fcn) - { - os << (lsode_opts.*list->s_get_fcn) (); - } - else - panic_impossible (); - - os << "\n"; - list++; - } - - os << "\n"; -} - -static void -set_lsode_option (const std::string& keyword, double val) -{ - LSODE_OPTIONS *list = lsode_option_table; - - while (list->keyword != 0) - { - if (keyword_almost_match (list->kw_tok, list->min_len, keyword, - list->min_toks_to_match, MAX_TOKENS)) - { - if (list->da_set_fcn) - { - Array<double> tmp (1, val); - (lsode_opts.*list->da_set_fcn) (tmp); - } - else if (list->d_set_fcn) - { - (lsode_opts.*list->d_set_fcn) (val); - } - else - { - if (xisnan (val)) - { - error ("lsode_options: %s: expecting integer, found NaN", - keyword.c_str ()); - } - else - (lsode_opts.*list->i_set_fcn) (NINT (val)); - } - return; - } - list++; - } - - warning ("lsode_options: no match for `%s'", keyword.c_str ()); -} - -static void -set_lsode_option (const std::string& keyword, const Array<double>& val) -{ - LSODE_OPTIONS *list = lsode_option_table; - - while (list->keyword != 0) - { - if (keyword_almost_match (list->kw_tok, list->min_len, keyword, - list->min_toks_to_match, MAX_TOKENS)) - { - if (list->da_set_fcn) - (lsode_opts.*list->da_set_fcn) (val); - else - error ("lsode_options: no function to handle vector option"); - - return; - } - list++; - } - - warning ("lsode_options: no match for `%s'", keyword.c_str ()); -} - -static void -set_lsode_option (const std::string& keyword, const std::string& val) -{ - LSODE_OPTIONS *list = lsode_option_table; - - while (list->keyword != 0) - { - if (keyword_almost_match (list->kw_tok, list->min_len, keyword, - list->min_toks_to_match, MAX_TOKENS)) - { - if (list->s_set_fcn) - (lsode_opts.*list->s_set_fcn) (val); - else - error ("lsode_options: no function to handle string option"); - - return; - } - list++; - } - - warning ("lsode_options: no match for `%s'", keyword.c_str ()); -} - -static octave_value_list -show_lsode_option (const std::string& keyword) -{ - octave_value retval; - - LSODE_OPTIONS *list = lsode_option_table; - - while (list->keyword != 0) - { - if (keyword_almost_match (list->kw_tok, list->min_len, keyword, - list->min_toks_to_match, MAX_TOKENS)) - { - if (list->da_get_fcn) - { - Array<double> val = (lsode_opts.*list->da_get_fcn) (); - if (val.length () == 1) - { - if (val(0) < 0.0) - retval = "computed automatically"; - else - retval = val(0); - } - else - retval = ColumnVector (val); - } - else if (list->d_get_fcn) - { - double val = (lsode_opts.*list->d_get_fcn) (); - if (val < 0.0) - retval = "computed automatically"; - else - retval = val; - } - else if (list->i_get_fcn) - { - int val = (lsode_opts.*list->i_get_fcn) (); - if (val < 0) - retval = "infinite"; - else - retval = static_cast<double> (val); - } - else if (list->s_get_fcn) - { - retval = (lsode_opts.*list->s_get_fcn) (); - } - else - panic_impossible (); - - return retval; - } - list++; - } - - warning ("lsode_options: no match for `%s'", keyword.c_str ()); - - return retval; -} - -DEFUN_DLD (lsode_options, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} lsode_options (@var{opt}, @var{val})\n\ -When called with two arguments, this function allows you set options\n\ -parameters for the function @code{lsode}. Given one argument,\n\ -@code{lsode_options} returns the value of the corresponding option. If\n\ -no arguments are supplied, the names of all the available options and\n\ -their current values are displayed.\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 0) - { - print_lsode_option_list (octave_stdout); - } - else if (nargin == 1 || nargin == 2) - { - std::string keyword = args(0).string_value (); - - if (! error_state) - { - if (nargin == 1) - retval = show_lsode_option (keyword); - else - { - if (args(1).is_string ()) - { - std::string val = args(1).string_value (); - - if (! error_state) - set_lsode_option (keyword, val); - } - else if (args(1).is_scalar_type ()) - { - double val = args(1).double_value (); - - if (! error_state) - set_lsode_option (keyword, val); - } - else - { - Array<double> val = args(1).vector_value (); - - if (! error_state) - set_lsode_option (keyword, val); - } - } - } - } - else - print_usage ("lsode_options"); - - return retval; -} - /* ;;; Local Variables: *** ;;; mode: C++ ***
--- a/src/DLD-FUNCTIONS/odessa.cc +++ b/src/DLD-FUNCTIONS/odessa.cc @@ -44,13 +44,13 @@ #include "variables.h" #include "parse.h" +#include "ODESSA-opts.cc" + // Global pointer for user defined function required by odessa. static octave_function *odessa_f; static octave_function *odessa_j; static octave_function *odessa_b; -static ODESSA_options odessa_opts; - // Is this a recursive call? static int call_depth = 0; @@ -450,354 +450,6 @@ return retval; } -typedef void (ODESSA_options::*da_set_opt_mf) (const Array<double>&); -typedef void (ODESSA_options::*d_set_opt_mf) (double); -typedef void (ODESSA_options::*i_set_opt_mf) (int); -typedef void (ODESSA_options::*s_set_opt_mf) (const std::string&); - -typedef Array<double> (ODESSA_options::*da_get_opt_mf) (void) const; -typedef double (ODESSA_options::*d_get_opt_mf) (void) const; -typedef int (ODESSA_options::*i_get_opt_mf) (void) const; -typedef std::string (ODESSA_options::*s_get_opt_mf) (void) const; - -#define MAX_TOKENS 3 - -struct ODESSA_OPTIONS -{ - const char *keyword; - const char *kw_tok[MAX_TOKENS + 1]; - int min_len[MAX_TOKENS + 1]; - int min_toks_to_match; - da_set_opt_mf da_set_fcn; - d_set_opt_mf d_set_fcn; - i_set_opt_mf i_set_fcn; - s_set_opt_mf s_set_fcn; - da_get_opt_mf da_get_fcn; - d_get_opt_mf d_get_fcn; - i_get_opt_mf i_get_fcn; - s_get_opt_mf s_get_fcn; -}; - -static ODESSA_OPTIONS odessa_option_table [] = -{ - { "absolute tolerance", - { "absolute", "tolerance", 0, 0, }, - { 1, 0, 0, 0, }, 1, - &ODESSA_options::set_absolute_tolerance, 0, 0, 0, - &ODESSA_options::absolute_tolerance, 0, 0, 0, }, - - { "initial step size", - { "initial", "step", "size", 0, }, - { 3, 0, 0, 0, }, 1, - 0, &ODESSA_options::set_initial_step_size, 0, 0, - 0, &ODESSA_options::initial_step_size, 0, 0, }, - - { "integration method", - { "integration", "method", 0, 0, }, - { 3, 0, 0, 0, }, 1, - 0, 0, 0, &ODESSA_options::set_integration_method, - 0, 0, 0, &ODESSA_options::integration_method, }, - - { "maximum step size", - { "maximum", "step", "size", 0, }, - { 2, 0, 0, 0, }, 1, - 0, &ODESSA_options::set_maximum_step_size, 0, 0, - 0, &ODESSA_options::maximum_step_size, 0, 0, }, - - { "minimum step size", - { "minimum", "step", "size", 0, }, - { 2, 0, 0, 0, }, 1, - 0, &ODESSA_options::set_minimum_step_size, 0, 0, - 0, &ODESSA_options::minimum_step_size, 0, 0, }, - - { "relative tolerance", - { "relative", "tolerance", 0, 0, }, - { 1, 0, 0, 0, }, 1, - 0, &ODESSA_options::set_relative_tolerance, 0, 0, - 0, &ODESSA_options::relative_tolerance, 0, 0, }, - - { "step limit", - { "step", "limit", 0, 0, }, - { 1, 0, 0, 0, }, 1, - 0, 0, &ODESSA_options::set_step_limit, 0, - 0, 0, &ODESSA_options::step_limit, 0, }, - - { 0, - { 0, 0, 0, 0, }, - { 0, 0, 0, 0, }, 0, - 0, 0, 0, 0, - 0, 0, 0, 0, }, -}; - -static void -print_odessa_option_list (std::ostream& os) -{ - print_usage ("odessa_options", 1); - - os << "\n" - << "Options for odessa include:\n\n" - << " keyword value\n" - << " ------- -----\n\n"; - - ODESSA_OPTIONS *list = odessa_option_table; - - const char *keyword; - while ((keyword = list->keyword) != 0) - { - os << " " - << std::setiosflags (std::ios::left) << std::setw (40) - << keyword - << std::resetiosflags (std::ios::left) - << " "; - - if (list->da_get_fcn) - { - Array<double> val = (odessa_opts.*list->da_get_fcn) (); - if (val.length () == 1) - { - if (val(0) < 0.0) - os << "computed automatically"; - else - os << val(0); - } - else - { - os << "\n\n"; - // XXX FIXME XXX - Matrix tmp = Matrix (ColumnVector (val)); - octave_print_internal (os, tmp, false, 2); - os << "\n"; - } - } - else if (list->d_get_fcn) - { - double val = (odessa_opts.*list->d_get_fcn) (); - if (val < 0.0) - os << "computed automatically"; - else - os << val; - } - else if (list->i_get_fcn) - { - int val = (odessa_opts.*list->i_get_fcn) (); - if (val < 0) - os << "infinite"; - else - os << val; - } - else if (list->s_get_fcn) - { - os << (odessa_opts.*list->s_get_fcn) (); - } - else - panic_impossible (); - - os << "\n"; - list++; - } - - os << "\n"; -} - -static void -set_odessa_option (const std::string& keyword, double val) -{ - ODESSA_OPTIONS *list = odessa_option_table; - - while (list->keyword != 0) - { - if (keyword_almost_match (list->kw_tok, list->min_len, keyword, - list->min_toks_to_match, MAX_TOKENS)) - { - if (list->da_set_fcn) - { - Array<double> tmp (1, val); - (odessa_opts.*list->da_set_fcn) (tmp); - } - else if (list->d_set_fcn) - { - (odessa_opts.*list->d_set_fcn) (val); - } - else - { - if (xisnan (val)) - { - error ("odessa_options: %s: expecting integer, found NaN", - keyword.c_str ()); - } - else - (odessa_opts.*list->i_set_fcn) (NINT (val)); - } - return; - } - list++; - } - - warning ("odessa_options: no match for `%s'", keyword.c_str ()); -} - -static void -set_odessa_option (const std::string& keyword, const Array<double>& val) -{ - ODESSA_OPTIONS *list = odessa_option_table; - - while (list->keyword != 0) - { - if (keyword_almost_match (list->kw_tok, list->min_len, keyword, - list->min_toks_to_match, MAX_TOKENS)) - { - if (list->da_set_fcn) - (odessa_opts.*list->da_set_fcn) (val); - else - error ("odessa_options: no function to handle vector option"); - - return; - } - list++; - } - - warning ("odessa_options: no match for `%s'", keyword.c_str ()); -} - -static void -set_odessa_option (const std::string& keyword, const std::string& val) -{ - ODESSA_OPTIONS *list = odessa_option_table; - - while (list->keyword != 0) - { - if (keyword_almost_match (list->kw_tok, list->min_len, keyword, - list->min_toks_to_match, MAX_TOKENS)) - { - if (list->s_set_fcn) - (odessa_opts.*list->s_set_fcn) (val); - else - error ("odessa_options: no function to handle string option"); - - return; - } - list++; - } - - warning ("odessa_options: no match for `%s'", keyword.c_str ()); -} - -static octave_value_list -show_odessa_option (const std::string& keyword) -{ - octave_value retval; - - ODESSA_OPTIONS *list = odessa_option_table; - - while (list->keyword != 0) - { - if (keyword_almost_match (list->kw_tok, list->min_len, keyword, - list->min_toks_to_match, MAX_TOKENS)) - { - if (list->da_get_fcn) - { - Array<double> val = (odessa_opts.*list->da_get_fcn) (); - if (val.length () == 1) - { - if (val(0) < 0.0) - retval = "computed automatically"; - else - retval = val(0); - } - else - retval = ColumnVector (val); - } - else if (list->d_get_fcn) - { - double val = (odessa_opts.*list->d_get_fcn) (); - if (val < 0.0) - retval = "computed automatically"; - else - retval = val; - } - else if (list->i_get_fcn) - { - int val = (odessa_opts.*list->i_get_fcn) (); - if (val < 0) - retval = "infinite"; - else - retval = static_cast<double> (val); - } - else if (list->s_get_fcn) - { - retval = (odessa_opts.*list->s_get_fcn) (); - } - else - panic_impossible (); - - return retval; - } - list++; - } - - warning ("odessa_options: no match for `%s'", keyword.c_str ()); - - return retval; -} - -DEFUN_DLD (odessa_options, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} odessa_options (@var{opt}, @var{val})\n\ -When called with two arguments, this function allows you set options\n\ -parameters for the function @code{odessa}. Given one argument,\n\ -@code{odessa_options} returns the value of the corresponding option. If\n\ -no arguments are supplied, the names of all the available options and\n\ -their current values are displayed.\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 0) - { - print_odessa_option_list (octave_stdout); - } - else if (nargin == 1 || nargin == 2) - { - std::string keyword = args(0).string_value (); - - if (! error_state) - { - if (nargin == 1) - retval = show_odessa_option (keyword); - else - { - if (args(1).is_string ()) - { - std::string val = args(1).string_value (); - - if (! error_state) - set_odessa_option (keyword, val); - } - else if (args(1).is_scalar_type ()) - { - double val = args(1).double_value (); - - if (! error_state) - set_odessa_option (keyword, val); - } - else - { - Array<double> val = args(1).vector_value (); - - if (! error_state) - set_odessa_option (keyword, val); - } - } - } - } - else - print_usage ("odessa_options"); - - return retval; -} - /* ;;; Local Variables: *** ;;; mode: C++ ***
--- a/src/DLD-FUNCTIONS/quad.cc +++ b/src/DLD-FUNCTIONS/quad.cc @@ -42,6 +42,8 @@ #include "utils.h" #include "variables.h" +#include "Quad-opts.cc" + #if defined (quad) #undef quad #endif @@ -49,8 +51,6 @@ // Global pointer for user defined function required by quadrature functions. static octave_function *quad_fcn; -static Quad_options quad_opts; - // Is this a recursive call? static int call_depth = 0; @@ -209,18 +209,17 @@ int nfun = 0; double abserr = 0.0; double val = 0.0; - double abstol = 1e-6; - double reltol = 1e-6; - ColumnVector tol (2); + bool have_sing = false; ColumnVector sing; - int have_sing = 0; + ColumnVector tol; + switch (nargin) { case 5: if (indefinite) QUAD_ABORT1 ("singularities not allowed on infinite intervals"); - have_sing = 1; + have_sing = true; sing = ColumnVector (args(4).vector_value ()); @@ -236,10 +235,10 @@ switch (tol.capacity ()) { case 2: - reltol = tol (1); + quad_opts.set_relative_tolerance (tol (1)); case 1: - abstol = tol (0); + quad_opts.set_absolute_tolerance (tol (0)); break; default: @@ -249,22 +248,22 @@ case 3: if (indefinite) { - IndefQuad iq (quad_user_function, bound, indef_type, abstol, reltol); - iq.set_options (quad_opts); + IndefQuad iq (quad_user_function, bound, indef_type); + iq.copy (quad_opts); val = iq.integrate (ier, nfun, abserr); } else { if (have_sing) { - DefQuad dq (quad_user_function, a, b, sing, abstol, reltol); - dq.set_options (quad_opts); + DefQuad dq (quad_user_function, a, b, sing); + dq.copy (quad_opts); val = dq.integrate (ier, nfun, abserr); } else { - DefQuad dq (quad_user_function, a, b, abstol, reltol); - dq.set_options (quad_opts); + DefQuad dq (quad_user_function, a, b); + dq.copy (quad_opts); val = dq.integrate (ier, nfun, abserr); } } @@ -288,162 +287,6 @@ return retval; } -typedef void (Quad_options::*d_set_opt_mf) (double); -typedef double (Quad_options::*d_get_opt_mf) (void); - -#define MAX_TOKENS 2 - -struct QUAD_OPTIONS -{ - const char *keyword; - const char *kw_tok[MAX_TOKENS + 1]; - int min_len[MAX_TOKENS + 1]; - int min_toks_to_match; - d_set_opt_mf d_set_fcn; - d_get_opt_mf d_get_fcn; -}; - -static QUAD_OPTIONS quad_option_table [] = -{ - { "absolute tolerance", - { "absolute", "tolerance", 0, }, - { 1, 0, 0, }, 1, - &Quad_options::set_absolute_tolerance, - &Quad_options::absolute_tolerance, }, - - { "relative tolerance", - { "relative", "tolerance", 0, }, - { 1, 0, 0, }, 1, - &Quad_options::set_relative_tolerance, - &Quad_options::relative_tolerance, }, - - { 0, - { 0, 0, 0, }, - { 0, 0, 0, }, 0, - 0, 0, }, -}; - -static void -print_quad_option_list (std::ostream& os) -{ - print_usage ("quad_options", 1); - - os << "\n" - << "Options for quad include:\n\n" - << " keyword value\n" - << " ------- -----\n\n"; - - QUAD_OPTIONS *list = quad_option_table; - - const char *keyword; - while ((keyword = list->keyword) != 0) - { - os << " " - << std::setiosflags (std::ios::left) << std::setw (40) - << keyword - << std::resetiosflags (std::ios::left) - << " "; - - double val = (quad_opts.*list->d_get_fcn) (); - if (val < 0.0) - os << "computed automatically"; - else - os << val; - - os << "\n"; - list++; - } - - os << "\n"; -} - -static void -set_quad_option (const std::string& keyword, double val) -{ - QUAD_OPTIONS *list = quad_option_table; - - while (list->keyword != 0) - { - if (keyword_almost_match (list->kw_tok, list->min_len, keyword, - list->min_toks_to_match, MAX_TOKENS)) - { - (quad_opts.*list->d_set_fcn) (val); - - return; - } - list++; - } - - warning ("quad_options: no match for `%s'", keyword.c_str ()); -} - -static octave_value_list -show_quad_option (const std::string& keyword) -{ - octave_value retval; - - QUAD_OPTIONS *list = quad_option_table; - - while (list->keyword != 0) - { - if (keyword_almost_match (list->kw_tok, list->min_len, keyword, - list->min_toks_to_match, MAX_TOKENS)) - { - return (quad_opts.*list->d_get_fcn) (); - } - list++; - } - - warning ("quad_options: no match for `%s'", keyword.c_str ()); - - return retval; -} - -DEFUN_DLD (quad_options, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} quad_options (@var{opt}, @var{val})\n\ -When called with two arguments, this function allows you set options\n\ -parameters for the function @code{quad}. Given one argument,\n\ -@code{quad_options} returns the value of the corresponding option. If\n\ -no arguments are supplied, the names of all the available options and\n\ -their current values are displayed.\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 0) - { - print_quad_option_list (octave_stdout); - return retval; - } - else if (nargin == 1 || nargin == 2) - { - std::string keyword = args(0).string_value (); - - if (! error_state) - { - if (nargin == 1) - return show_quad_option (keyword); - else - { - double val = args(1).double_value (); - - if (! error_state) - { - set_quad_option (keyword, val); - return retval; - } - } - } - } - - print_usage ("quad_options"); - - return retval; -} - /* ;;; Local Variables: *** ;;; mode: C++ ***
--- a/src/Makefile.in +++ b/src/Makefile.in @@ -39,6 +39,9 @@ endif endif +OPT_HANDLERS := DASPK-opts.cc DASRT-opts.cc DASSL-opts.cc \ + LSODE-opts.cc NLEqn-opts.cc ODESSA-opts.cc Quad-opts.cc + DLD_XSRC := balance.cc besselj.cc betainc.cc chol.cc colloc.cc \ daspk.cc dasrt.cc dassl.cc det.cc eig.cc expm.cc fft.cc fft2.cc \ filter.cc find.cc fsolve.cc gammainc.cc getgrent.cc \ @@ -170,7 +173,7 @@ DEFUN_PATTERN = "^[ \t]*DEFU(N|N_DLD|N_TEXT|N_MAPPER)[ \t]*\\(" DEF_5 := $(SOURCES) $(DLD_SRC) -DEF_4 := $(addprefix $(srcdir)/, $(DEF_5)) +DEF_4 := $(addprefix $(srcdir)/, $(DEF_5)) $(OPT_HANDLERS) DEF_3 := $(notdir $(shell egrep -l $(DEFUN_PATTERN) $(DEF_4))) DEF_2 := $(patsubst %.y, %.df, $(DEF_3)) DEF_1 := $(patsubst %.l, %.df, $(DEF_2)) @@ -198,7 +201,7 @@ DOCSTRINGS mkbuiltins mk-oct-links \ defaults.h.in oct-conf.h.in octave.gperf oct-gperf.h \ octave.cc parse.cc lex.cc y.tab.h \ - $(INCLUDES) $(DIST_SRC) + $(INCLUDES) $(DIST_SRC) $(OPT_HANDLERS) ifeq ($(SHARED_LIBS), true) BINDISTLIBS = src/liboctinterp @@ -253,7 +256,7 @@ fi touch stamp-oct-links -stamp-prereq: defaults.h oct-conf.h +stamp-prereq: defaults.h oct-conf.h $(OPT_HANDLERS) touch stamp-prereq octave: stamp-prereq $(LIBRARIES) stamp-oct-links \ @@ -452,6 +455,11 @@ # Special rules -- these files need special things to be defined. +$(OPT_HANDLERS) : %.cc : $(top_srcdir)/liboctave/%.in $(top_srcdir)/mk-opts.pl + @echo making $@ from $< + @perl $(top_srcdir)/mk-opts.pl --opt-handler-fcns $< > $@.t + @$(top_srcdir)/move-if-change $@.t $@ + parse.cc : parse.y @echo "expect 11 shift/reduce conflicts" $(YACC) $(YFLAGS) $<
--- a/src/pt-loop.cc +++ b/src/pt-loop.cc @@ -334,7 +334,7 @@ int nr; int steps; - if (rhs.is_real_matrix ()) + if (rhs.is_real_type ()) { m_tmp = rhs.matrix_value (); nr = m_tmp.rows (); @@ -350,7 +350,7 @@ if (error_state) goto cleanup; - if (rhs.is_real_matrix ()) + if (rhs.is_real_type ()) { if (nr == 1) DO_LOOP (m_tmp (0, i));