home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / octave-1.1.1p1-base.tgz / octave-1.1.1p1-base.tar / fsf / octave / src / f-npsol.cc < prev    next >
C/C++ Source or Header  |  1995-01-30  |  20KB  |  808 lines
  1. // f-npsol.cc                                           -*- C++ -*-
  2. /*
  3.  
  4. Copyright (C) 1993, 1994, 1995 John W. Eaton
  5.  
  6. This file is part of Octave.
  7.  
  8. Octave is free software; you can redistribute it and/or modify it
  9. under the terms of the GNU General Public License as published by the
  10. Free Software Foundation; either version 2, or (at your option) any
  11. later version.
  12.  
  13. Octave is distributed in the hope that it will be useful, but WITHOUT
  14. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  15. FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  16. for more details.
  17.  
  18. You should have received a copy of the GNU General Public License
  19. along with Octave; see the file COPYING.  If not, write to the Free
  20. Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  21.  
  22. */
  23.  
  24. #ifdef HAVE_CONFIG_H
  25. #include "config.h"
  26. #endif
  27.  
  28. #include <strstream.h>
  29.  
  30. #include "NPSOL.h"
  31.  
  32. #include "tree-const.h"
  33. #include "variables.h"
  34. #include "gripes.h"
  35. #include "error.h"
  36. #include "pager.h"
  37. #include "utils.h"
  38. #include "help.h"
  39. #include "defun-dld.h"
  40.  
  41. #ifndef NPSOL_MISSING
  42.  
  43. // Global pointers for user defined functions required by npsol.
  44. static tree_fvc *npsol_objective;
  45. static tree_fvc *npsol_constraints;
  46.  
  47. static NPSOL_options npsol_opts;
  48.  
  49. double
  50. npsol_objective_function (const ColumnVector& x)
  51. {
  52.   int n = x.capacity ();
  53.  
  54.   tree_constant decision_vars;
  55.   if (n > 1)
  56.     {
  57.       Matrix m (n, 1);
  58.       for (int i = 0; i < n; i++)
  59.     m (i, 0) = x.elem (i);
  60.       decision_vars = m;
  61.     }
  62.   else
  63.     {
  64.       double d = x.elem (0);
  65.       decision_vars = d;
  66.     }
  67.  
  68.   Octave_object args;
  69.   args(0) = decision_vars;
  70.  
  71.   static double retval;
  72.   retval = 0.0;
  73.  
  74.   tree_constant objective_value;
  75.   if (npsol_objective)
  76.     {
  77.       Octave_object tmp = npsol_objective->eval (0, 1, args);
  78.  
  79.       if (error_state)
  80.     {
  81.       error ("npsol: error evaluating objective function");
  82.       npsol_objective_error = 1; // XXX FIXME XXX
  83.       return retval;
  84.     }
  85.  
  86.       if (tmp.length () > 0 && tmp(0).is_defined ())
  87.     objective_value = tmp(0);
  88.       else
  89.     {
  90.       error ("npsol: error evaluating objective function");
  91.       npsol_objective_error = 1; // XXX FIXME XXX
  92.       return retval;
  93.     }
  94.     }
  95.  
  96.   if (objective_value.is_real_matrix ())
  97.     {
  98.       Matrix m = objective_value.matrix_value ();
  99.       if (m.rows () == 1 && m.columns () == 1)
  100.     retval = m.elem (0, 0);
  101.       else
  102.     {
  103.       gripe_user_returned_invalid ("npsol_objective");
  104.       npsol_objective_error = 1; // XXX FIXME XXX
  105.     }
  106.     }
  107.   else if (objective_value.is_real_scalar ())
  108.     {
  109.       retval = objective_value.double_value ();
  110.     }
  111.   else
  112.     {
  113.       gripe_user_returned_invalid ("npsol_objective");
  114.       npsol_objective_error = 1; // XXX FIXME XXX
  115.     }
  116.  
  117.   return retval;
  118. }
  119.  
  120. ColumnVector
  121. npsol_constraint_function (const ColumnVector& x)
  122. {
  123.   ColumnVector retval;
  124.  
  125.   int n = x.capacity ();
  126.  
  127.   tree_constant decision_vars;
  128.   if (n > 1)
  129.     {
  130.       Matrix m (n, 1);
  131.       for (int i = 0; i < n; i++)
  132.     m (i, 0) = x.elem (i);
  133.       decision_vars = m;
  134.     }
  135.   else
  136.     {
  137.       double d = x.elem (0);
  138.       decision_vars = d;
  139.     }
  140.  
  141.   Octave_object args;
  142.   args(0) = decision_vars;
  143.  
  144.   if (npsol_constraints)
  145.     {
  146.       Octave_object tmp = npsol_constraints->eval (0, 1, args);
  147.  
  148.       if (error_state)
  149.     {
  150.       error ("npsol: error evaluating constraints");
  151.       return retval;
  152.     }
  153.  
  154.       if (tmp.length () > 0 && tmp(0).is_defined ())
  155.     {
  156.       retval = tmp(0).vector_value ();
  157.  
  158.       if (error_state || retval.length () <= 0)
  159.         error ("npsol: error evaluating constraints");
  160.     }
  161.       else
  162.     error ("npsol: error evaluating constraints");
  163.     }
  164.  
  165.   return retval;
  166. }
  167.  
  168. int
  169. linear_constraints_ok (const ColumnVector& x, const ColumnVector& llb,
  170.                const Matrix& c, const ColumnVector& lub,
  171.                char *warn_for, int warn)
  172. {
  173.   int x_len = x.capacity ();
  174.   int llb_len = llb.capacity ();
  175.   int lub_len = lub.capacity ();
  176.   int c_rows = c.rows ();
  177.   int c_cols = c.columns ();
  178.  
  179.   int ok = 1;
  180.   if (warn)
  181.     {
  182.       if (c_rows == 0 || c_cols == 0 || llb_len == 0 || lub_len == 0)
  183.     {
  184.       ok = 0;
  185.       error ("%s: linear constraints must have nonzero dimensions",
  186.          warn_for);
  187.     }
  188.       else if (x_len != c_cols || llb_len != lub_len || llb_len != c_rows)
  189.     {
  190.       ok = 0;
  191.       error ("%s: linear constraints have inconsistent dimensions",
  192.          warn_for);
  193.     }
  194.     }
  195.  
  196.   return ok;
  197. }
  198.  
  199. int
  200. nonlinear_constraints_ok (const ColumnVector& x, const ColumnVector& nllb,
  201.               nonlinear_fcn g, const ColumnVector& nlub,
  202.               char *warn_for, int warn)
  203. {
  204.   int nllb_len = nllb.capacity ();
  205.   int nlub_len = nlub.capacity ();
  206.   ColumnVector c = (*g) (x);
  207.   int c_len = c.capacity ();
  208.  
  209.   int ok = 1;
  210.   if (warn)
  211.     {
  212.       if (nllb_len == 0 || nlub_len == 0 || c_len == 0)
  213.     {
  214.       ok = 0;
  215.       error ("%s: nonlinear constraints have nonzero dimensions",
  216.          warn_for);
  217.     }
  218.       else if (nllb_len != nlub_len || nllb_len != c_len)
  219.     {
  220.       ok = 0;
  221.       error ("%s: nonlinear constraints have inconsistent dimensions",
  222.          warn_for);
  223.     }
  224.     }
  225.   return ok;
  226. }
  227.  
  228. #endif
  229.  
  230. #if defined (NPSOL_MISSING)
  231. DEFUN_DLD_BUILTIN ("npsol", Fnpsol, Snpsol, 10, 4,
  232.   "This function requires NPSOL, which is not freely\n\
  233. redistributable.  For more information, read the file\n\
  234. libcruft/npsol/README.MISSING in the source distribution.")
  235. #else
  236. DEFUN_DLD_BUILTIN ("npsol", Fnpsol, Snpsol, 10, 4,
  237.   "[X, OBJ, INFO, LAMBDA] = npsol (X, PHI [, LB, UB] [, LB, A, UB] [, LB, G, UB])\n\
  238. \n\
  239. Groups of arguments surrounded in `[]' are optional, but\n\
  240. must appear in the same relative order shown above.\n\
  241. \n\
  242. The second argument is a string containing the name of the objective\n\
  243. function to call.  The objective function must be of the form\n\
  244. \n\
  245.   y = phi (x)\n\
  246. \n\
  247. where x is a vector and y is a scalar.\n\
  248. \n\
  249. The argument G is a string containing the name of the function that
  250. defines the nonlinear constraints.  It must be of the form\n\
  251. \n\
  252.   y = g (x)\n\
  253. \n\
  254. where x is a vector and y is a vector.")
  255. #endif
  256. {
  257. /*
  258.  
  259. Handle all of the following:
  260.  
  261.   1. npsol (x, phi)
  262.   2. npsol (x, phi, lb, ub)
  263.   3. npsol (x, phi, lb, ub, llb, c, lub)
  264.   4. npsol (x, phi, lb, ub, llb, c, lub, nllb, g, nlub)
  265.   5. npsol (x, phi, lb, ub,              nllb, g, nlub)
  266.   6. npsol (x, phi,         llb, c, lub, nllb, g, nlub)
  267.   7. npsol (x, phi,         llb, c, lub)
  268.   8. npsol (x, phi,                      nllb, g, nlub)
  269.  
  270. */
  271.  
  272.   Octave_object retval;
  273.  
  274. #if defined (NPSOL_MISSING)
  275.  
  276. // Force a bad value of inform, and empty matrices for x, phi, and lambda.
  277.  
  278.   retval.resize (4, Matrix ());
  279.  
  280.   retval(2) = -1.0;
  281.  
  282.   print_usage ("npsol");
  283.  
  284. #else
  285.  
  286.   int nargin = args.length ();
  287.  
  288.   if (nargin < 2 || nargin == 3 || nargin == 6 || nargin == 9
  289.       || nargin > 10 || nargout > 4)
  290.     {
  291.       print_usage ("npsol");
  292.       return retval;
  293.     }
  294.  
  295.   ColumnVector x = args(0).vector_value ();
  296.  
  297.   if (error_state || x.capacity () == 0)
  298.     {
  299.       error ("npsol: expecting vector as first argument");
  300.       return retval;
  301.     }
  302.  
  303.   npsol_objective = is_valid_function (args(1), "npsol", 1);
  304.   if (! npsol_objective
  305.       || takes_correct_nargs (npsol_objective, 1, "npsol", 1) != 1)
  306.     return retval;
  307.  
  308.   Objective func (npsol_objective_function);
  309.  
  310.   ColumnVector soln;
  311.  
  312.   Bounds bounds;
  313.   if (nargin == 4 || nargin == 7 || nargin == 10)
  314.     {
  315.       ColumnVector lb = args(2).vector_value ();
  316.       ColumnVector ub = args(3).vector_value ();
  317.  
  318.       int lb_len = lb.capacity ();
  319.       int ub_len = ub.capacity ();
  320.  
  321.       if (error_state || lb_len != ub_len || lb_len != x.capacity ())
  322.     {
  323.       error ("npsol: lower and upper bounds and decision variable vector");
  324.       error ("must all have the same number of elements");
  325.       return retval;
  326.     }
  327.  
  328.       bounds.resize (lb_len);
  329.       bounds.set_lower_bounds (lb);
  330.       bounds.set_upper_bounds (ub);
  331.     }
  332.  
  333.   double objf;
  334.   ColumnVector lambda;
  335.   int inform;
  336.  
  337.   if (nargin == 2)
  338.     {
  339.       // 1. npsol (x, phi)
  340.  
  341.       NPSOL nlp (x, func);
  342.       nlp.copy (npsol_opts);
  343.       soln = nlp.minimize (objf, inform, lambda);
  344.  
  345.       goto solved;
  346.     }
  347.  
  348.   if (nargin == 4)
  349.     {
  350.       // 2. npsol (x, phi, lb, ub)
  351.  
  352.       NPSOL nlp (x, func, bounds);
  353.       nlp.copy (npsol_opts);
  354.       soln = nlp.minimize (objf, inform, lambda);
  355.  
  356.       goto solved;
  357.     }
  358.  
  359.   npsol_constraints = 0;
  360.   if (nargin == 5 || nargin == 7 || nargin == 8 || nargin == 10)
  361.     npsol_constraints = is_valid_function (args(nargin-2), "npsol", 0);
  362.  
  363.   if (nargin == 7 || nargin == 5)
  364.     {
  365.       if (! npsol_constraints)
  366.     {
  367.       ColumnVector lub = args(nargin-1).vector_value ();
  368.       ColumnVector llb = args(nargin-3).vector_value ();
  369.  
  370.       if (error_state || llb.capacity () == 0 || lub.capacity () == 0)
  371.         {
  372.           error ("npsol: bounds for linear constraints must be vectors");
  373.           return retval;
  374.         }
  375.  
  376.       Matrix c = args(nargin-2).matrix_value ();
  377.  
  378.       if (error_state)
  379.         {
  380.           error ("npsol: invalid linear constraint matrix");
  381.           return retval;
  382.         }
  383.  
  384.       if (! linear_constraints_ok (x, llb, c, lub, "npsol", 1))
  385.         return retval;
  386.  
  387.       LinConst linear_constraints (llb, c, lub);
  388.  
  389.       if (nargin == 5)
  390.         {
  391.           // 7. npsol (x, phi, llb, c, lub)
  392.  
  393.           NPSOL nlp (x, func, linear_constraints);
  394.           nlp.copy (npsol_opts);
  395.           soln = nlp.minimize (objf, inform, lambda);
  396.         }
  397.       else
  398.         {
  399.           // 3. npsol (x, phi, lb, ub, llb, c, lub)
  400.  
  401.           NPSOL nlp (x, func, bounds, linear_constraints);
  402.           nlp.copy (npsol_opts);
  403.           soln = nlp.minimize (objf, inform, lambda);
  404.         }
  405.       goto solved;
  406.     }
  407.       else
  408.     {
  409.       if (takes_correct_nargs (npsol_constraints, 1, "npsol", 1))
  410.         {
  411.           ColumnVector nlub = args(nargin-1).vector_value ();
  412.           ColumnVector nllb = args(nargin-3).vector_value ();
  413.  
  414.           if (error_state
  415.           || (! nonlinear_constraints_ok
  416.               (x, nllb, npsol_constraint_function, nlub, "npsol", 1)))
  417.         return retval;
  418.  
  419.           NLFunc const_func (npsol_constraint_function);
  420.           NLConst nonlinear_constraints (nllb, const_func, nlub);
  421.  
  422.           if (nargin == 5)
  423.         {
  424.           // 8. npsol (x, phi, nllb, g, nlub)
  425.  
  426.           NPSOL nlp (x, func, nonlinear_constraints);
  427.           nlp.copy (npsol_opts);
  428.           soln = nlp.minimize (objf, inform, lambda);
  429.         }
  430.           else
  431.         {
  432.           // 5. npsol (x, phi, lb, ub, nllb, g, nlub)
  433.  
  434.           NPSOL nlp (x, func, bounds, nonlinear_constraints);
  435.           nlp.copy (npsol_opts);
  436.           soln = nlp.minimize (objf, inform, lambda);
  437.         }
  438.           goto solved;
  439.         }
  440.     }
  441.     }
  442.  
  443.   if (nargin == 8 || nargin == 10)
  444.     {
  445.       if (! npsol_constraints)
  446.     {
  447.       // Produce error message.
  448.       is_valid_function (args(nargin-2), "npsol", 1);
  449.     }
  450.       else
  451.     {
  452.       if (takes_correct_nargs (npsol_constraints, 1, "npsol", 1))
  453.         {
  454.           ColumnVector nlub = args(nargin-1).vector_value ();
  455.           ColumnVector nllb = args(nargin-3).vector_value ();
  456.  
  457.           if (error_state
  458.           || (! nonlinear_constraints_ok
  459.               (x, nllb, npsol_constraint_function, nlub, "npsol", 1)))
  460.         return retval;
  461.  
  462.           NLFunc const_func (npsol_constraint_function);
  463.           NLConst nonlinear_constraints (nllb, const_func, nlub);
  464.  
  465.           ColumnVector lub = args(nargin-4).vector_value ();
  466.           ColumnVector llb = args(nargin-6).vector_value ();
  467.  
  468.           if (error_state || llb.capacity () == 0 || lub.capacity () == 0)
  469.         {
  470.           error ("npsol: bounds for linear constraints must be vectors");
  471.           return retval;
  472.         }
  473.           
  474.           Matrix c = args(nargin-5).matrix_value ();
  475.  
  476.           if (error_state)
  477.         {
  478.           error ("npsol: invalid linear constraint matrix");
  479.           return retval;
  480.         }
  481.  
  482.           if (! linear_constraints_ok (x, llb, c, lub, "npsol", 1))
  483.         return retval;
  484.  
  485.           LinConst linear_constraints (llb, c, lub);
  486.  
  487.           if (nargin == 8)
  488.         {
  489.           // 6. npsol (x, phi, llb, c, lub, nllb, g, nlub)
  490.  
  491.           NPSOL nlp (x, func, linear_constraints,
  492.                  nonlinear_constraints);
  493.           nlp.copy (npsol_opts);
  494.           soln = nlp.minimize (objf, inform, lambda);
  495.         }
  496.           else
  497.         {
  498.           // 4. npsol (x, phi, lb, ub, llb, c, lub, nllb, g, nlub)
  499.  
  500.           NPSOL nlp (x, func, bounds, linear_constraints,
  501.                  nonlinear_constraints);
  502.           nlp.copy (npsol_opts);
  503.           soln = nlp.minimize (objf, inform, lambda);
  504.         }
  505.           goto solved;
  506.         }
  507.     }
  508.     }
  509.  
  510.   return retval;
  511.  
  512.  solved:
  513.  
  514.   retval.resize (nargout ? nargout : 1);
  515.   retval(0) = soln, 1;
  516.   if (nargout > 1)
  517.     retval(1) = objf;
  518.   if (nargout > 2)
  519.     retval(2) = (double) inform;
  520.   if (nargout > 3)
  521.     retval(3) = lambda;
  522.  
  523. #endif
  524.  
  525.   return retval;
  526. }
  527.  
  528. #ifndef NPSOL_MISSING
  529.  
  530. typedef void (NPSOL_options::*d_set_opt_mf) (double);
  531. typedef void (NPSOL_options::*i_set_opt_mf) (int);
  532. typedef double (NPSOL_options::*d_get_opt_mf) (void);
  533. typedef int (NPSOL_options::*i_get_opt_mf) (void);
  534.  
  535. #define MAX_TOKENS 5
  536.  
  537. struct NPSOL_OPTIONS
  538. {
  539.   const char *keyword;
  540.   const char *kw_tok[MAX_TOKENS + 1];
  541.   int min_len[MAX_TOKENS + 1];
  542.   int min_toks_to_match;
  543.   d_set_opt_mf d_set_fcn;
  544.   i_set_opt_mf i_set_fcn;
  545.   d_get_opt_mf d_get_fcn;
  546.   i_get_opt_mf i_get_fcn;
  547. };
  548.  
  549. static NPSOL_OPTIONS npsol_option_table [] =
  550. {
  551.   { "central difference interval",
  552.     { "central", "difference", "interval", 0, 0, 0, },
  553.     { 2, 0, 0, 0, 0, 0, }, 1,
  554.     NPSOL_options::set_central_difference_interval, 0,
  555.     NPSOL_options::central_difference_interval, 0, },
  556.  
  557.   { "crash tolerance",
  558.     { "crash", "tolerance", 0, 0, 0, 0, },
  559.     { 2, 0, 0, 0, 0, 0, }, 1,
  560.     NPSOL_options::set_crash_tolerance, 0,
  561.     NPSOL_options::crash_tolerance, 0, },
  562.  
  563.   { "derivative level",
  564.     { "derivative", "level", 0, 0, 0, 0, },
  565.     { 1, 0, 0, 0, 0, 0, }, 1,
  566.     0, NPSOL_options::set_derivative_level,
  567.     0, NPSOL_options::derivative_level, },
  568.  
  569.   { "difference interval",
  570.     { "difference", "interval", 0, 0, 0, 0, },
  571.     { 3, 0, 0, 0, 0, 0, }, 1,
  572.     NPSOL_options::set_difference_interval, 0,
  573.     NPSOL_options::difference_interval, 0, },
  574.  
  575.   { "function precision",
  576.     { "function", "precision", 0, 0, 0, 0, },
  577.     { 2, 0, 0, 0, 0, 0, }, 1,
  578.     NPSOL_options::set_function_precision, 0,
  579.     NPSOL_options::function_precision, 0, },
  580.  
  581.   { "infinite bound size",
  582.     { "infinite", "bound", "size", 0, 0, 0, },
  583.     { 1, 1, 0, 0, 0, 0, }, 2,
  584.     NPSOL_options::set_infinite_bound, 0,
  585.     NPSOL_options::infinite_bound, 0, },
  586.  
  587.   { "infinite step size",
  588.     { "infinite", "step", "size", 0, 0, 0, },
  589.     { 1, 1, 0, 0, 0, 0, }, 2,
  590.     NPSOL_options::set_infinite_step, 0,
  591.     NPSOL_options::infinite_step, 0, },
  592.  
  593.   { "linear feasibility tolerance",
  594.     { "linear", "feasibility", "tolerance", 0, 0, 0, },
  595.     { 5, 0, 0, 0, 0, 0, }, 1,
  596.     NPSOL_options::set_linear_feasibility_tolerance, 0,
  597.     NPSOL_options::linear_feasibility_tolerance, 0, },
  598.  
  599.   { "linesearch tolerance",
  600.     { "linesearch", "tolerance", 0, 0, 0, 0, },
  601.     { 5, 0, 0, 0, 0, 0, }, 1,
  602.     NPSOL_options::set_linesearch_tolerance, 0,
  603.     NPSOL_options::linesearch_tolerance, 0, },
  604.  
  605.   { "major iteration limit",
  606.     { "major", "iteration", "limit", 0, 0, 0, },
  607.     { 2, 1, 0, 0, 0, 0, }, 2,
  608.     0, NPSOL_options::set_major_iteration_limit,
  609.     0, NPSOL_options::major_iteration_limit, },
  610.  
  611.   { "minor iteration limit",
  612.     { "minor", "iteration", "limit", 0, 0, 0, },
  613.     { 2, 1, 0, 0, 0, 0, }, 2,
  614.     0, NPSOL_options::set_minor_iteration_limit,
  615.     0, NPSOL_options::minor_iteration_limit, },
  616.  
  617.   { "major print level",
  618.     { "major", "print", "level", 0, 0, 0, },
  619.     { 2, 1, 0, 0, 0, 0, }, 2,
  620.     0, NPSOL_options::set_major_print_level,
  621.     0, NPSOL_options::major_print_level, },
  622.  
  623.   { "minor print level",
  624.     { "minor", "print", "level", 0, 0, 0, },
  625.     { 2, 1, 0, 0, 0, 0, }, 2,
  626.     0, NPSOL_options::set_minor_print_level,
  627.     0, NPSOL_options::minor_print_level, },
  628.  
  629.   { "nonlinear feasibility tolerance",
  630.     { "nonlinear", "feasibility", "tolerance", 0, 0, },
  631.     { 1, 0, 0, 0, 0, 0, }, 1,
  632.     NPSOL_options::set_nonlinear_feasibility_tolerance, 0,
  633.     NPSOL_options::nonlinear_feasibility_tolerance, 0, },
  634.  
  635.   { "optimality tolerance",
  636.     { "optimality", "tolerance", 0, 0, 0, 0, },
  637.     { 1, 0, 0, 0, 0, 0, }, 1,
  638.     NPSOL_options::set_optimality_tolerance, 0,
  639.     NPSOL_options::optimality_tolerance, 0, },
  640.  
  641.   { "start objective check at variable",
  642.     { "start", "objective", "check", "at", "variable", 0, },
  643.     { 3, 1, 0, 0, 0, 0, }, 2,
  644.     0, NPSOL_options::set_start_objective_check,
  645.     0, NPSOL_options::start_objective_check, },
  646.  
  647.   { "start constraint check at variable",
  648.     { "start", "constraint", "check", "at", "variable", 0, },
  649.     { 3, 1, 0, 0, 0, 0, }, 2,
  650.     0, NPSOL_options::set_start_constraint_check,
  651.     0, NPSOL_options::start_constraint_check, },
  652.  
  653.   { "stop objective check at variable",
  654.     { "stop", "objective", "check", "at", "variable", 0, },
  655.     { 3, 1, 0, 0, 0, 0, }, 2,
  656.     0, NPSOL_options::set_stop_objective_check,
  657.     0, NPSOL_options::stop_objective_check, },
  658.  
  659.   { "stop constraint check at variable",
  660.     { "stop", "constraint", "check", "at", "variable", 0, },
  661.     { 3, 1, 0, 0, 0, 0, }, 2,
  662.     0, NPSOL_options::set_stop_constraint_check,
  663.     0, NPSOL_options::stop_constraint_check, },
  664.  
  665.   { "verify level",
  666.     { "verify", "level", 0, 0, 0, 0, },
  667.     { 1, 0, 0, 0, 0, 0, }, 1,
  668.     0, NPSOL_options::set_verify_level,
  669.     0, NPSOL_options::verify_level, },
  670.  
  671.   { 0,
  672.     { 0, 0, 0, 0, 0, 0, },
  673.     { 0, 0, 0, 0, 0, 0, }, 0,
  674.     0, 0, 0, 0, },
  675. };
  676.  
  677. static void
  678. print_npsol_option_list (void)
  679. {
  680.   ostrstream output_buf;
  681.  
  682.   print_usage ("npsol_options", 1);
  683.  
  684.   output_buf << "\n"
  685.          << "Options for npsol include:\n\n"
  686.          << "  keyword                                  value\n"
  687.          << "  -------                                  -----\n\n";
  688.  
  689.   NPSOL_OPTIONS *list = npsol_option_table;
  690.  
  691.   const char *keyword;
  692.   while ((keyword = list->keyword) != 0)
  693.     {
  694.       output_buf.form ("  %-40s ", keyword);
  695.       if (list->d_get_fcn)
  696.     {
  697.       double val = (npsol_opts.*list->d_get_fcn) ();
  698.       if (val < 0.0)
  699.         output_buf << "computed automatically";
  700.       else
  701.         output_buf << val;
  702.     }
  703.       else
  704.     {
  705.       int val = (npsol_opts.*list->i_get_fcn) ();
  706.       if (val < 0)
  707.         output_buf << "depends on problem size";
  708.       else
  709.         output_buf << val;
  710.     }
  711.       output_buf << "\n";
  712.       list++;
  713.     }
  714.  
  715.   output_buf << "\n" << ends;
  716.   maybe_page_output (output_buf);
  717. }
  718.  
  719. static void
  720. do_npsol_option (char *keyword, double val)
  721. {
  722.   NPSOL_OPTIONS *list = npsol_option_table;
  723.  
  724.   while (list->keyword != 0)
  725.     {
  726.       if (keyword_almost_match (list->kw_tok, list->min_len, keyword,
  727.                 list->min_toks_to_match, MAX_TOKENS))
  728.     {
  729.       if (list->d_set_fcn)
  730.         (npsol_opts.*list->d_set_fcn) (val);
  731.       else
  732.         {
  733.           if (xisnan (val))
  734.         {
  735.           error ("npsol_options: %s: expecting integer, found NaN",
  736.              keyword);
  737.         }
  738.           else
  739.         (npsol_opts.*list->i_set_fcn) (NINT (val));
  740.         }
  741.       return;
  742.     }
  743.       list++;
  744.     }
  745.  
  746.   warning ("npsol_options: no match for `%s'", keyword);
  747. }
  748.  
  749. #endif
  750.  
  751. #if defined (NPSOL_MISSING)
  752. DEFUN_DLD_BUILTIN ("npsol_options", Fnpsol_options, Snpsol_options, -1, 1,
  753.   "This function requires NPSOL, which is not freely\n\
  754. redistributable.  For more information, read the file\n\
  755. libcruft/npsol/README.MISSING in the source distribution.")
  756. #else
  757. DEFUN_DLD_BUILTIN ("npsol_options", Fnpsol_options, Snpsol_options, -1, 1,
  758.   "npsol_options (KEYWORD, VALUE)\n\
  759. \n\
  760. Set or show options for npsol.  Keywords may be abbreviated\n\
  761. to the shortest match.")
  762. #endif
  763. {
  764.   Octave_object retval;
  765.  
  766. #if defined (NPSOL_MISSING)
  767.  
  768.   print_usage ("npsol_options");
  769.  
  770. #else
  771.  
  772.   int nargin = args.length ();
  773.  
  774.   if (nargin == 0)
  775.     {
  776.       print_npsol_option_list ();
  777.       return retval;
  778.     }
  779.   else if (nargin == 2)
  780.     {
  781.       char *keyword = args(0).string_value ();
  782.  
  783.       if (! error_state)
  784.     {
  785.       double val = args(1).double_value ();
  786.  
  787.       if (! error_state)
  788.         {
  789.           do_npsol_option (keyword, val);
  790.           return retval;
  791.         }
  792.     }
  793.     }
  794.  
  795.   print_usage ("npsol_options");
  796.  
  797. #endif
  798.  
  799.   return retval;
  800. }
  801.  
  802. /*
  803. ;;; Local Variables: ***
  804. ;;; mode: C++ ***
  805. ;;; page-delimiter: "^/\\*" ***
  806. ;;; End: ***
  807. */
  808.