Mercurial > hg > octave-lyh
diff src/fsolve.cc @ 1:78fd87e624cb
[project @ 1993-08-08 01:13:40 by jwe]
Initial revision
author | jwe |
---|---|
date | Sun, 08 Aug 1993 01:13:40 +0000 |
parents | |
children | d68036bcad4c |
line wrap: on
line diff
new file mode 100644 --- /dev/null +++ b/src/fsolve.cc @@ -0,0 +1,164 @@ +// tc-fsolve.cc -*- C++ -*- +/* + +Copyright (C) 1993 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +#ifdef __GNUG__ +#pragma implementation +#endif + +#include "NLEqn.h" + +#include "tree-const.h" +#include "variables.h" +#include "gripes.h" +#include "error.h" +#include "utils.h" + +// Global pointer for user defined function required by hybrd1. +static tree *fsolve_fcn; + +#ifdef WITH_DLD +tree_constant * +builtin_fsolve (tree_constant *args, int nargin, int nargout) +{ + return fsolve (args, nargin, nargout); +} +#endif + +int +hybrd_info_to_fsolve_info (int info) +{ + switch (info) + { + case 0: + info = -1; + break; + case 1: + break; + case 2: + info = 4; + break; + case 3: + case 4: + case 5: + info = 3; + break; + default: + panic_impossible (); + break; + } + return info; +} + +ColumnVector +fsolve_user_function (ColumnVector& x) +{ + ColumnVector retval; + + int n = x.capacity (); + +// tree_constant name = tree_constant (fsolve_fcn->name ()); + tree_constant *args = new tree_constant [2]; +// args[0] = name; + + if (n > 1) + { + Matrix m (n, 1); + for (int i = 0; i < n; i++) + m (i, 0) = x.elem (i); + tree_constant vars (m); + args[1] = vars; + } + else + { + double d = x.elem (0); + tree_constant vars (d); + args[1] = vars; + } + + if (fsolve_fcn != NULL_TREE) + { + tree_constant *tmp = fsolve_fcn->eval (args, 2, 1, 0); + delete [] args; + if (tmp != NULL_TREE_CONST && tmp[0].is_defined ()) + { + retval = tmp[0].to_vector (); + delete [] tmp; + } + else + { + delete [] tmp; + gripe_user_supplied_eval ("fsolve"); + jump_to_top_level (); + } + } + + return retval; +} + +tree_constant * +fsolve (tree_constant *args, int nargin, int nargout) +{ +// Assumes that we have been given the correct number of arguments. + + tree_constant *retval = NULL_TREE_CONST; + + fsolve_fcn = is_valid_function (args[1], "fsolve", 1); + if (fsolve_fcn == NULL_TREE + || takes_correct_nargs (fsolve_fcn, 2, "fsolve", 1) != 1) + return retval; + + ColumnVector x = args[2].to_vector (); + + if (nargin > 3) + message ("fsolve", "ignoring optional arguments..."); + + if (nargout > 2) + message ("fsolve", "can't compute path output yet..."); + + NLFunc foo_fcn (fsolve_user_function); + NLEqn foo (x, foo_fcn); + + int info; + ColumnVector soln = foo.solve (info); + + info = hybrd_info_to_fsolve_info (info); + + retval = new tree_constant [nargout+1]; + retval[0] = tree_constant (soln, 1); + + if (nargout > 1) + retval[1] = tree_constant ((double) info); + + if (nargout > 2) + retval[2] = tree_constant (); + + return retval; +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ +