Mercurial > forge
changeset 2370:24d6a5cdedfe octave-forge
Changed the directory structure to match the package system
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/COPYING Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,339 @@ + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc. + 675 Mass Ave, Cambridge, MA 02139, USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Library General Public License instead.) You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must show them these terms so they know their +rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute verbatim copies of the Program's +source code as you receive it, in any medium, provided that you +conspicuously and appropriately publish on each copy an appropriate +copyright notice and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of this License which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + <one line to give the program's name and a brief idea of what it does.> + Copyright (C) 19yy <name of author> + + This program 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 of the License, or + (at your option) any later version. + + This program 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 this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) 19yy name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, the commands you use may +be called something other than `show w' and `show c'; they could even be +mouse-clicks or menu items--whatever suits your program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the program + `Gnomovision' (which makes passes at compilers) written by James Hacker. + + <signature of Ty Coon>, 1 April 1989 + Ty Coon, President of Vice + +This General Public License does not permit incorporating your program into +proprietary programs. If your program is a subroutine library, you may +consider it more useful to permit linking proprietary applications with the +library. If this is what you want to do, use the GNU Library General +Public License instead of this License.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/DESCRIPTION Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,10 @@ +Name: Optim +Version: 1.0.0 +Date: 2006-08-05 +Author: Various Authors +Maintainer: The Octave Community +Title: Optimzation. +Description: Add a description to this package! +Depends: octave (>= 2.9.7) +License: GPL version 2 or later +Url: http://octave.sf.net
--- a/main/optim/Makefile Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,6 +0,0 @@ -sinclude ../../Makeconf - -all: leval.oct __bfgsmin.oct celleval.oct numgradient.oct numhessian.oct samin.oct - -clean: - -$(RM) *.o core octave-core *.oct *~
--- a/main/optim/__bfgsmin.cc Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,496 +0,0 @@ -// Copyright (C) 2004,2005,2006 Michael Creel <michael.creel@uab.es> -// -// This program 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 of the License, or -// (at your option) any later version. -// -// This program 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 this program; if not, write to the Free Software -// Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - -// the functions defined in this file are: -// __bfgsmin_obj: bulletproofed objective function that allows checking for availability of analytic gradient -// __numgradient: numeric gradient, used only if analytic not supplied -// __bisectionstep: fallback stepsize algorithm -// __newtonstep: default stepsize algorithm -// __bfgsmin: the DLD function that does the minimization, to be called from bfgsmin.m - - - -#include <oct.h> -#include <octave/parse.h> -#include <octave/Cell.h> -#include <float.h> -#include "error.h" - - -int __bfgsmin_obj(double &obj, std::string f, Cell f_args, ColumnVector theta, int minarg) -{ - octave_value_list f_return; - octave_value_list c_args(2,1); // for cellevall {f, f_args} - int success = 1; - - c_args(0) = f; - f_args(minarg - 1) = theta; - c_args(1) = f_args; - f_return = feval("celleval", c_args); - obj = f_return(0).double_value(); - // bullet-proof the objective function - if (error_state) - { - warning("__bfgsmin_obj: objective function could not be evaluated - setting to DBL_MAX"); - obj = DBL_MAX; - success = 0; - } - return success; -} - - -// __numgradient: numeric central difference gradient for bfgs. -// This is the same as numgradient, except the derivative is known to be a vector, it's defined as a column, -// and the finite difference delta is incorporated directly rather than called from a function -int __numgradient(ColumnVector &derivative, std::string f, Cell f_args, int minarg) -{ - double SQRT_EPS, diff, delta, obj_left, obj_right, p; - int j, test, success; - - ColumnVector parameter = f_args(minarg - 1).column_vector_value(); - - int k = parameter.rows(); - ColumnVector g(k); - - for (j=0; j<k; j++) // get 1st derivative by central difference - { - p = parameter(j); - // determine delta for finite differencing - SQRT_EPS = sqrt(DBL_EPSILON); - diff = exp(log(DBL_EPSILON)/3); - test = (fabs(p) + SQRT_EPS) * SQRT_EPS > diff; - if (test) delta = (fabs(p) + SQRT_EPS) * SQRT_EPS; - else delta = diff; - // right side - parameter(j) = p + delta; - success = __bfgsmin_obj(obj_right, f, f_args, parameter, minarg); - if (!success) error("__numgradient: objective function failed, can't compute numeric gradient"); - // left size - parameter(j) = p - delta; - success = __bfgsmin_obj(obj_left, f, f_args, parameter, minarg); - if (!success) error("__numgradient: objective function failed, can't compute numeric gradient"); parameter(j) = p; // restore original parameter for next round - g(j) = (obj_right - obj_left) / (2*delta); - } - derivative = g; - return success; -} - - -int __bfgsmin_gradient(ColumnVector &derivative, std::string f, Cell f_args, ColumnVector theta, int minarg, int try_analytic_gradient, int &have_analytic_gradient) { - octave_value_list f_return; - octave_value_list c_args(2,1); // for cellevall {f, f_args} - int k = theta.rows(); - int success; - ColumnVector g(k); - Matrix check_gradient(k,1); - - if (have_analytic_gradient) { - c_args(0) = f; - f_args(minarg - 1) = theta; - c_args(1) = f_args; - f_return = feval("celleval", c_args); - g = f_return(1).column_vector_value(); - } - - else if (try_analytic_gradient) { - c_args(0) = f; - f_args(minarg - 1) = theta; - c_args(1) = f_args; - f_return = feval("celleval", c_args); - if (f_return.length() > 1) { - if (f_return(1).is_real_matrix()) { - if ((f_return(1).rows() == k) & (f_return(1).columns() == 1)) { - g = f_return(1).column_vector_value(); - have_analytic_gradient = 1; - } - else have_analytic_gradient = 0; - } - else have_analytic_gradient = 0; - } - else have_analytic_gradient = 0; - if (!have_analytic_gradient) __numgradient(g, f, f_args, minarg); - } - else __numgradient(g, f, f_args, minarg); - - // check that gradient is ok - check_gradient.column(0) = g; - if (check_gradient.any_element_is_inf_or_nan()) { - error("__bfgsmin_gradient: gradient contains NaNs or Inf"); - success = 0; - } - else success = 1; - - derivative = g; - return success; -} - - -// this is the lbfgs direction, used if control has 5 elements -ColumnVector lbfgs_recursion(int memory, Matrix sigmas, Matrix gammas, ColumnVector d) -{ - if (memory == 0) - { - const int n = sigmas.columns(); - ColumnVector sig = sigmas.column(n-1); - ColumnVector gam = gammas.column(n-1); - // do conditioning if there is any memory - double cond = gam.transpose()*gam; - if (cond > 0) - { - cond = (sig.transpose()*gam) / cond; - d = cond*d; - } - return d; - } - else - { - const int k = d.rows(); - const int n = sigmas.columns(); - int i, j; - ColumnVector sig = sigmas.column(memory-1); - ColumnVector gam = gammas.column(memory-1); - double rho; - rho = 1.0 / (gam.transpose() * sig); - double alpha; - alpha = rho * (sig.transpose() * d); - d = d - alpha*gam; - d = lbfgs_recursion(memory - 1, sigmas, gammas, d); - d = d + (alpha - rho * gam.transpose() * d) * sig; - } - return d; -} - -// __bisectionstep: fallback stepsize method if __newtonstep fails -int __bisectionstep(double &step, double &obj, std::string f, Cell f_args, ColumnVector dx, int minarg, int verbose) -{ - double obj_0, a; - int found_improvement; - - ColumnVector x (f_args(minarg - 1).column_vector_value()); - - // initial values - obj_0 = obj; - a = 1.0; - found_improvement = 0; - - // this first loop goes until an improvement is found - while (a > 2*DBL_EPSILON) // limit iterations - { - __bfgsmin_obj(obj, f, f_args, x + a*dx, minarg); - // reduce stepsize if worse, or if function can't be evaluated - if ((obj >= obj_0) || lo_ieee_isnan(obj)) a = 0.5 * a; - else - { - obj_0 = obj; - found_improvement = 1; - break; - } - } - // If unable to find any improvement break out with stepsize zero - if (!found_improvement) - { - if (verbose) warning("bisectionstep: unable to find improvement, setting step to zero"); - step = 0.0; - obj = obj_0; - return found_improvement; - } - // now keep going until we no longer improve, or reach max trials - while (a > 2*DBL_EPSILON) - { - a = 0.5*a; - __bfgsmin_obj(obj, f, f_args, x + a*dx, minarg); - // if improved, record new best and try another step - if (obj < obj_0) obj_0 = obj; - else - { - a = a / 0.5; // put it back to best found - break; - } - } - step = a; - obj = obj_0; - return found_improvement; -} - -// __newtonstep: default stepsize algorithm -int __newtonstep(double &a, double &obj, std::string f, Cell f_args, ColumnVector dx, int minarg, int verbose) -{ - double obj_0, obj_left, obj_right, delta, inv_delta_sq, gradient, hessian; - int found_improvement = 0; - - ColumnVector x (f_args(minarg - 1).column_vector_value()); - - // initial value without step - __bfgsmin_obj(obj_0, f, f_args, x, minarg); - - delta = 0.001; // experimentation show that this is a good choice - inv_delta_sq = 1.0 / (delta*delta); - ColumnVector x_right = x + delta*dx; - ColumnVector x_left = x - delta*dx; - - // right - __bfgsmin_obj(obj_right, f, f_args, x_right, minarg); - // left - __bfgsmin_obj(obj_left, f, f_args, x_left, minarg); - - gradient = (obj_right - obj_left) / (2*delta); // take central difference - hessian = inv_delta_sq*(obj_right - 2*obj_0 + obj_left); - hessian = fabs(hessian); // ensures we're going in a decreasing direction - if (hessian < 2*DBL_EPSILON) hessian = 1.0; // avoid div by zero - a = - gradient / hessian; // hessian inverse gradient: the Newton step - if (a < 0) // since direction is descending, a must be positive - { // if it is not, go to bisection step - if (verbose) warning("__stepsize: no improvement with Newton step, falling back to bisection"); - found_improvement = __bisectionstep(a, obj, f, f_args, dx, minarg, verbose); - return 0; - } - - a = (a < 10.0)*a + 10.0*(a>=10.0); // Let's avoid extreme steps that might cause crashes - - // ensure that this is improvement - __bfgsmin_obj(obj, f, f_args, x + a*dx, minarg); - - // if not, fall back to bisection - if ((obj >= obj_0) || lo_ieee_isnan(obj)) - { - if (verbose) warning("__stepsize: no improvement with Newton step, falling back to bisection"); - found_improvement = __bisectionstep(a, obj, f, f_args, dx, minarg, verbose); - } - else found_improvement = 1; - - return found_improvement; -} - - - - -DEFUN_DLD(__bfgsmin, args, ,"__bfgsmin: backend for bfgs minimization\n\ -Users should not use this directly. Use bfgsmin.m instead") { - std::string f (args(0).string_value()); - Cell f_args (args(1).cell_value()); - octave_value_list f_return; // holder for return items - - int max_iters, verbosity, criterion, minarg, convergence, iter, memory, \ - gradient_ok, i, j, k, conv_fun, conv_param, conv_grad, have_gradient, \ - try_gradient, warnings; - double func_tol, param_tol, gradient_tol, stepsize, obj_value, obj_in, last_obj_value, denominator, test; - Matrix H, H1, H2; - ColumnVector thetain, d, g, g_new, p, q, sig, gam; - - // controls - Cell control (args(2).cell_value()); - max_iters = control(0).int_value(); - if (max_iters == -1) max_iters = INT_MAX; - verbosity = control(1).int_value(); - criterion = control(2).int_value(); - minarg = control(3).int_value(); - memory = control(4).int_value(); - func_tol = control(5).double_value(); - param_tol = control(6).double_value(); - gradient_tol = control(7).double_value(); - - // want to see warnings? - warnings = 0; - if (verbosity == 3) warnings = 1; - - // get the minimization argument - ColumnVector theta = f_args(minarg - 1).column_vector_value(); - k = theta.rows(); - - // containers for items in limited memory version - Matrix sigmas(k,memory); - Matrix gammas(k,memory); - - // initialize things - have_gradient = 0; // have analytic gradient - try_gradient = 1; // try to get analytic gradient - convergence = -1; // if this doesn't change, it means that maxiters were exceeded - thetain = theta; - H = identity_matrix(k,k); - - // Initial obj_value - __bfgsmin_obj(obj_in, f, f_args, theta, minarg); - - // Initial gradient (try analytic, and use it if it's close enough to numeric) - __bfgsmin_gradient(g, f, f_args, theta, minarg, 1, have_gradient); // try analytic - if (have_gradient) { // check equality if analytic available - have_gradient = 0; // force numeric - __bfgsmin_gradient(g_new, f, f_args, theta, minarg, 0, have_gradient); - p = g - g_new; - have_gradient = sqrt(p.transpose() * p) < gradient_tol; - } - - last_obj_value = obj_in; // initialize, is updated after each iteration - // MAIN LOOP STARTS HERE - for (iter = 0; iter < max_iters; iter++) { - // make sure the messages aren't stale - conv_fun = -1; - conv_param = -1; - conv_grad = -1; - - if(memory > 0) { // lbfgs - if (iter < memory) d = lbfgs_recursion(iter, sigmas, gammas, g); - else d = lbfgs_recursion(memory, sigmas, gammas, g); - d = -d; - } - else d = -H*g; // ordinary bfgs - - // stepsize: try (l)bfgs direction, then steepest descent if it fails - f_args(minarg - 1) = theta; - __newtonstep(stepsize, obj_value, f, f_args, d, minarg, warnings); - if (stepsize == 0.0) { // fall back to steepest descent - if (warnings) warning("bfgsmin: BFGS direction fails, switch to steepest descent"); - d = -g; // try steepest descent - __newtonstep(stepsize, obj_value, f, f_args, d, minarg, warnings); - if (stepsize == 0.0) { // if true, exit, we can't find a direction of descent - warning("bfgsmin: failure, exiting. Try different start values?"); - f_return(0) = theta; - f_return(1) = obj_value; - f_return(2) = -1; - f_return(3) = iter; - return octave_value_list(f_return); - } - } - p = stepsize*d; - - // check normal convergence: all 3 must be satisfied - // function convergence - if (fabs(last_obj_value) > 1.0) { - conv_fun = (fabs(obj_value - last_obj_value)/fabs(last_obj_value)) < func_tol; - } - else { - conv_fun = fabs(obj_value - last_obj_value) < func_tol; - } - // parameter change convergence - test = sqrt(theta.transpose() * theta); - if (test > 1) conv_param = sqrt(p.transpose() * p) / test < param_tol ; - else conv_param = sqrt(p.transpose() * p) < param_tol; // Want intermediate results? - // gradient convergence - conv_grad = sqrt(g.transpose() * g) < gradient_tol; - - // Want intermediate results? - if (verbosity > 1) { - printf("\n======================================================\n"); - printf("BFGSMIN intermediate results\n"); - printf("\n"); - if (memory > 0) printf("Using LBFGS, memory is last %d iterations\n",memory); - if (have_gradient) printf("Using analytic gradient\n"); - else printf("Using numeric gradient\n"); - printf("\n"); - printf("------------------------------------------------------\n"); - printf("Function conv %d Param conv %d Gradient conv %d\n", conv_fun, conv_param, conv_grad); - printf("------------------------------------------------------\n"); - printf("Objective function value %g\n", last_obj_value); - printf("Stepsize %g\n", stepsize); - printf("%d iterations\n", iter); - printf("------------------------------------------------------\n"); - printf("\n param gradient change\n"); - for (j = 0; j<k; j++) printf("%8.4f %8.4f %8.4f\n",theta(j),g(j),p(j)); - } - // Are we done? - if (criterion == 1) { - if (conv_fun && conv_param && conv_grad) { - convergence = 1; - break; - } - } - else if (conv_fun) { - convergence = 1; - break; - } - last_obj_value = obj_value; - theta = theta + p; - - // new gradient - gradient_ok = __bfgsmin_gradient(g_new, f, f_args, theta, minarg, try_gradient, have_gradient); - - if (memory == 0) { //bfgs? - // Hessian update if gradient ok - if (gradient_ok) { - q = g_new-g; - g = g_new; - denominator = q.transpose()*p; - if ((fabs(denominator) < DBL_EPSILON)) { // reset Hessian if necessary - if (verbosity == 1) printf("bfgsmin: Hessian reset\n"); - H = identity_matrix(k,k); - } - else { - H1 = (1.0+(q.transpose() * H * q) / denominator) / denominator \ - * (p * p.transpose()); - H2 = (p * q.transpose() * H + H*q*p.transpose()); - H2 = H2 / denominator; - H = H + H1 - H2; - } - } - else H = identity_matrix(k,k); // reset hessian if gradient fails - // then try to start again with steepest descent - } - else { // otherwise lbfgs - // save components for Hessian if gradient ok - if (gradient_ok) { - sig = p; // change in parameter - gam = g_new - g; // change in gradient - g = g_new; - // shift remembered vectors to the right (forget last) - for(j = memory - 1; j > 0; j--) { - for(i = 0; i < k; i++) { - sigmas(i,j) = sigmas(i,j-1); - gammas(i,j) = gammas(i,j-1); - } - } - // insert new vectors in left-most column - for(i = 0; i < k; i++) { - sigmas(i, 0) = sig(i); - gammas(i, 0) = gam(i); - } - } - else { // failed gradient - loose memory and use previous theta - sigmas.fill(0.0); - gammas.fill(0.0); - theta = theta - p; - } - } - } - - // Want last iteration results? - if (verbosity > 0) { - printf("\n======================================================\n"); - printf("BFGSMIN final results\n"); - printf("\n"); - if (memory > 0) printf("Used LBFGS, memory is last %d iterations\n",memory); - if (have_gradient) printf("Used analytic gradient\n"); - else printf("Used numeric gradient\n"); - printf("\n"); - printf("------------------------------------------------------\n"); - if (convergence == -1) printf("NO CONVERGENCE: max iters exceeded\n"); - if ((convergence == 1) & (criterion == 1)) printf("STRONG CONVERGENCE\n"); - if ((convergence == 1) & !(criterion == 1)) printf("WEAK CONVERGENCE\n"); - if (convergence == 2) printf("NO CONVERGENCE: algorithm failed\n"); - printf("Function conv %d Param conv %d Gradient conv %d\n", conv_fun, conv_param, conv_grad); - printf("------------------------------------------------------\n"); - printf("Objective function value %g\n", last_obj_value); - printf("Stepsize %g\n", stepsize); - printf("%d iterations\n", iter); - printf("------------------------------------------------------\n"); - printf("\n param gradient change\n"); - for (j = 0; j<k; j++) printf("%8.4f %8.4f %8.4f\n",theta(j),g(j),p(j)); - } - f_return(0) = theta; - f_return(1) = obj_value; - f_return(2) = convergence; - f_return(3) = iter; - return octave_value_list(f_return); -}
--- a/main/optim/adsmax.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,158 +0,0 @@ -function [x, fmax, nf] = adsmax(f, x, stopit, savit, P, varargin) -%ADSMAX Alternating directions method for direct search optimization. -% [x, fmax, nf] = ADSMAX(FUN, x0, STOPIT, SAVIT, P) attempts to -% maximize the function FUN, using the starting vector x0. -% The alternating directions direct search method is used. -% Output arguments: -% x = vector yielding largest function value found, -% fmax = function value at x, -% nf = number of function evaluations. -% The iteration is terminated when either -% - the relative increase in function value between successive -% iterations is <= STOPIT(1) (default 1e-3), -% - STOPIT(2) function evaluations have been performed -% (default inf, i.e., no limit), or -% - a function value equals or exceeds STOPIT(3) -% (default inf, i.e., no test on function values). -% Progress of the iteration is not shown if STOPIT(5) = 0 (default 1). -% If a non-empty fourth parameter string SAVIT is present, then -% `SAVE SAVIT x fmax nf' is executed after each inner iteration. -% By default, the search directions are the co-ordinate directions. -% The columns of a fifth parameter matrix P specify alternative search -% directions (P = EYE is the default). -% NB: x0 can be a matrix. In the output argument, in SAVIT saves, -% and in function calls, x has the same shape as x0. -% ADSMAX(fun, x0, STOPIT, SAVIT, P, P1, P2,...) allows additional -% arguments to be passed to fun, via feval(fun,x,P1,P2,...). - -% From Matrix Toolbox -% Copyright (C) 2002 N.J.Higham -% www.maths.man.ac.uk/~higham/mctoolbox -% distributed under the terms of the GNU General Public License -% -% Modifications for octave by A.Adler 2003 -% $Id$ - -% Reference: -% N. J. Higham, Optimization by direct search in matrix computations, -% SIAM J. Matrix Anal. Appl, 14(2): 317-333, 1993. -% N. J. Higham, Accuracy and Stability of Numerical Algorithms, -% Second edition, Society for Industrial and Applied Mathematics, -% Philadelphia, PA, 2002; sec. 20.5. - -x0 = x(:); % Work with column vector internally. -n = length(x0); - -mu = 1e-4; % Initial percentage change in components. -nstep = 25; % Max number of times to double or decrease h. - -% Set up convergence parameters. -if nargin < 3 - stopit(1) = 1e-3; -elseif isempty(stopit) - stopit(1) = 1e-3; -endif -tol = stopit(1); % Required rel. increase in function value over one iteration. -if length(stopit) == 1, stopit(2) = inf; end % Max no. of f-evaluations. -if length(stopit) == 2, stopit(3) = inf; end % Default target for f-values. -if length(stopit) < 5, stopit(5) = 1; end % Default: show progress. -trace = stopit(5); -if length(stopit) == 5, stopit(6) = 1; end % Default: maximize -dirn= stopit(6); -if nargin < 4, savit = []; end % File name for snapshots. - -% Matrix of search directions. -if nargin < 5 - P = eye(n); -elseif isempty(P) - P = eye(n); -else - if ~isequal(size(P),[n n]) % Check for common error. - error('P must be of dimension the number of elements in x0.') - end -end - -fmax = dirn*feval(f,x,varargin{:}); nf = 1; -if trace, fprintf('f(x0) = %9.4e\n', fmax), end - -steps = zeros(n,1); -it = 0; y = x0; - -while 1 % Outer loop. -it = it+1; -if trace, fprintf('Iter %2.0f (nf = %2.0f)\n', it, nf), end -fmax_old = fmax; - -for i=1:n % Loop over search directions. - - pi = P(:,i); - flast = fmax; - yi = y; - h = sign(pi'*yi)*norm(pi.*yi)*mu; % Initial step size. - if h == 0, h = max(norm(yi,inf),1)*mu; end - y = yi + h*pi; - x(:) = y; fnew = dirn*feval(f,x,varargin{:}); nf = nf + 1; - if fnew > fmax - fmax = fnew; - if fmax >= stopit(3) - if trace - fprintf('Comp. = %2.0f, steps = %2.0f, f = %9.4e*\n', i,0,fmax) - fprintf('Exceeded target...quitting\n') - end - x(:) = y; return - end - h = 2*h; lim = nstep; k = 1; - else - h = -h; lim = nstep+1; k = 0; - end - - for j=1:lim - y = yi + h*pi; - x(:) = y; fnew = dirn*feval(f,x,varargin{:}); nf = nf + 1; - if fnew <= fmax, break, end - fmax = fnew; k = k + 1; - if fmax >= stopit(3) - if trace - fprintf('Comp. = %2.0f, steps = %2.0f, f = %9.4e*\n', i,j,fmax) - fprintf('Exceeded target...quitting\n') - end - x(:) = y; return - end - h = 2*h; - end - - steps(i) = k; - y = yi + 0.5*h*pi; - if k == 0, y = yi; end - - if trace - fprintf('Comp. = %2.0f, steps = %2.0f, f = %9.4e', i, k, fmax) - fprintf(' (%2.1f%%)\n', 100*(fmax-flast)/(abs(flast)+eps)) - end - - - if nf >= stopit(2) - if trace - fprintf('Max no. of function evaluations exceeded...quitting\n') - end - x(:) = y; return - end - - if fmax > flast & ~isempty(savit) - x(:) = y; - eval(['save ' savit ' x fmax nf']) - end - -end % Loop over search directions. - -if isequal(steps,zeros(n,1)) - if trace, fprintf('Stagnated...quitting\n'), end - x(:) = y; return -end - -if fmax-fmax_old <= tol*abs(fmax_old) - if trace, fprintf('Function values ''converged''...quitting\n'), end - x(:) = y; return -end - -end %%%%%% Of outer loop.
--- a/main/optim/battery.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,51 +0,0 @@ -# Copyright (C) 2004 Michael Creel <michael.creel@uab.es> -# -# This program 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 of the License, or -# (at your option) any later version. -# -# This program 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 this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -# (c) Michael Creel <michael.creel@uab.es> - -# battery.m: repeatedly call bfgs using a battery of -# start values, to attempt to find global min -# of a nonconvex function - -# INPUTS: -# func: function to mimimize -# args: args of function -# minarg: argument to minimize w.r.t. (usually = 1) -# startvals: kxp matrix of values to try for sure (don't include all zeros, that's automatic) -# max iters per start value -# number of additional random start values to try - -# OUTPUT: theta - the best value found - NOT iterated to convergence - -function theta = battery(func, args, minarg, startvals, maxiters) - -# setup -[k,trials] = size(startvals); -bestobj = inf; -besttheta = zeros(k,1); -bfgscontrol = {maxiters,0,0,1}; -# now try the supplied start values, and optionally the random start values -for i = 1:trials - args{minarg} = startvals(:,i); - [theta, obj_value, convergence] = bfgsmin (func, args, bfgscontrol); - - if obj_value < bestobj - besttheta = theta; - bestobj = obj_value; - endif -endfor - -theta = besttheta; -endfunction
--- a/main/optim/bfgsmin.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,131 +0,0 @@ -## Copyright (C) 2006 Michael Creel <michael.creel@uab.es> -## -## This program 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 of the License, or -## (at your option) any later version. -## -## This program 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 this program; if not, write to the Free Software -## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - -## bfgsmin: bfgs or limited memory bfgs minimization of function -## -## Usage: [x, obj_value, convergence, iters] = bfgsmin(f, args, control) -## -## The function must be of the form -## [value, return_2,..., return_m] = f(arg_1, arg_2,..., arg_n) -## By default, minimization is w.r.t. arg_1, but it can be done -## w.r.t. any argument that is a vector. Numeric derivatives are -## used unless analytic derivatives are supplied. See bfgsmin_example.m -## for methods. -## -## Arguments: -## * f: name of function to minimize (string) -## * args: a cell array that holds all arguments of the function -## The argument with respect to which minimization is done -## MUST be a vector -## * control: an optional cell array of 1-8 elements. If a cell -## array shorter than 8 elements is provided, the trailing elements -## are provided with default values. -## * elem 1: maximum iterations (positive integer, or -1 or Inf for unlimited (default)) -## * elem 2: verbosity -## 0 = no screen output (default) -## 1 = only final results -## 2 = summary every iteration -## 3 = detailed information -## * elem 3: convergence criterion -## 1 = strict (function, gradient and param change) (default) -## 2 = weak - only function convergence required -## * elem 4: arg in f_args with respect to which minimization is done (default is first) -## * elem 5: (optional) Memory limit for lbfgs. If it's a positive integer -## then lbfgs will be use. Otherwise ordinary bfgs is used -## * elem 6: function change tolerance, default 1e-12 -## * elem 7: parameter change tolerance, default 1e-6 -## * elem 8: gradient tolerance, default 1e-5 -## -## Returns: -## * x: the minimizer -## * obj_value: the value of f() at x -## * convergence: 1 if normal conv, other values if not -## * iters: number of iterations performed -## -## Example: see bfgsmin_example.m - -function [parameter, obj, convergence, iters] = bfgsmin(f, f_args, control) - - # check number and types of arguments - if ((nargin < 2) || (nargin > 3)) - usage("bfgsmin: you must supply 2 or 3 arguments"); - endif - if (!isstr(f)) usage("bfgsmin: first argument must be string holding objective function name"); endif - if (!iscell(f_args)) usage("bfgsmin: second argument must cell array of function arguments"); endif - if (nargin > 2) - if (!iscell(control)) - usage("bfgsmin: 3rd argument must be a cell array of 1-8 elements"); - endif - if (length(control) > 8) - usage("bfgsmin: 3rd argument must be a cell array of 1-8 elements"); - endif - else control = {}; - endif - - # provide defaults for missing controls - if (length(control) == 0) control{1} = -1; endif # limit on iterations - if (length(control) == 1) control{2} = 0; endif # level of verbosity - if (length(control) == 2) control{3} = 1; endif # strong (function, gradient and parameter change) convergence required? - if (length(control) == 3) control{4} = 1; endif # argument with respect to which minimization is done - if (length(control) == 4) control{5} = 0; endif # memory for lbfgs: 0 uses ordinary bfgs - if (length(control) == 5) control{6} = 1e-12; endif # tolerance for function convergence - if (length(control) == 6) control{7} = 1e-6; endif # tolerance for parameter convergence - if (length(control) == 7) control{8} = 1e-5; endif # tolerance for gradient convergence - - # validity checks on all controls - tmp = control{1}; - if (((tmp !=Inf) || (tmp != -1)) & (tmp > 0 & (mod(tmp,1) != 0))) - usage("bfgsmin: 1st element of 3rd argument (iteration limit) must be Inf or positive integer"); - endif - tmp = control{2}; - if ((tmp < 0) || (tmp > 3) || (mod(tmp,1) != 0)) - usage("bfgsmin: 2nd element of 3rd argument (verbosity level) must be 0, 1, 2, or 3"); - endif - tmp = control{3}; - if ((tmp != 0) & (tmp != 1)) - usage("bfgsmin: 3rd element of 3rd argument (strong/weak convergence) must be 0 (weak) or 1 (strong)"); - endif - tmp = control{4}; - if ((tmp < 1) || (tmp > length(f_args)) || (mod(tmp,1) != 0)) - usage("bfgsmin: 4th element of 3rd argument (arg with respect to which minimization is done) must be an integer that indicates one of the elements of f_args"); - endif - tmp = control{5}; - if ((tmp < 0) || (mod(tmp,1) != 0)) - usage("bfgsmin: 5th element of 3rd argument (memory for lbfgs must be zero (regular bfgs) or a positive integer"); - endif - tmp = control{6}; - if (tmp < 0) - usage("bfgsmin: 6th element of 3rd argument (tolerance for function convergence) must be a positive real number"); - endif - tmp = control{7}; - if (tmp < 0) - usage("bfgsmin: 7th element of 3rd argument (tolerance for parameter convergence) must be a positive real number"); - endif - tmp = control{8}; - if (tmp < 0) - usage("bfgsmin: 8th element of 3rd argument (tolerance for gradient convergence) must be a positive real number"); - endif - - # check that the parameter we minimize w.r.t. is a vector - minarg = control{4}; - theta = f_args{minarg}; - theta = theta(:); - if (!is_vector(theta)) usage("bfgsmin: minimization must be done with respect to a vector of parameters"); endif - f_args{minarg} = theta; - - # now go ahead and do the minimization - [parameter, obj, convergence, iters] = __bfgsmin(f, f_args, control); -endfunction
--- a/main/optim/bfgsmin_example.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,163 +0,0 @@ -# Copyright (C) 2004,2005,2006 Michael Creel <michael.creel@uab.es> -# -# This program 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 of the License, or -# (at your option) any later version. -# -# This program 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 this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - -# usage: bfgsmin_example (to run) or edit bfgsmin_example (to examine) -## -# Shows how to call bfgsmin. There are two objective functions, the first -# supplies the analytic gradient, and the second does not. The true minimizer -# is at "location", a 50x1 vector (0.00, 0.02, 0.04 ..., 1.00). -# Note that limited memory bfgs is faster when the dimension is high. -# Also note that supplying analytic derivatives gives a speedup. -## -# Six examples are given: -# Example 1: regular bfgs, analytic gradient -# Example 2: same as Example 1, but verbose -# Example 3: limited memory bfgs, analytic gradient -# Example 4: regular bfgs, numeric gradient -# Example 5: limited memory bfgs, numeric gradient -# Example 6: regular bfgs, analytic gradient, minimize wrt second argument -1; -# example obj. fn.: supplies analytic gradient -function [obj_value, gradient] = objective(theta, location) - x = theta - location + ones(rows(theta),1); # move minimizer to "location" - [obj_value, gradient] = rosenbrock(x); -endfunction - -# example obj. fn.: no gradient -function obj_value = objective2(theta, location) - x = theta - location + ones(rows(theta),1); # move minimizer to "location" - obj_value = rosenbrock(x); -endfunction - - -# initial values -dim = 50; # dimension of Rosenbrock function -theta0 = zeros(dim+1,1); # starting values -location = (0:dim)/dim; # true values -location = location'; - -printf("EXAMPLE 1: Ordinary BFGS, using analytic gradient\n"); -t=cputime(); -control = {-1;1}; # maxiters, verbosity -[theta, obj_value, convergence] = bfgsmin("objective", {theta0, location}, control); -printf("EXAMPLE 1: Ordinary BFGS, using analytic gradient\n"); -t = cputime() - t; -conv = norm(theta-location, 'inf'); -test = conv < 1e-5; -if test - printf("Success!! :-)\n"); -else - printf("Failure?! :-(\n"); -endif -printf("Elapsed time = %f\n\n\n\n",t); -pause(5); - -printf("EXAMPLE 2: Same as Example 1, but verbose\n"); -t=cputime(); -control = {-1;3}; # maxiters, verbosity -[theta, obj_value, convergence] = bfgsmin("objective", {theta0, location}, control); -printf("EXAMPLE 2: Same as Example 1, but verbose\n"); -t = cputime() - t; -conv = norm(theta-location, 'inf'); -test = conv < 1e-5; -if test - printf("Success!! :-)\n"); -else - printf("Failure?! :-(\n"); -endif -printf("Elapsed time = %f\n\n\n\n",t); -pause(5); - - -printf("EXAMPLE 3: Limited memory BFGS, using analytic gradient\n"); -t=cputime(); -control = {-1;1;1;1;5}; # maxiters, verbosity, conv. requirement., arg_to_min, lbfgs memory -[theta, obj_value, convergence] = bfgsmin("objective", {theta0, location}, control); -printf("EXAMPLE 3: Limited memory BFGS, using analytic gradient\n"); -t = cputime() - t; -conv = norm(theta-location, 'inf'); -test = conv < 1e-5; -if test - printf("Success!! :-)\n"); -else - printf("Failure?! :-(\n"); -endif -printf("Elapsed time = %f\n\n\n\n",t); -pause(5); - -printf("EXAMPLE 4: Ordinary BFGS, using numeric gradient\n"); -t=cputime(); -control = {-1;1}; # maxiters, verbosity -[theta, obj_value, convergence] = bfgsmin("objective2", {theta0, location}, control); -printf("EXAMPLE 4: Ordinary BFGS, using numeric gradient\n"); -t = cputime() - t; -conv = norm(theta-location, 'inf'); -test = conv < 1e-5; -if test - printf("Success!! :-)\n"); -else - printf("Failure?! :-(\n"); -endif -printf("Elapsed time = %f\n\n\n\n",t); -pause(5); - -printf("EXAMPLE 5: Limited memory BFGS, using numeric gradient\n"); -t=cputime(); -control = {-1;1;1;1;5}; # maxiters, verbosity, conv. reg., arg_to_min, lbfgs memory -[theta, obj_value, convergence] = bfgsmin("objective2", {theta0, location}, control); -printf("EXAMPLE 5: Limited memory BFGS, using numeric gradient\n"); -t = cputime() - t; -conv = norm(theta-location, 'inf'); -test = conv < 1e-5; -if test - printf("Success!! :-)\n"); -else - printf("Failure?! :-(\n"); -endif -printf("Elapsed time = %f\n\n\n\n",t); -pause(5); - -printf("EXAMPLE 6: Funny case: minimize w.r.t. second argument, Ordinary BFGS, using numeric gradient\n"); -t=cputime(); -control = {-1;1;1;2}; # maxiters, verbosity, conv. reg., arg_to_min -[theta, obj_value, convergence] = bfgsmin("objective2", {location, theta0}, control); -printf("EXAMPLE 6: Funny case: minimize w.r.t. second argument, Ordinary BFGS, using numeric gradient\n"); -t = cputime() - t; -conv = norm(theta-location, 'inf'); -test = conv < 1e-5; -if test - printf("Success!! :-)\n"); -else - printf("Failure?! :-(\n"); -endif -printf("Elapsed time = %f\n\n\n\n",t); - -printf("EXAMPLE 7: Ordinary BFGS, using numeric gradient, using non-default tolerances\n"); -t=cputime(); -control = {-1;1;1;1;0;1e-6;1e-2;1e-2}; # maxiters, verbosity, conv. reg., arg_to_min, lbfgs memory, fun. tol., param. tol., gradient tol. -[theta, obj_value, convergence] = bfgsmin("objective2", {theta0, location}, control); -printf("EXAMPLE 7: Ordinary BFGS, using numeric gradient. Note that gradient is only roughly zero.\n"); -t = cputime() - t; -conv = norm(theta-location, 'inf'); -test = conv < 1e-2; -if test - printf("Success!! :-)\n"); -else - printf("Failure?! :-(\n"); -endif -printf("Elapsed time = %f\n\n\n\n",t); -pause(5); -
--- a/main/optim/bs_gradient.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,4 +0,0 @@ -function [dx,nev] = bs_gradient (f, args, narg) - error("bs_gradient: bs_gradient has been replaced by numgradient"); -endfunction -
--- a/main/optim/cdiff.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,152 +0,0 @@ -## Copyright (C) 2002 Etienne Grossmann. All rights reserved. -## -## This program 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. -## -## This 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. - -## c = cdiff (func,wrt,N,dfunc,stack,dx) - Code for num. differentiation -## = "function df = dfunc (var1,..,dvar,..,varN) .. endfunction -## -## Returns a string of octave code that defines a function 'dfunc' that -## returns the derivative of 'func' with respect to it's 'wrt'th -## argument. -## -## The derivatives are obtained by symmetric finite difference. -## -## dfunc()'s return value is in the same format as that of ndiff() -## -## func : string : name of the function to differentiate -## -## wrt : int : position, in argument list, of the differentiation -## variable. Default:1 -## -## N : int : total number of arguments taken by 'func'. -## If N=inf, dfunc will take variable argument list. -## Default:wrt -## -## dfunc : string : Name of the octave function that returns the -## derivatives. Default:['d',func] -## -## stack : string : Indicates whether 'func' accepts vertically -## (stack="rstack") or horizontally (stack="cstack") -## arguments. Any other string indicates that 'func' -## does not allow stacking. Default:'' -## -## dx : real : Step used in the symmetric difference scheme. -## Default:10*sqrt(eps) -## -## See also : ndiff, eval, todisk -## -function c = cdiff (func,wrt,nargs,dfunc,stack,dx) - -if nargin<2, - wrt = 1 ; -end -if nargin<3, - nargs = wrt ; -end -if nargin<4 || strcmp(dfunc,""), - dfunc = ["d",func] ; - if exist(dfunc)>=2, - printf(["cdiff : Warning : name of derivative not specified\n",\ - " and canonic name '%s' is already taken\n"],\ - dfunc); - ## keyboard - end -end -if nargin<5, stack = "" ; end -if nargin<6, dx = 10*sqrt(eps) ; end - -## verbose = 0 ; -## build argstr = "var1,..,dvar,...var_nargs" -if isfinite (nargs) - argstr = sprintf("var%i,",1:nargs); -else - argstr = [sprintf("var%i,",1:wrt),"...,"]; -end - -argstr = strrep(argstr,sprintf("var%i",wrt),"dvar") ; -argstr = argstr(1:length(argstr)-1) ; - -if strcmp("cstack",stack) , # Horizontal stacking ################ - - calstr = "reshape (kron(ones(1,2*ps), dvar(:))+[-dx*eye(ps),dx*eye(ps)], sz.*[1,2*ps])"; - calstr = strrep(argstr,"dvar",calstr) ; - calstr = sprintf("%s(%s)",func,calstr) ; - - calstr = sprintf(strcat(" res = %s;\n", - " pr = prod (size(res)) / (2*ps);\n", - " res = reshape (res,pr,2*ps);\n", - " df = (res(:,ps+1:2*ps)-res(:,1:ps)) / (2*dx);\n"), - calstr) ; - - -elseif strcmp("rstack",stack), # Vertical stacking ################## - - calstr = "kron(ones(2*ps,1),dvar)+dx*[-dv;dv]" ; - calstr = strrep(argstr,"dvar",calstr) ; - calstr = sprintf("%s(%s)",func,calstr) ; - - calstr = sprintf(strcat(" dv = kron (eye(sz(2)), eye(sz(1))(:));\n",\ - " res = %s;\n",\ - " sr = size(res)./[2*ps,1];\n",\ - " pr = prod (sr);\n",\ - " df = (res(sr(1)*ps+1:2*sr(1)*ps,:)-res(1:sr(1)*ps,:))/(2*dx);\n",\ - " scramble = reshape (1:pr,sr(2),sr(1))';\n",\ - " df = reshape (df',pr,ps)(scramble(:),:);\n"),\ - calstr) ; - ## sayif(verbose,"cdiff : calstr='%s'\n",calstr) ; -else # No stacking ######################## - calstr = sprintf("%s (%s)",func,argstr) ; - ## "func(var1,dvar%sdv(:,%d:%d),...,varN)," - ## calstr = strrep(calstr,"dvar","dvar%sdv(:,(i-1)*sz(2)+1:i*sz(2))")(:)'; - - calstr = strrep(calstr,"dvar","dvar%sdv")(:)'; - - ## func(..,dvar+dv(:,1:sz(2)),..) - func(..) - calstr = strcat(calstr,"-",calstr) ; ## strcat(calstr,"-",calstr) ; - calstr = sprintf(calstr,"+","-") ; - tmp = calstr ; - ## sayif(verbose,"cdiff : calstr='%s'\n",calstr) ; - calstr = sprintf(strcat(" dv = zeros (sz); dv(1) = dx;\n",\ - " df0 = %s;\n",\ - " sr = size (df0);\n",\ - " df = zeros(prod (sr),ps); df(:,1) = df0(:);\n",\ - " for i = 2:ps,\n",\ - " dv(i) = dx; dv(i-1) = 0;\n",\ - " df(:,i) = (%s)(:);\n",\ - " end;\n",\ - " df ./= 2*dx;\n" - ), - calstr, tmp) ; - - - ## sayif(verbose,"cdiff : calstr='%s'\n",calstr) ; - - ## "func(var1,reshape(dvar(1:NV,1),SZ1,SZ2),...,varN)," , - ## "func(var1,reshape(dvar(1:NV,2),SZ1,SZ2),...,varN)," , ... - ## "func(var1,reshape(dvar(1:NV,NP),SZ1,SZ2),...,varN)" - ## sayif(verbose,"cdiff : calstr='%s'\n",calstr) ; -end -argstr = strrep (argstr, "...", "varargin"); -calstr = strrep (calstr, "...", "varargin{:}"); - -c = sprintf(strcat("function df = %s (%s)\n",\ - " ## Numerical differentiation of '%s' wrt to it's %d'th argument\n",\ - " ## This function has been written by 'cdiff()'\n",\ - " dx = %e;\n",\ - " sz = size (dvar);\n",\ - " ps = prod (sz);\n",\ - "%s",\ - "endfunction\n"),\ - dfunc,argstr,\ - func,wrt,\ - dx,\ - calstr) ; -
--- a/main/optim/celleval.cc Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,69 +0,0 @@ -// Copyright (C) 2004 Michael Creel <michael.creel@uab.es> -// -// This program 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 of the License, or -// (at your option) any later version. -// -// This program 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 this program; if not, write to the Free Software -// Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - -// a descendant of "leval", by Etienne Grossman - -#include "config.h" -#include <oct.h> -#include <octave/parse.h> -#include <octave/Cell.h> -#include <octave/lo-mappers.h> - -DEFUN_DLD (celleval, args, nargout, "celleval (name, cell_array)\n\ -Evaluate the function named \"name\". All the elements in cell_array\n\ -are passed on to the named function.\n\ -Example:\n\ -function a = f(b,c)\n\ - a = b + c;\n\ -endfunction\n\ -celleval(\"f\", {1,2,\"this\"})\n\ -ans = 3\n\ -") -{ - octave_value_list retval; - int nargin = args.length (); - if (!(nargin == 2)) - { - error("celleval: you must supply exactly 2 arguments"); - return octave_value_list(); - } - if (!args(0).is_string()) - { - error ("celleval: first argument must be a string"); - return octave_value_list(); - } - if (!args(1).is_cell()) - { - error ("celleval: second argument must be a cell"); - return octave_value_list(); - } - - std::string name = args(0).string_value (); - Cell f_args_cell = args(1).cell_value (); - int k = f_args_cell.length(); - int i; - // a list to copy the cell contents into, so feval can be used - octave_value_list f_args(k,1); - - // copy contents over - for (i = 0; i<k; i++) f_args(i) = f_args_cell(i); - - // evaluate the function - retval = feval (name, f_args, nargout); - - return retval; -} -
--- a/main/optim/d2_min.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,392 +0,0 @@ -## Copyright (C) 2002 Etienne Grossmann. All rights reserved. -## -## This program 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. -## -## This 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. -## -## Changelog: -## 2002 / 05 / 09 : Heuristic for negative hessian - -## [x,v,nev,h,args] = d2_min(f,d2f,args,ctl,code) - Newton-like minimization -## -## Minimize f(x) using 1st and 2nd derivatives. Any function w/ second -## derivatives can be minimized, as in Newton. f(x) decreases at each -## iteration, as in Levenberg-Marquardt. This function is inspired from the -## Levenberg-Marquardt algorithm found in the book "Numerical Recipes". -## -## ARGUMENTS : -## f : string : Cost function's name -## -## d2f : string : Name of function returning the cost (1x1), its -## differential (1xN) and its second differential or it's -## pseudo-inverse (NxN) (see ctl(5) below) : -## -## [v,dv,d2v] = d2f (x). -## -## args : list : f and d2f's arguments. By default, minimize the 1st -## or matrix : argument. -## -## ctl : vector : Control arguments (see below) -## or struct -## -## code : string : code will be evaluated after each outer loop that -## produced some (any) improvement. Variables visible from -## "code" include "x", the best parameter found, "v" the -## best value and "args", the list of all arguments. All can -## be modified. This option can be used to re-parameterize -## the argument space during optimization -## -## CONTROL VARIABLE ctl : (optional). May be a struct or a vector of length -## ---------------------- 5 or less where NaNs are ignored. Default values -## are written <value>. -## FIELD VECTOR -## NAME POS -## -## ftol, f N/A : Stop search when value doesn't improve, as tested by -## -## f > Deltaf/max(|f(x)|,1) -## -## where Deltaf is the decrease in f observed in the last -## iteration. <10*sqrt(eps)> -## -## utol, u N/A : Stop search when updates are small, as tested by -## -## u > max { dx(i)/max(|x(i)|,1) | i in 1..N } -## -## where dx is the change in the x that occured in the last -## iteration. <NaN> -## -## dtol, d N/A : Stop search when derivative is small, as tested by -## -## d > norm (dv) <eps> -## -## crit, c ctl(1) : Set one stopping criterion, 'ftol' (c=1), 'utol' (c=2) -## or 'dtol' (c=3) to the value of by the 'tol' option. <1> -## -## tol, t ctl(2) : Threshold in termination test chosen by 'crit' <10*eps> -## -## narg, n ctl(3) : Position of the minimized argument in args <1> -## maxev,m ctl(4) : Maximum number of function evaluations <inf> -## maxout,m : Maximum number of outer loops <inf> -## id2f, i ctl(5) : 0 if d2f returns the 2nd derivatives, 1 if <0> -## it returns its pseudo-inverse. -## -## verbose, v N/A : Be more or less verbose (quiet=0) <0> - -function [xbest,vbest,nev,hbest,args] = d2_min (f,d2f,args,ctl,code) - -## Author : Etienne Grossmann <etienne@cs.uky.edu> -## - -maxout = inf; -maxinner = 30 ; - -tcoeff = 0.5 ; # Discount on total weight -ncoeff = 0.5 ; # Discount on weight of newton -ocoeff = 1.5 ; # Factor for outwards searching - -report = 0 ; # Never report -verbose = 0 ; # Be quiet -prudent = 1 ; # Check coherence of d2f and f? - -niter = 0 ; - -crit = 0; # Default control variables -ftol = 10 * sqrt (eps); -dtol = eps; -utol = tol = nan; -narg = 1; -maxev = inf; -id2f = 0; - -if nargin >= 4 # Read arguments - if isnumeric (ctl) - if length (ctl)>=1 && !isnan (ctl(1)), crit = ctl(1); end - if length (ctl)>=2 && !isnan (ctl(2)), tol = ctl(2); end - if length (ctl)>=3 && !isnan (ctl(3)), narg = ctl(3); end - if length (ctl)>=4 && !isnan (ctl(4)), maxev = ctl(4); end - if length (ctl)>=5 && !isnan (ctl(5)), id2f = ctl(5); end - elseif isstruct (ctl) - if struct_contains (ctl, "crit") , crit = ctl.crit ; end - if struct_contains (ctl, "tol") , tol = ctl.tol ; end - if struct_contains (ctl, "narg") , narg = ctl.narg ; end - if struct_contains (ctl, "maxev") , maxev = ctl.maxev ; end - if struct_contains (ctl, "maxout") , maxout = ctl.maxout ; end - if struct_contains (ctl, "id2f") , id2f = ctl.id2f ; end - if struct_contains (ctl, "verbose"), verbose = ctl.verbose; end - if struct_contains (ctl, "code") , code = ctl.code ; end - else - error ("The 'ctl' argument should be either a vector or a struct"); - end -end - -if crit == 1, ftol = tol; -elseif crit == 2, utol = tol; -elseif crit == 3, dtol = tol; -elseif crit, error ("crit is %i. Should be 1,2 or 3.\n"); -end - - -if nargin < 5, code = "" ; end - -if is_list (args) # List of arguments - x = nth (args, narg); -else # Single argument - x = args; - args = list (args); -end - -############################## Checking ############################## -if narg > length (args) - error ("d2_min : narg==%i, length (args)==%i\n", - narg, length (args)); -end - -if tol <= 0 - printf ("d2_min : tol=%8.3g <= 0\n",tol) ; -end - -if !ischar (d2f) || !ischar (f) - printf ("d2_min : f and d2f should be strings!\n"); -end - -sz = size (x); N = prod (sz); - -v = leval (f, args); -nev = [1,0]; - -if prudent && (! isnumeric (v) || isnan (v) || any (size (v)>1)) - error ("Function '%s' returns inadequate output", f); -end - -xbest = x = x(:); -vold = vbest = nan ; # Values of f -hbest = nan ; # Inv. Hessian - -if verbose - printf ( "d2_min : Initially, v=%8.3g\n",v); -end - -while niter++ <= maxout && nev(1) < maxev - - [v,d,h] = leval (d2f, splice (args, narg, 1, list (reshape (x,sz)))); - nev(2)++; - - if prudent && niter <= 1 && \ - (! isnumeric (v) || isnan (v) || any (size (v)>1) || \ - ! isnumeric (d) || length (d(:)) != N || \ - ! isnumeric (h) || any (size (h) != N)) - error ("Function '%s' returns inadequate output", d2f); - end - - if ! id2f, h = pinv (h); end - d = d(:); - - if prudent - v2 = leval (f, splice (args, narg, 1, list (reshape (x,sz)))); - nev(1)++; - if abs(v2-v) > 0.001 * sqrt(eps) * max (abs(v2), 1) - printf ("d2_min : f and d2f disagree %8.3g\n",abs(v2-v)); - end - end - - xbest = x ; - if ! isnan (vbest) # Check that v ==vbest - if abs (vbest - v) > 1000*eps * max (vbest, 1) - printf ("d2_min : vbest changed at beginning of outer loop\n"); - end - end - vold = vbest = v ; - hbest = h ; - - if length (code), abest = args; end # Eventually stash all args - - if verbose || (report && rem(niter,max(report,1)) == 1) - printf ("d2_min : niter=%d, v=%8.3g\n",niter,v ); - end - - if norm (d) < dtol # Check for small derivative - if verbose || report - printf ("d2_min : Exiting because of low gradient\n"); - end - break; # Exit outer loop - end - - dnewton = -h*d ; # Newton step - # Heuristic for negative hessian - if dnewton'*d > 0, dnewton = -100*d; end - wn = 1 ; # Weight of Newton step - wt = 1 ; # Total weight - - ninner = done_inner = 0; # 0=not found. 1=Ready to quit inner. - - # ########################################## - while ninner++ < maxinner # Inner loop ############################### - - # Proposed step - dx = wt*(wn*dnewton - (1-wn)*d) ; - xnew = x+dx ; - - if verbose - printf (["Weight : total=%8.3g, newtons's=%8.3g vbest=%8.3g ",... - "Norm:Newton=%8.3g, deriv=%8.3g\n"],... - wt,wn,vbest,norm(wt*wn*dnewton),norm(wt*(1-wn)*d)); - end - if any(isnan(xnew)) - printf ("d2_min : Whoa!! any(isnan(xnew)) (1)\n"); - end - - vnew = leval (f, splice (args, narg, 1, list (reshape (xnew,sz)))); - nev(1)++ ; - - if vnew<vbest # Stash best values - dbest = dx ; - vbest = vnew; - xbest = xnew; - - done_inner = 1 ; # Will go out at next increase - if verbose - printf ( "d2_min : Found better value\n"); - end - - elseif done_inner == 1 # Time to go out - if verbose - printf ( "d2_min : Quitting %d th inner loop\n",niter); - end - break; # out of inner loop - end - wt = wt*tcoeff ; # Reduce norm of proposed step - wn = wn*ncoeff ; # And bring it closer to derivative - - end # End of inner loop ######################## - # ########################################## - - wbest = 0; # Best coeff for dbest - - if ninner >= maxinner # There was a problem - if verbose - printf ( "d2_min : Too many inner loops (vnew=%8.3g)\n",vnew); - end - - # ########################################## - else # Look for improvement along dbest - wn = ocoeff ; - xnew = x+wn*dbest; - if any(isnan(xnew)), - printf ("d2_min : Whoa!! any(isnan(xnew)) (2)\n"); - end - vnew = leval (f, splice (args, narg, 1, list (reshape (xnew,sz)))); - nev(1)++; - - while vnew < vbest, - vbest = vnew; # Stash best values - wbest = wn; - xbest = xnew; - wn = wn*ocoeff ; - xnew = x+wn*dbest; - vnew = leval (f, splice (args, narg, 1, list (reshape (xnew,sz)))); - if verbose - printf ( "Looking farther : v = %8.3g\n",vnew); - end - nev(1)++; - end - end # End of improving along dbest - # ########################################## - - if verbose || rem(niter,max(report,1)) == 1 - if vold, - if verbose - printf ("d2_min : Inner loop : vbest=%8.5g, vbest/vold=%8.5g\n",\ - vbest,vbest/vold); - end - else - if verbose - printf ( "d2_min : Inner loop : vbest=%8.5g, vold=0\n", vbest); - end - end - end - - if vbest < vold - ## "improvement found" - if prudent - tmpv = leval (f, splice (args, narg, 1, list (reshape (xbest,sz)))); - nev(1)++; - - if abs (tmpv-vbest) > eps - printf ("d2_min : Whoa! Value at xbest changed by %g\n",\ - abs(tmpv-vbest)); - end - end - v = vbest; x = xbest; - if ! isempty (code) - if verbose - printf ("d2_min : Going to eval (\"%s\")\n",code); - end - - xstash = xbest; - astash = abest; - args = abest; # Here : added 2001/11/07. Is that right? - x = xbest; - eval (code, "printf (\"code fails\\n\");"); - xbest = x; - abest = args; - # Check whether eval (code) changes value - if prudent - tmpv = leval (f, splice (args, narg, 1, list (reshape (x,sz)))); - nev(1)++; - if abs (tmpv-vbest) > max (min (100*eps,0.00001*abs(vbest)), eps) , - printf ("d2_min : Whoa! Value changes by %g after eval (code)\n",\ - abs (tmpv-vbest)); - end - end - end - end - - if ! isnan (ftol) && ftol > (vold-vbest)/max(vold,1), - if verbose || report - printf ("d2_min : Quitting, niter=%-3d v=%8.3g, ",niter,v); - if vold, printf ("v/vold=%8.3g \n",v/vold); - else printf ("vold =0 \n",v); - end - end - break ; # out of outer loop - end - if ! isnan (utol) && utol > max (abs (wbest*dbest)) / max(abs (xbest),1) - if verbose || report - printf ("d2_min : Quitting, niter=%-3d v=%8.3g, ",niter,v); - if vold, printf ("v/vold=%8.3g \n",v/vold); - else printf ("vold =0 \n",v); - end - end - break ; # out of outer loop - end -end # End of outer loop ################## - -xbest = reshape (xbest, sz); -if length (code) - args = abest; - args(narg) = xbest; -end - -if niter > maxout - if verbose - printf ( "d2_min : Outer loop lasts forever\n"); - end -end - - # One last check -if prudent - err = leval (f, splice (args, narg, 1, list (reshape (xbest,sz)))); - nev(1)++; - - if abs (err-vbest) > eps, - printf ("d2_min : Whoa!! xbest does not eval to vbest\n"); - printf (" : %8.3e - %8.3e = %8.3e != 0\n",err,vbest,err-vbest); - end -end
--- a/main/optim/deriv.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,85 +0,0 @@ -## Copyright (C) 2000 Ben Sapp. All rights reserved. -## -## This program 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. -## -## This 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. - -## deriv(f,x0[,h,O,N]) - -## Reference -> Numerical Methods for Mathematics, Science, and -## Engineering by John H. Mathews. - -function dx = deriv(f,x0,varargin) - - if(nargin < 2) - error("not enough arguments\n"); - endif - if(!ischar(f)) - error("The first argument must be a string\n"); - endif - if(!is_scalar(x0)) - error("The second argument must be a scalar.\n"); - endif - if(nargin >= 3) - va_arg_cnt = 1; - h = nth (varargin, va_arg_cnt++); - if(!is_scalar(h)) - error("h must be a scalar."); - endif - if(nargin >= 4) - O = nth (varargin, va_arg_cnt++); - if((O != 2) && (O != 4)) - error("Only order 2 or 4 is supported.\n"); - endif - if(nargin >= 5) - N = nth (varargin, va_arg_cnt++); - if((N > 4)||(N < 1)) - error("Only 1st,2nd,3rd or 4th order derivatives are acceptable.\n"); - endif - if(nargin >= 6) - warning("Ignoring arguements beyond the 5th.\n"); - endif - endif - endif - else - h = 0.0000001; - O = 2; - endif - - switch O - case (2) - switch N - case (1) - dx = (feval(f,x0+h)-feval(f,x0-h))/(2*h); - case (2) - dx = (feval(f,x0+h)-2*feval(f,x0)+feval(f,x0-h))/(h^2); - case (3) - dx = (feval(f,x0+2*h)-2*feval(f,x0+h)+2*feval(f,x0-h)-feval(f,x0-2*h))/(2*h^3); - case (4) - dx = (feval(f,x0+2*h)-4*feval(f,x0+h)+6*feval(f,x0)-4*feval(f,x0-h)+feval(f,x0-2*h))/(h^4); - otherwise - error("I can only take the 1st,2nd,3rd or 4th derivative\n"); - endswitch - case (4) - switch N - case (1) - dx = (-feval(f,x0+2*h)+8*feval(f,x0+h)-8*feval(f,x0-h)+feval(f,x0-2*h))/(12*h); - case (2) - dx = (-feval(f,x0+2*h)+16*feval(f,x0+h)-30*feval(f,x0)+16*feval(f,x0-h)-feval(f,x0-2*h))/(12*h^2); - case (3) - dx = (-feval(f,x0+3*h)+8*feval(f,x0+2*h)-13*feval(f,x0+h)+13*feval(f,x0-h)-8*feval(f,x0-2*h)+feval(f,x0-3*h))/(8*h^3); - case (4) - dx = (-feval(f,x0+3*h)+12*feval(f,x0+2*h)-39*feval(f,x0+h)+56*feval(f,x0)-39*feval(f,x0-h)+12*feval(f,x0-2*h)-feval(f,x0-3*h))/(6*h^4); - otherwise - error("I can only take the 1st,2nd,3rd or 4th derivative\n"); - endswitch - otherwise - error("Only order 4 or 2 supported\n"); - endswitch -endfunction
--- a/main/optim/dfdp.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,53 +0,0 @@ -% Copyright (C) 1992-1994 Richard Shrager -% Copyright (C) 1992-1994 Arthur Jutan -% Copyright (C) 1992-1994 Ray Muzic -% -% This program 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 of the License, or -% (at your option) any later version. -% -% This program 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 this program; if not, write to the Free Software -% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - -function prt=dfdp(x,f,p,dp,func) -% numerical partial derivatives (Jacobian) df/dp for use with leasqr -% --------INPUT VARIABLES--------- -% x=vec or matrix of indep var(used as arg to func) x=[x0 x1 ....] -% f=func(x,p) vector initialsed by user before each call to dfdp -% p= vec of current parameter values -% dp= fractional increment of p for numerical derivatives -% dp(j)>0 central differences calculated -% dp(j)<0 one sided differences calculated -% dp(j)=0 sets corresponding partials to zero; i.e. holds p(j) fixed -% func=string naming the function (.m) file -% e.g. to calc Jacobian for function expsum prt=dfdp(x,f,p,dp,'expsum') -%----------OUTPUT VARIABLES------- -% prt= Jacobian Matrix prt(i,j)=df(i)/dp(j) -%================================ - -m=size(x,1); if (m==1), m=size(x,2); end %# PAK: in case #cols > #rows -n=length(p); %dimensions -ps=p; prt=zeros(m,n);del=zeros(n,1); % initialise Jacobian to Zero -for j=1:n - del(j)=dp(j) .*p(j); %cal delx=fract(dp)*param value(p) - if p(j)==0 - del(j)=dp(j); %if param=0 delx=fraction - end - p(j)=ps(j) + del(j); - if del(j)~=0, f1=feval(func,x,p); - if dp(j) < 0, prt(:,j)=(f1-f)./del(j); - else - p(j)=ps(j)- del(j); - prt(:,j)=(f1-feval(func,x,p))./(2 .*del(j)); - end - end - p(j)=ps(j); %restore p(j) -end -return
--- a/main/optim/expdemo.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,16 +0,0 @@ -## An example of expfit in action - -## Author: Paul Kienzle -## This program is public domain -x0 = 1.5; step = 0.05; xend = 5; -a = [1.3, 2]' -c = [2, -0.5]' -v = 1e-4 - -x = x0:step:xend; -y = exp ( x(:) * a(:).' ) * c(:); -err = randn(size(y))*v; -plot(x,y+err); - -[a_out, c_out, rms] = expfit(2, x0, step, y+err) -
--- a/main/optim/expfit.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,128 +0,0 @@ -## USAGE [alpha,c,rms] = expfit( deg, x1, h, y ) -## -## Prony's method for non-linear exponential fitting -## -## Fit function: \sum_1^{deg} c(i)*exp(alpha(i)*x) -## -## Elements of data vector y must correspond to -## equidistant x-values starting at x1 with stepsize h -## -## The method is fully compatible with complex linear -## coefficients c, complex nonlinear coefficients alpha -## and complex input arguments y, x1, non-zero h . -## Fit-order deg must be a real positive integer. -## -## Returns linear coefficients c, nonlinear coefficients -## alpha and root mean square error rms. This method is -## known to be more stable than 'brute-force' non-linear -## least squares fitting. -## -## Example -## x0 = 0; step = 0.05; xend = 5; x = x0:step:xend; -## y = 2*exp(1.3*x)-0.5*exp(2*x); -## error = (rand(1,length(y))-0.5)*1e-4; -## [alpha,c,rms] = expfit(2,x0,step,y+error) -## -## alpha = -## 2.0000 -## 1.3000 -## c = -## -0.50000 -## 2.00000 -## rms = 0.00028461 -## -## The fit is very sensitive to the number of data points. -## It doesn't perform very well for small data sets. -## Theoretically, you need at least 2*deg data points, but -## if there are errors on the data, you certainly need more. -## -## Be aware that this is a very (very,very) ill-posed problem. -## By the way, this algorithm relies heavily on computing the -## roots of a polynomial. I used 'roots.m', if there is -## something better please use that code. -## -## Copyright (C) 2000 Gert Van den Eynde -## SCK-CEN (Nuclear Energy Research Centre) -## Boeretang 200 -## 2400 Mol -## Belgium -## na.gvandeneynde@na-net.ornl.gov -## -## This code is under the GNU Public License (GPL) version 2 or later. -## I hope that it is useful, but it is WITHOUT ANY WARRANTY, without -## even the implied warranty of MERCHANTABILITY or FITNESS FOR A -## PARTICULAR PURPOSE. -## __________________________________________________________________ -## Modified for full compatibility with complex fit-functions by -## Rolf Fabian <fabian@tu-cottbus.de> 2002-Sep-23 -## Brandenburg University of Technology Cottbus -## Dep. of Air Chemistry and Pollution Control -## -## Demo for a complex fit-function: -## deg= 2; N= 20; x1= -(1+i), x= linspace(x1,1+i/2,N).'; -## h = x(2) - x(1) -## y= (2+i)*exp( (-1-2i)*x ) + (-1+3i)*exp( (2+3i)*x ); -## A= 5e-2; y+= A*(randn(N,1)+randn(N,1)*i); % add complex noise -## [alpha,c,rms]= expfit( deg, x1, h, y ) -## __________________________________________________________________ - - -function [a,c,rms] = expfit(deg,x1,h,y) - -% Check input -if deg<1, error('expfit: deg must be >= 1'); end -if ~h, error('expfit: vanishing stepsize h'); end - -if ( N=length( y=y(:) ) ) < 2*deg - error('expfit: less than %d samples',2*deg); -end - -% Solve for polynomial coefficients -A = hankel( y(1:N-deg),y(N-deg:N) ); -s = - A(:,1:deg) \ A(:,deg+1); - -% Compose polynomial -p = flipud([s;1]); - -% Compute roots -u = roots(p); - -% nonlinear coefficients -a = log(u)/h; - -% Compose second matrix A(i,j) = u(j)^(i-1) -A = ( ones(N,1) * u(:).' ) .^ ( [0:N-1](:) * ones(1,deg) ); - -% Solve linear system -f = A\y; - -% linear coefficients -c = f./exp( a*x1 ); - -% Compute rms of y - approx -% where approx(i) = sum_k ( c(k) * exp(x(i)*a(k)) ) -if nargout > 2 - x = x1+h*[0:N-1]; - approx = exp( x(:) * a(:).' ) * c(:); - rms = sqrt( sumsq(approx - y) ); -end - -endfunction - -% Two demos for users of P. Kienzle's 'demo'-feature : - -%!demo % same as in help - part -%! deg= 2; N= 20; x1= -(1+i), x= linspace(x1,1+i/2,N).'; -%! h = x(2) - x(1) -%! y= (2+i)*exp( (-1-2i)*x ) + (-1+3i)*exp( (2+3i)*x ); -%! A= 5e-2; y+= A*(randn(N,1)+randn(N,1)*i); % add complex noise -%! [alpha,c,rms]= expfit( deg, x1, h, y ) - -%!demo % demo for stepsize with negative real part -%! deg= 2; N= 20; x1= +3*(1+i), x= linspace(x1,1+i/3,N).'; -%! h = x(2) - x(1) -%! y= (2+i)*exp( (-1-2i)*x ) + (-1+3i)*exp( (2+3i)*x ); -%! A= 5e-2; y+= A*(randn(N,1)+randn(N,1)*i); % add complex noise -%! [alpha,c,rms]= expfit( deg, x1, h, y ) - -
--- a/main/optim/fmin.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,21 +0,0 @@ -## Copyright (C) 2001 Paul Kienzle -## -## This program 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 of the License, or -## (at your option) any later version. -## -## This program 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 this program; if not, write to the Free Software -## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - -function ret=fmin(varargin) - - ret = fminbnd(varargin{:}); - -endfunction
--- a/main/optim/fminbnd.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,66 +0,0 @@ -## Copyright (C) 2000 Ben Sapp. All rights reserved. -## Modification by Andreas Helms -## This program 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. -## -## This 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. - -## -*- texinfo -*- -## @deftypefn {Function File} {[@var{x}] =} fminbnd(@var{f},@var{lb},@var{ub},@var{[options]},@var{P1},@var{P2}, ...) -## -## Find the minimum of a scalar function with the Golden Search method. -## -## @strong{Inputs} -## @table @var -## @item f -## A string contining the name of the function to minimiz -## @item lb -## Value to use as an initial lower bound on @var{x}. -## @item ub -## Value to use as an initial upper bound on @var{x}. -## @item options -## Vector with control parameters (For compatibily with MATLAB, not used -## here) -## @item P1,P2, ... -## Optional parameter for function @var{f} -## -## @end table -## @end deftypefn - -## 2001-09-24 Andreas Helms <helms@astro.physik.uni-potsdam.de> -## * modified for use with functions of more than one parameter - -function min = fminbnd(_func,lb,ub, options, varargin) - - delta = 1e-17; - gr = (sqrt(5)-1)/2; - width = (ub-lb); - out = [ lb:(width/3):ub ]; - out(2) = out(4)-gr*width; - out(3) = out(1)+gr*width; - upper = feval(_func,out(3), varargin{:}); - lower = feval(_func,out(2), varargin{:}); - while((out(3)-out(2)) > delta) #this will not work for symmetric funcs - if(upper > lower) - out(4) = out(3); - out(3) = out(2); - width = out(4)-out(1); - out(2) = out(4)-gr*width; - upper = lower; - lower = feval(_func,out(2), varargin{:}); - else - out(1) = out(2); - out(2) = out(3); - width = out(4)-out(1); - out(3) = out(1)+width*gr; - lower = upper; - upper = feval(_func,out(3), varargin{:}); - endif - endwhile - min = out(2); -endfunction
--- a/main/optim/fmins.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,79 +0,0 @@ -## Copyright (C) 2003 Andy Adler -## -## This program 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 of the License, or -## (at your option) any later version. -## -## This program 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 this program; if not, write to the Free Software -## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - -## -*- texinfo -*- -## @deftypefn {Function File} {[@var{x}] =} fmins(@var{f},@var{X0},@var{options},@var{grad},@var{P1},@var{P2}, ...) -## -## Find the minimum of a funtion of several variables. -## By default the method used is the Nelder&Mead Simplex algorithm -## -## Example usage: -## fmins(inline('(x(1)-5).^2+(x(2)-8).^4'),[0;0]) -## -## @strong{Inputs} -## @table @var -## @item f -## A string containing the name of the function to minimize -## @item X0 -## A vector of initial parameters fo the function @var{f}. -## @item options -## Vector with control parameters (not all parameters are used) -## @verbatim -## options(1) - Show progress (if 1, default is 0, no progress) -## options(2) - Relative size of simplex (default 1e-3) -## options(6) - Optimization algorithm -## if options(6)==0 - Nelder & Mead simplex (default) -## if options(6)==1 - Multidirectional search Method -## if options(6)==2 - Alternating Directions search -## options(5) -## if options(6)==0 && options(5)==0 - regular simplex -## if options(6)==0 && options(5)==1 - right-angled simplex -## Comment: the default is set to "right-angled simplex". -## this works better for me on a broad range of problems, -## although the default in nmsmax is "regular simplex" -## options(10) - Maximum number of function evaluations -## @end verbatim -## @item grad -## Unused (For compatibility with Matlab) -## @item P1,P2, ... -## Optional parameters for function @var{f} -## -## @end table -## @end deftypefn - -function ret=fmins(funfun, X0, options, grad, varargin) - stopit = [1e-3, inf, inf, 1, 0, -1]; - minfun = 'nmsmax'; - - if nargin < 3; options=[]; end - - if length(options)>=1; stopit(5)= options(1); end - if length(options)>=2; stopit(1)= options(2); end - if length(options)>=5; - if options(6)==0; minfun= 'nmsmax'; - if options(5)==0; stopit(4)= 0; - elseif options(5)==1; stopit(4)= 1; - else error('options(5): no associated simple strategy'); - end - elseif options(6)==1; minfun= 'mdsmax'; - elseif options(6)==2; minfun= 'adsmax'; - else error('options(6) does not correspond to known algorithm'); - end - end - if length(options)>=10; stopit(2)= options(10); end - - ret = feval(minfun, funfun, X0, stopit, [], varargin{:}); -endfunction
--- a/main/optim/fminunc.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,154 +0,0 @@ -## Copyright (C) 2002 Etienne Grossmann. All rights reserved. -## -## This program 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. -## -## This 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. - -## [x,v,flag,out,df,d2f] = fminunc (f,x,opt,...) - M*tlab-like optimization -## -## Imitation of m*tlab's fminunc(). The optional 'opt' argument is a struct, -## e.g. produced by 'optimset()'. -## -## Supported options -## ----------------- -## Diagnostics, [off|on] : Be verbose -## Display , [off|iter|notify|final] -## : Be verbose unless value is "off" -## GradObj , [off|on] : Function's 2nd return value is derivatives -## Hessian , [off|on] : Function's 2nd and 3rd return value are -## derivatives and Hessian. -## TolFun , scalar : Termination criterion (see 'ftol' in minimize()) -## TolX , scalar : Termination criterion (see 'utol' in minimize()) -## MaxFunEvals, int : Max. number of function evaluations -## MaxIter , int : Max. number of algorithm iterations -## -## These non-m*tlab are provided to facilitate porting code to octave: -## ----------------------- -## "MinEquiv" , [off|on] : Don't minimize 'fun', but instead return the -## option passed to minimize(). -## -## "Backend" , [off|on] : Don't minimize 'fun', but instead return -## [backend, opt], the name of the backend -## optimization function that is used and the -## optional arguments that will be passed to it. See -## the 'backend' option of minimize(). -## -## This function is a front-end to minimize(). -function [x,fval,flag,out,df,d2f] = fminunc (fun,x0,opt,varargin) - -if nargin < 3, opt = setfield (); end -if nargin > 3, - args = list (x0, varargin{:}); -else - args = list (x0); -end - -## Do some checks #################################################### -ws = es = ""; - -## Check for unknown options -## All known options -opn = [" DerivativeCheck Diagnostics DiffMaxChange DiffMinChange",\ - " Display GoalsExactAchieve GradConstr GradObj Hessian HessMult",\ - " HessPattern HessUpdate Jacobian JacobMult JacobPattern",\ - " LargeScale LevenbergMarquardt LineSearchType MaxFunEvals MaxIter",\ - " MaxPCGIter MeritFunction MinAbsMax PrecondBandWidth TolCon",\ - " TolFun TolPCG TolX TypicalX ",\ - " MinEquiv Backend "]; - -for [v,k] = opt - if ! findstr ([" ",k," "],opn) - es = [es,sprintf("Unknown option '%s'\n",k)]; - end -end - -## Check for ignored options -## All ignored options -iop = [" DerivativeCheck DiffMaxChange DiffMinChange",\ - " Display GoalsExactAchieve GradConstr HessMult",\ - " HessPattern HessUpdate JacobMult JacobPattern",\ - " LargeScale LevenbergMarquardt LineSearchType",\ - " MaxPCGIter MeritFunction MinAbsMax PrecondBandWidth TolCon",\ - " TolPCG TypicalX "]; -for [v,k] = opt - if ! findstr ([" ",k," "],iop) - ws = [ws,sprintf("Ignoring option '%s'\n",k)]; - end -end - -if length (ws) && ! length (es), warn (ws); -elseif length (es), error ([ws,es]); -end - -## Transform fminunc options into minimize() options - -opm = struct(); # minimize() options - -equiv = struct ("TolX" , "utol" , "TolFun" , "ftol",\ - "MaxFunEvals", "maxev" , "MaxIter" , "maxit",\ - "GradObj ", "jac" , "Hessian" , "hess",\ - "Display" , "verbose", "Diagnostics", "verbose",\ - "Backend" , "backend"); - -for [v,k] = equiv - if struct_contains (opt,k), opm = setfield (opm, getfield(equiv,k),v); end -end - - # Transform "off" into 0, other strings into - # 1. -for [v,k] = opm - if ischar (v) - if strcmp (v,"off") - opm = setfield (opm, k,0); - else - opm = setfield (opm, k,1); - end - end -end - -unary_opt = " hess jac backend verbose "; -opml = list (); -for [v,k] = opm - if findstr ([" ",k," "], unary_opt) - opml = append (opml, list (k)); - else - opml = append (opml, list (k, v)); - end -end - # Return only options to minimize() ## -if struct_contains (opt, "MinEquiv") - x = opml; - if nargout > 1 - warn ("Only 1 return value is defined with the 'MinEquiv' option"); - end - return - # Use the backend option ############# -elseif struct_contains (opm, "backend") - [x,fval] = minimize (fun, args, opml); - if nargout > 2 - warn ("Only 2 return values are defined with the 'Backend' option"); - end - return -else # Do the minimization ################ - [x,fval,out] = minimize (fun, args, opml); - - if struct_contains (opm, "maxev") - flag = out(1) < maxev; - else - flag = 1; - end - - if nargout > 4 - args = splice (args, 1, 1, list (x)); - [dummy,df,d2f] = leval (fun, args); - elseif nargout > 3 - args = splice (args, 1, 1, list (x)); - [dummy,df] = leval (fun, args); - end -end
--- a/main/optim/fzero.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,446 +0,0 @@ -## Copyright (C) 2004 £ukasz Bodzon <lllopezzz@o2.pl> -## -## This program 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 of the License, or -## (at your option) any later version. -## -## This program 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 this program; if not, write to the Free Software -## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -## -## REVISION HISTORY -## -## 2004-07-20, Piotr Krzyzanowski, <piotr.krzyzanowski@mimuw.edu.pl>: -## Options parameter and fall back to fsolve if only scalar APPROX argument -## supplied -## -## 2004-07-01, Lukasz Bodzon: -## Replaced f(a)*f(b) < 0 criterion by a more robust -## sign(f(a)) ~= sign(f(b)) -## -## 2004-06-18, Lukasz Bodzon: -## Original implementation of Brent's method of finding a zero of a scalar -## function - -## -*- texinfo -*- -## @deftypefn {Function File} {} [X, FX, INFO] = fzero (FCN, APPROX, OPTIONS) -## -## Given FCN, the name of a function of the form `F (X)', and an initial -## approximation APPROX, `fzero' solves the scalar nonlinear equation such that -## `F(X) == 0'. Depending on APPROX, `fzero' uses different algorithms to solve -## the problem: either the Brent's method or the Powell's method of `fsolve'. -## -## @deftypefnx {Function File} {} [X, FX, INFO] = fzero (FCN, APPROX, OPTIONS,P1,P2,...) -## -## Call FCN with FCN(X,P1,P2,...). -## -## @table @asis -## @item INPUT ARGUMENTS -## @end table -## -## @table @asis -## @item APPROX can be a vector with two components, -## @example -## A = APPROX(1) and B = APPROX(2), -## @end example -## which localizes the zero of F, that is, it is assumed that X lies between A and -## B. If APPROX is a scalar, it is treated as an initial guess for X. -## -## If APPROX is a vector of length 2 and F takes different signs at A and B, -## F(A)*F(B) < 0, then the Brent's zero finding algorithm [1] is used with error -## tolerance criterion -## @example -## reltol*|X|+abstol (see OPTIONS). -## @end example -## This algorithm combines -## superlinear convergence (for sufficiently regular functions) with the -## robustness of bisection. -## -## Whether F has identical signs at A and B, or APPROX is a single scalar value, -## then `fzero' falls back to another method and `fsolve(FCN, X0)' is called, with -## the starting value X0 equal to (A+B)/2 or APPROX, respectively. Only absolute -## residual tolerance, abstol, is used then, due to the limitations of the `fsolve_options' -## function. See OPTIONS and `help fsolve' for details. -## -## @item OPTIONS is a structure, with the following fields: -## -## @table @asis -## @item 'abstol' - absolute (error for Brent's or residual for fsolve) -## tolerance. Default = 1e-6. -## -## @item 'reltol' - relative error tolerance (only Brent's method). Default = 1e-6. -## -## @item 'prl' - print level, how much diagnostics to print. Default = 0, no -## diagnostics output. -## @end table -## -## If OPTIONS argument is omitted, or a specific field is not present in the -## OPTIONS structure, default values will be used. -## @end table -## -## @table @asis -## @item OUTPUT ARGUMENTS -## @end table -## -## @table @asis -## @item The computed approximation to the zero of FCN is returned in X. FX is then equal -## to FCN(X). If the iteration converged, INFO == 1. If Brent's method is used, -## and the function seems discontinuous, INFO is set to -5. If fsolve is used, -## INFO is determined by its convergence. -## @end table -## -## @table @asis -## @item EXAMPLES -## @end table -## -## @example -## fzero('sin',[-2 1]) will use Brent's method to find the solution to -## sin(x) = 0 in the interval [-2, 1] -## @end example -## -## @example -## [x, fx, info] = fzero('sin',-2) will use fsolve to find a solution to -## sin(x)=0 near -2. -## @end example -## -## @example -## options.abstol = 1e-2; fzero('sin',-2, options) will use fsolve to -## find a solution to sin(x)=0 near -2 with the absolute tolerance 1e-2. -## @end example -## -## @table @asis -## @item REFERENCES -## [1] Brent, R. P. "Algorithms for minimization without derivatives" (1971). -## @end table -## @end deftypefn -## @seealso{fsolve} - -function [Z, FZ, INFO] =fzero(Func,bracket,options,varargin) - - if (nargin < 2) - usage("[x, fx, info] = fzero(@fcn, [lo,hi]|start, options)"); - endif - - if !ischar(Func) && !isa(Func,"function handle") && !isa(Func,"inline function") - error("fzero expects a function as the first argument"); - endif - bracket = bracket(:); - if all(length(bracket)!=[1,2]) - error("fzero expects an initial value or a range"); - endif - - - set_default_options = false; - if (nargin >= 2) % check for the options - if (nargin == 2) - set_default_options = true; - options = []; - else % nargin > 2 - if ~isstruct(options) - if ~isempty(options) % empty indicates default chosen - warning('Options incorrect. Setting default values.'); - end - warning('Options incorrect. Setting default values.'); - set_default_options = true; - end - end - end - - if ~isfield(options,'abstol') - options.abstol = 1e-6; - end - if ~isfield(options,'reltol') - options.reltol = 1e-6; - end - % if ~isfield(options,'maxit') - % options.maxit = 100; - % end - if ~isfield(options,'prl') - options.prl = 0; % no diagnostics output - end - - fcount = 0; % counts function evaluations - if (length(bracket) > 1) - a = bracket(1); b = bracket(2); - use_brent = true; - else - b = bracket; - use_brent = false; - end - - - if (use_brent) - - fa=feval(Func,a,varargin{:}); fcount=fcount+1; - fb=feval(Func,b,varargin{:}); fcount=fcount+1; - - BOO=true; - tol=options.reltol*abs(b)+options.abstol; - - % check if one of the endpoints is the solution - if (fa == 0.0) - BOO = false; - c = b = a; - fc = fb = fa; - end - if (fb == 0.0) - BOO = false; - c = a = b; - fc = fa = fb; - end - - if ((sign(fa) == sign(fb)) & BOO) - warning ("fzero: equal signs at both ends of the interval.\n\ - Using fsolve('%s',%g) instead", Func, 0.5*(a+b)); - use_brent = false; - b = 0.5*(a+b); - endif - end - - - - if (use_brent) % it is reasonable to call Brent's method - if options.prl > 0 - fprintf(stderr,"============================\n"); - fprintf(stderr,"fzero: using Brent's method\n"); - fprintf(stderr,"============================\n"); - end - c=a; - fc=fa; - d=b-a; - e=d; - - while (BOO == true) % convergence check - - if (sign(fb) == sign(fc)) % rename a, b, c and adjust bounding interval - c=a; - fc=fa; - d=b-a; - e=d; - endif, - - ## We are preventing overflow and division by zero - ## while computing the new approximation by - ## linear interpolation. - ## After this step, we lose the chance for using - ## inverse quadratic interpolation (a==c). - - if (abs(fc) < abs(fb)) - a=b; - b=c; - c=a; - fa=fb; - fb=fc; - fc=fa; - endif, - - tol=options.reltol*abs(b)+options.abstol; - m=0.5*(c-b); - if options.prl > 0 - fprintf(stderr,'fzero: [%d feval] X = %8.4e\n', fcount, b); - if options.prl > 1 - fprintf(stderr,'fzero: m = %8.4e e = %8.4e [tol = %8.4e]\n', m, e, tol); - end - end - - if (abs(m) > tol & fb != 0) - - ## The second condition in following if-instruction - ## prevents overflow and division by zero - ## while computing the new approximation by - ## inverse quadratic interpolation. - - if (abs(e) < tol | abs(fa) <= abs(fb)) - d=m; % bisection - e=m; - - else - s=fb/fa; - - if (a == c) % attempt linear interpolation - p=2*m*s; % (the secant method) - q=1-s; - - else % attempt inverse quadratic interpolation - q=fa/fc; - r=fb/fc; - p=s*(2*m*q*(q-r)-(b-a)*(r-1)); - q=(q-1)*(r-1)*(s-1); - endif, - - if (p > 0) % fit signs - q=-q; % to the sign of (c-b) - - else - p=-p; - endif, - - s=e; - e=d; - - if (2*p < 3*m*q-abs(tol*q) & p < abs(0.5*s*q)) - d=p/q; % accept interpolation - - else % interpolation failed; - d=m; % take the bisection step - e=m; - endif, - - endif, - - a=b; - fa=fb; - - if (abs(d) > tol) % the step we take is never shorter - b=b+d; % than tol - - else - - if (m > 0) % fit signs - b=b+tol; % to the sign of (c-b) - - else - b=b-tol; - endif, - - endif, - - fb=feval(Func,b,varargin{:}); fcount=fcount+1; - - else - BOO=false; - endif, - - endwhile, - Z=b; - FZ = fb; - if abs(FZ) > 100*tol % large value of the residual may indicate a discontinuity point - INFO = -5; - else - INFO = 1; - end - % - % TODO: test if Z may be a singular point of F (ie F is discontinuous at Z - % Then return INFO = -5 - % - if (options.prl > 0 ) - fprintf(stderr,"\nfzero: summary\n"); - switch(INFO) - case 1 - MSG = "Solution converged within specified tolerance"; - case -5 - MSG = strcat("Probably a discontinuity/singularity point of F()\n encountered close to X = ", sprintf('%8.4e',Z),... - ".\n Value of the residual at X, |F(X)| = ",... - sprintf('%8.4e',abs(FZ)), ... - ".\n Another possibility is that you use too large tolerance parameters",... - ".\n Currently TOL = ", sprintf('%8.4e', tol), ... - ".\n Try fzero with smaller tolerance values"); - otherwise - MSG = "Something strange happened" - endswitch - fprintf(stderr,' %s.\n', MSG); - fprintf(stderr,' %d function evaluations.\n', fcount); - end - - else % fall back to fsolve - if options.prl > 0 - fprintf(stderr,"============================\n"); - fprintf(stderr,"fzero: using fsolve\n"); - fprintf(stderr,"============================\n"); - end - % check for zeros in APPROX - fb=feval(Func,b,varargin{:}); - fcount=fcount+1; - tol_save = fsolve_options('tolerance'); - fsolve_options("tolerance",options.abstol); - [Z, INFO, MSG] = fsolve(Func, b); - fsolve_options('tolerance',tol_save); - FZ = feval(Func,Z,varargin{:}); - if options.prl > 0 - fprintf(stderr,"\nfzero: summary\n"); - fprintf(stderr,' %s.\n', MSG); - end - end -endfunction; - -%!## usage and error testing -%!## the Brent's method -%!test -%! options.abstol=0; -%! assert (fzero('sin',[-1,2],options), 0) -%!test -%! options.abstol=0.01; -%! options.reltol=1e-3; -%! assert (fzero('tan',[-0.5,1.41],options), 0, 0.01) -%!test -%! options.abstol=1e-3; -%! assert (fzero('atan',[-(10^300),10^290],options), 0, 1e-3) -%!test -%! testfun=inline('(x-1)^3','x'); -%! options.abstol=0; -%! options.reltol=eps; -%! assert (fzero(testfun,[0,3],options), 1, -eps) -%!test -%! testfun=inline('(x-1)^3+y+z','x','y','z'); -%! options.abstol=0; -%! options.reltol=eps; -%! assert (fzero(testfun,[-3,0],options,22,5), -2, eps) -%!test -%! testfun=inline('x.^2-100','x'); -%! options.abstol=1e-4; -%! assert (fzero(testfun,[-9,300],options),10,1e-4) -%!## `fsolve' -%!test -%! options.abstol=0.01; -%! assert (fzero('tan',-0.5,options), 0, 0.01) -%!test -%! options.abstol=0; -%! assert (fzero('sin',[0.5,1],options), 0) -%! -%!demo -%! bracket=[-1,1.2]; -%! [X,FX,MSG]=fzero('tan',bracket) -%!demo -%! bracket=1; # `fsolve' will be used -%! [X,FX,MSG]=fzero('sin',bracket) -%!demo -%! bracket=[-1,2]; -%! options.abstol=0; options.prl=1; -%! X=fzero('sin',bracket,options) -%!demo -%! bracket=[0.5,1]; -%! options.abstol=0; options.reltol=eps; options.prl=1; -%! fzero('sin',bracket,options) -%!demo -%! demofun=inline('2*x.*exp(-4)+1 - 2*exp(-4*x)','x'); -%! bracket=[0, 1]; -%! options.abstol=1e-14; options.reltol=eps; options.prl=2; -%! [X,FX]=fzero(demofun,bracket,options) -%!demo -%! demofun=inline('x^51','x'); -%! bracket=[-12,10]; -%! # too large tolerance parameters -%! options.abstol=1; options.reltol=1; options.prl=1; -%! [X,FX]=fzero(demofun,bracket,options) -%!demo -%! # points of discontinuity inside the bracket -%! demofun=inline('0.5*(sign(x-1e-7)+sign(x+1e-7))','x'); -%! bracket=[-5,7]; -%! options.prl=1; -%! [X,FX]=fzero(demofun,bracket,options) -%!demo -%! demofun=inline('2*x*exp(-x^2)','x'); -%! bracket=1; -%! options.abstol=1e-14; options.prl=2; -%! [X,FX]=fzero(demofun,bracket,options) -%!demo -%! demofun=inline('2*x.*exp(-x.^2)','x'); -%! bracket=[-10,1]; -%! options.abstol=1e-14; options.prl=2; -%! [X,FX]=fzero(demofun,bracket,options)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/adsmax.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,158 @@ +function [x, fmax, nf] = adsmax(f, x, stopit, savit, P, varargin) +%ADSMAX Alternating directions method for direct search optimization. +% [x, fmax, nf] = ADSMAX(FUN, x0, STOPIT, SAVIT, P) attempts to +% maximize the function FUN, using the starting vector x0. +% The alternating directions direct search method is used. +% Output arguments: +% x = vector yielding largest function value found, +% fmax = function value at x, +% nf = number of function evaluations. +% The iteration is terminated when either +% - the relative increase in function value between successive +% iterations is <= STOPIT(1) (default 1e-3), +% - STOPIT(2) function evaluations have been performed +% (default inf, i.e., no limit), or +% - a function value equals or exceeds STOPIT(3) +% (default inf, i.e., no test on function values). +% Progress of the iteration is not shown if STOPIT(5) = 0 (default 1). +% If a non-empty fourth parameter string SAVIT is present, then +% `SAVE SAVIT x fmax nf' is executed after each inner iteration. +% By default, the search directions are the co-ordinate directions. +% The columns of a fifth parameter matrix P specify alternative search +% directions (P = EYE is the default). +% NB: x0 can be a matrix. In the output argument, in SAVIT saves, +% and in function calls, x has the same shape as x0. +% ADSMAX(fun, x0, STOPIT, SAVIT, P, P1, P2,...) allows additional +% arguments to be passed to fun, via feval(fun,x,P1,P2,...). + +% From Matrix Toolbox +% Copyright (C) 2002 N.J.Higham +% www.maths.man.ac.uk/~higham/mctoolbox +% distributed under the terms of the GNU General Public License +% +% Modifications for octave by A.Adler 2003 +% $Id$ + +% Reference: +% N. J. Higham, Optimization by direct search in matrix computations, +% SIAM J. Matrix Anal. Appl, 14(2): 317-333, 1993. +% N. J. Higham, Accuracy and Stability of Numerical Algorithms, +% Second edition, Society for Industrial and Applied Mathematics, +% Philadelphia, PA, 2002; sec. 20.5. + +x0 = x(:); % Work with column vector internally. +n = length(x0); + +mu = 1e-4; % Initial percentage change in components. +nstep = 25; % Max number of times to double or decrease h. + +% Set up convergence parameters. +if nargin < 3 + stopit(1) = 1e-3; +elseif isempty(stopit) + stopit(1) = 1e-3; +endif +tol = stopit(1); % Required rel. increase in function value over one iteration. +if length(stopit) == 1, stopit(2) = inf; end % Max no. of f-evaluations. +if length(stopit) == 2, stopit(3) = inf; end % Default target for f-values. +if length(stopit) < 5, stopit(5) = 1; end % Default: show progress. +trace = stopit(5); +if length(stopit) == 5, stopit(6) = 1; end % Default: maximize +dirn= stopit(6); +if nargin < 4, savit = []; end % File name for snapshots. + +% Matrix of search directions. +if nargin < 5 + P = eye(n); +elseif isempty(P) + P = eye(n); +else + if ~isequal(size(P),[n n]) % Check for common error. + error('P must be of dimension the number of elements in x0.') + end +end + +fmax = dirn*feval(f,x,varargin{:}); nf = 1; +if trace, fprintf('f(x0) = %9.4e\n', fmax), end + +steps = zeros(n,1); +it = 0; y = x0; + +while 1 % Outer loop. +it = it+1; +if trace, fprintf('Iter %2.0f (nf = %2.0f)\n', it, nf), end +fmax_old = fmax; + +for i=1:n % Loop over search directions. + + pi = P(:,i); + flast = fmax; + yi = y; + h = sign(pi'*yi)*norm(pi.*yi)*mu; % Initial step size. + if h == 0, h = max(norm(yi,inf),1)*mu; end + y = yi + h*pi; + x(:) = y; fnew = dirn*feval(f,x,varargin{:}); nf = nf + 1; + if fnew > fmax + fmax = fnew; + if fmax >= stopit(3) + if trace + fprintf('Comp. = %2.0f, steps = %2.0f, f = %9.4e*\n', i,0,fmax) + fprintf('Exceeded target...quitting\n') + end + x(:) = y; return + end + h = 2*h; lim = nstep; k = 1; + else + h = -h; lim = nstep+1; k = 0; + end + + for j=1:lim + y = yi + h*pi; + x(:) = y; fnew = dirn*feval(f,x,varargin{:}); nf = nf + 1; + if fnew <= fmax, break, end + fmax = fnew; k = k + 1; + if fmax >= stopit(3) + if trace + fprintf('Comp. = %2.0f, steps = %2.0f, f = %9.4e*\n', i,j,fmax) + fprintf('Exceeded target...quitting\n') + end + x(:) = y; return + end + h = 2*h; + end + + steps(i) = k; + y = yi + 0.5*h*pi; + if k == 0, y = yi; end + + if trace + fprintf('Comp. = %2.0f, steps = %2.0f, f = %9.4e', i, k, fmax) + fprintf(' (%2.1f%%)\n', 100*(fmax-flast)/(abs(flast)+eps)) + end + + + if nf >= stopit(2) + if trace + fprintf('Max no. of function evaluations exceeded...quitting\n') + end + x(:) = y; return + end + + if fmax > flast & ~isempty(savit) + x(:) = y; + eval(['save ' savit ' x fmax nf']) + end + +end % Loop over search directions. + +if isequal(steps,zeros(n,1)) + if trace, fprintf('Stagnated...quitting\n'), end + x(:) = y; return +end + +if fmax-fmax_old <= tol*abs(fmax_old) + if trace, fprintf('Function values ''converged''...quitting\n'), end + x(:) = y; return +end + +end %%%%%% Of outer loop.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/battery.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,51 @@ +# Copyright (C) 2004 Michael Creel <michael.creel@uab.es> +# +# This program 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 of the License, or +# (at your option) any later version. +# +# This program 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 this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +# (c) Michael Creel <michael.creel@uab.es> + +# battery.m: repeatedly call bfgs using a battery of +# start values, to attempt to find global min +# of a nonconvex function + +# INPUTS: +# func: function to mimimize +# args: args of function +# minarg: argument to minimize w.r.t. (usually = 1) +# startvals: kxp matrix of values to try for sure (don't include all zeros, that's automatic) +# max iters per start value +# number of additional random start values to try + +# OUTPUT: theta - the best value found - NOT iterated to convergence + +function theta = battery(func, args, minarg, startvals, maxiters) + +# setup +[k,trials] = size(startvals); +bestobj = inf; +besttheta = zeros(k,1); +bfgscontrol = {maxiters,0,0,1}; +# now try the supplied start values, and optionally the random start values +for i = 1:trials + args{minarg} = startvals(:,i); + [theta, obj_value, convergence] = bfgsmin (func, args, bfgscontrol); + + if obj_value < bestobj + besttheta = theta; + bestobj = obj_value; + endif +endfor + +theta = besttheta; +endfunction
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/bfgsmin.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,131 @@ +## Copyright (C) 2006 Michael Creel <michael.creel@uab.es> +## +## This program 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 of the License, or +## (at your option) any later version. +## +## This program 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 this program; if not, write to the Free Software +## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +## bfgsmin: bfgs or limited memory bfgs minimization of function +## +## Usage: [x, obj_value, convergence, iters] = bfgsmin(f, args, control) +## +## The function must be of the form +## [value, return_2,..., return_m] = f(arg_1, arg_2,..., arg_n) +## By default, minimization is w.r.t. arg_1, but it can be done +## w.r.t. any argument that is a vector. Numeric derivatives are +## used unless analytic derivatives are supplied. See bfgsmin_example.m +## for methods. +## +## Arguments: +## * f: name of function to minimize (string) +## * args: a cell array that holds all arguments of the function +## The argument with respect to which minimization is done +## MUST be a vector +## * control: an optional cell array of 1-8 elements. If a cell +## array shorter than 8 elements is provided, the trailing elements +## are provided with default values. +## * elem 1: maximum iterations (positive integer, or -1 or Inf for unlimited (default)) +## * elem 2: verbosity +## 0 = no screen output (default) +## 1 = only final results +## 2 = summary every iteration +## 3 = detailed information +## * elem 3: convergence criterion +## 1 = strict (function, gradient and param change) (default) +## 2 = weak - only function convergence required +## * elem 4: arg in f_args with respect to which minimization is done (default is first) +## * elem 5: (optional) Memory limit for lbfgs. If it's a positive integer +## then lbfgs will be use. Otherwise ordinary bfgs is used +## * elem 6: function change tolerance, default 1e-12 +## * elem 7: parameter change tolerance, default 1e-6 +## * elem 8: gradient tolerance, default 1e-5 +## +## Returns: +## * x: the minimizer +## * obj_value: the value of f() at x +## * convergence: 1 if normal conv, other values if not +## * iters: number of iterations performed +## +## Example: see bfgsmin_example.m + +function [parameter, obj, convergence, iters] = bfgsmin(f, f_args, control) + + # check number and types of arguments + if ((nargin < 2) || (nargin > 3)) + usage("bfgsmin: you must supply 2 or 3 arguments"); + endif + if (!isstr(f)) usage("bfgsmin: first argument must be string holding objective function name"); endif + if (!iscell(f_args)) usage("bfgsmin: second argument must cell array of function arguments"); endif + if (nargin > 2) + if (!iscell(control)) + usage("bfgsmin: 3rd argument must be a cell array of 1-8 elements"); + endif + if (length(control) > 8) + usage("bfgsmin: 3rd argument must be a cell array of 1-8 elements"); + endif + else control = {}; + endif + + # provide defaults for missing controls + if (length(control) == 0) control{1} = -1; endif # limit on iterations + if (length(control) == 1) control{2} = 0; endif # level of verbosity + if (length(control) == 2) control{3} = 1; endif # strong (function, gradient and parameter change) convergence required? + if (length(control) == 3) control{4} = 1; endif # argument with respect to which minimization is done + if (length(control) == 4) control{5} = 0; endif # memory for lbfgs: 0 uses ordinary bfgs + if (length(control) == 5) control{6} = 1e-12; endif # tolerance for function convergence + if (length(control) == 6) control{7} = 1e-6; endif # tolerance for parameter convergence + if (length(control) == 7) control{8} = 1e-5; endif # tolerance for gradient convergence + + # validity checks on all controls + tmp = control{1}; + if (((tmp !=Inf) || (tmp != -1)) & (tmp > 0 & (mod(tmp,1) != 0))) + usage("bfgsmin: 1st element of 3rd argument (iteration limit) must be Inf or positive integer"); + endif + tmp = control{2}; + if ((tmp < 0) || (tmp > 3) || (mod(tmp,1) != 0)) + usage("bfgsmin: 2nd element of 3rd argument (verbosity level) must be 0, 1, 2, or 3"); + endif + tmp = control{3}; + if ((tmp != 0) & (tmp != 1)) + usage("bfgsmin: 3rd element of 3rd argument (strong/weak convergence) must be 0 (weak) or 1 (strong)"); + endif + tmp = control{4}; + if ((tmp < 1) || (tmp > length(f_args)) || (mod(tmp,1) != 0)) + usage("bfgsmin: 4th element of 3rd argument (arg with respect to which minimization is done) must be an integer that indicates one of the elements of f_args"); + endif + tmp = control{5}; + if ((tmp < 0) || (mod(tmp,1) != 0)) + usage("bfgsmin: 5th element of 3rd argument (memory for lbfgs must be zero (regular bfgs) or a positive integer"); + endif + tmp = control{6}; + if (tmp < 0) + usage("bfgsmin: 6th element of 3rd argument (tolerance for function convergence) must be a positive real number"); + endif + tmp = control{7}; + if (tmp < 0) + usage("bfgsmin: 7th element of 3rd argument (tolerance for parameter convergence) must be a positive real number"); + endif + tmp = control{8}; + if (tmp < 0) + usage("bfgsmin: 8th element of 3rd argument (tolerance for gradient convergence) must be a positive real number"); + endif + + # check that the parameter we minimize w.r.t. is a vector + minarg = control{4}; + theta = f_args{minarg}; + theta = theta(:); + if (!is_vector(theta)) usage("bfgsmin: minimization must be done with respect to a vector of parameters"); endif + f_args{minarg} = theta; + + # now go ahead and do the minimization + [parameter, obj, convergence, iters] = __bfgsmin(f, f_args, control); +endfunction
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/bfgsmin_example.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,163 @@ +# Copyright (C) 2004,2005,2006 Michael Creel <michael.creel@uab.es> +# +# This program 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 of the License, or +# (at your option) any later version. +# +# This program 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 this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +# usage: bfgsmin_example (to run) or edit bfgsmin_example (to examine) +## +# Shows how to call bfgsmin. There are two objective functions, the first +# supplies the analytic gradient, and the second does not. The true minimizer +# is at "location", a 50x1 vector (0.00, 0.02, 0.04 ..., 1.00). +# Note that limited memory bfgs is faster when the dimension is high. +# Also note that supplying analytic derivatives gives a speedup. +## +# Six examples are given: +# Example 1: regular bfgs, analytic gradient +# Example 2: same as Example 1, but verbose +# Example 3: limited memory bfgs, analytic gradient +# Example 4: regular bfgs, numeric gradient +# Example 5: limited memory bfgs, numeric gradient +# Example 6: regular bfgs, analytic gradient, minimize wrt second argument +1; +# example obj. fn.: supplies analytic gradient +function [obj_value, gradient] = objective(theta, location) + x = theta - location + ones(rows(theta),1); # move minimizer to "location" + [obj_value, gradient] = rosenbrock(x); +endfunction + +# example obj. fn.: no gradient +function obj_value = objective2(theta, location) + x = theta - location + ones(rows(theta),1); # move minimizer to "location" + obj_value = rosenbrock(x); +endfunction + + +# initial values +dim = 50; # dimension of Rosenbrock function +theta0 = zeros(dim+1,1); # starting values +location = (0:dim)/dim; # true values +location = location'; + +printf("EXAMPLE 1: Ordinary BFGS, using analytic gradient\n"); +t=cputime(); +control = {-1;1}; # maxiters, verbosity +[theta, obj_value, convergence] = bfgsmin("objective", {theta0, location}, control); +printf("EXAMPLE 1: Ordinary BFGS, using analytic gradient\n"); +t = cputime() - t; +conv = norm(theta-location, 'inf'); +test = conv < 1e-5; +if test + printf("Success!! :-)\n"); +else + printf("Failure?! :-(\n"); +endif +printf("Elapsed time = %f\n\n\n\n",t); +pause(5); + +printf("EXAMPLE 2: Same as Example 1, but verbose\n"); +t=cputime(); +control = {-1;3}; # maxiters, verbosity +[theta, obj_value, convergence] = bfgsmin("objective", {theta0, location}, control); +printf("EXAMPLE 2: Same as Example 1, but verbose\n"); +t = cputime() - t; +conv = norm(theta-location, 'inf'); +test = conv < 1e-5; +if test + printf("Success!! :-)\n"); +else + printf("Failure?! :-(\n"); +endif +printf("Elapsed time = %f\n\n\n\n",t); +pause(5); + + +printf("EXAMPLE 3: Limited memory BFGS, using analytic gradient\n"); +t=cputime(); +control = {-1;1;1;1;5}; # maxiters, verbosity, conv. requirement., arg_to_min, lbfgs memory +[theta, obj_value, convergence] = bfgsmin("objective", {theta0, location}, control); +printf("EXAMPLE 3: Limited memory BFGS, using analytic gradient\n"); +t = cputime() - t; +conv = norm(theta-location, 'inf'); +test = conv < 1e-5; +if test + printf("Success!! :-)\n"); +else + printf("Failure?! :-(\n"); +endif +printf("Elapsed time = %f\n\n\n\n",t); +pause(5); + +printf("EXAMPLE 4: Ordinary BFGS, using numeric gradient\n"); +t=cputime(); +control = {-1;1}; # maxiters, verbosity +[theta, obj_value, convergence] = bfgsmin("objective2", {theta0, location}, control); +printf("EXAMPLE 4: Ordinary BFGS, using numeric gradient\n"); +t = cputime() - t; +conv = norm(theta-location, 'inf'); +test = conv < 1e-5; +if test + printf("Success!! :-)\n"); +else + printf("Failure?! :-(\n"); +endif +printf("Elapsed time = %f\n\n\n\n",t); +pause(5); + +printf("EXAMPLE 5: Limited memory BFGS, using numeric gradient\n"); +t=cputime(); +control = {-1;1;1;1;5}; # maxiters, verbosity, conv. reg., arg_to_min, lbfgs memory +[theta, obj_value, convergence] = bfgsmin("objective2", {theta0, location}, control); +printf("EXAMPLE 5: Limited memory BFGS, using numeric gradient\n"); +t = cputime() - t; +conv = norm(theta-location, 'inf'); +test = conv < 1e-5; +if test + printf("Success!! :-)\n"); +else + printf("Failure?! :-(\n"); +endif +printf("Elapsed time = %f\n\n\n\n",t); +pause(5); + +printf("EXAMPLE 6: Funny case: minimize w.r.t. second argument, Ordinary BFGS, using numeric gradient\n"); +t=cputime(); +control = {-1;1;1;2}; # maxiters, verbosity, conv. reg., arg_to_min +[theta, obj_value, convergence] = bfgsmin("objective2", {location, theta0}, control); +printf("EXAMPLE 6: Funny case: minimize w.r.t. second argument, Ordinary BFGS, using numeric gradient\n"); +t = cputime() - t; +conv = norm(theta-location, 'inf'); +test = conv < 1e-5; +if test + printf("Success!! :-)\n"); +else + printf("Failure?! :-(\n"); +endif +printf("Elapsed time = %f\n\n\n\n",t); + +printf("EXAMPLE 7: Ordinary BFGS, using numeric gradient, using non-default tolerances\n"); +t=cputime(); +control = {-1;1;1;1;0;1e-6;1e-2;1e-2}; # maxiters, verbosity, conv. reg., arg_to_min, lbfgs memory, fun. tol., param. tol., gradient tol. +[theta, obj_value, convergence] = bfgsmin("objective2", {theta0, location}, control); +printf("EXAMPLE 7: Ordinary BFGS, using numeric gradient. Note that gradient is only roughly zero.\n"); +t = cputime() - t; +conv = norm(theta-location, 'inf'); +test = conv < 1e-2; +if test + printf("Success!! :-)\n"); +else + printf("Failure?! :-(\n"); +endif +printf("Elapsed time = %f\n\n\n\n",t); +pause(5); +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/bs_gradient.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,4 @@ +function [dx,nev] = bs_gradient (f, args, narg) + error("bs_gradient: bs_gradient has been replaced by numgradient"); +endfunction +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/cdiff.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,152 @@ +## Copyright (C) 2002 Etienne Grossmann. All rights reserved. +## +## This program 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. +## +## This 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. + +## c = cdiff (func,wrt,N,dfunc,stack,dx) - Code for num. differentiation +## = "function df = dfunc (var1,..,dvar,..,varN) .. endfunction +## +## Returns a string of octave code that defines a function 'dfunc' that +## returns the derivative of 'func' with respect to it's 'wrt'th +## argument. +## +## The derivatives are obtained by symmetric finite difference. +## +## dfunc()'s return value is in the same format as that of ndiff() +## +## func : string : name of the function to differentiate +## +## wrt : int : position, in argument list, of the differentiation +## variable. Default:1 +## +## N : int : total number of arguments taken by 'func'. +## If N=inf, dfunc will take variable argument list. +## Default:wrt +## +## dfunc : string : Name of the octave function that returns the +## derivatives. Default:['d',func] +## +## stack : string : Indicates whether 'func' accepts vertically +## (stack="rstack") or horizontally (stack="cstack") +## arguments. Any other string indicates that 'func' +## does not allow stacking. Default:'' +## +## dx : real : Step used in the symmetric difference scheme. +## Default:10*sqrt(eps) +## +## See also : ndiff, eval, todisk +## +function c = cdiff (func,wrt,nargs,dfunc,stack,dx) + +if nargin<2, + wrt = 1 ; +end +if nargin<3, + nargs = wrt ; +end +if nargin<4 || strcmp(dfunc,""), + dfunc = ["d",func] ; + if exist(dfunc)>=2, + printf(["cdiff : Warning : name of derivative not specified\n",\ + " and canonic name '%s' is already taken\n"],\ + dfunc); + ## keyboard + end +end +if nargin<5, stack = "" ; end +if nargin<6, dx = 10*sqrt(eps) ; end + +## verbose = 0 ; +## build argstr = "var1,..,dvar,...var_nargs" +if isfinite (nargs) + argstr = sprintf("var%i,",1:nargs); +else + argstr = [sprintf("var%i,",1:wrt),"...,"]; +end + +argstr = strrep(argstr,sprintf("var%i",wrt),"dvar") ; +argstr = argstr(1:length(argstr)-1) ; + +if strcmp("cstack",stack) , # Horizontal stacking ################ + + calstr = "reshape (kron(ones(1,2*ps), dvar(:))+[-dx*eye(ps),dx*eye(ps)], sz.*[1,2*ps])"; + calstr = strrep(argstr,"dvar",calstr) ; + calstr = sprintf("%s(%s)",func,calstr) ; + + calstr = sprintf(strcat(" res = %s;\n", + " pr = prod (size(res)) / (2*ps);\n", + " res = reshape (res,pr,2*ps);\n", + " df = (res(:,ps+1:2*ps)-res(:,1:ps)) / (2*dx);\n"), + calstr) ; + + +elseif strcmp("rstack",stack), # Vertical stacking ################## + + calstr = "kron(ones(2*ps,1),dvar)+dx*[-dv;dv]" ; + calstr = strrep(argstr,"dvar",calstr) ; + calstr = sprintf("%s(%s)",func,calstr) ; + + calstr = sprintf(strcat(" dv = kron (eye(sz(2)), eye(sz(1))(:));\n",\ + " res = %s;\n",\ + " sr = size(res)./[2*ps,1];\n",\ + " pr = prod (sr);\n",\ + " df = (res(sr(1)*ps+1:2*sr(1)*ps,:)-res(1:sr(1)*ps,:))/(2*dx);\n",\ + " scramble = reshape (1:pr,sr(2),sr(1))';\n",\ + " df = reshape (df',pr,ps)(scramble(:),:);\n"),\ + calstr) ; + ## sayif(verbose,"cdiff : calstr='%s'\n",calstr) ; +else # No stacking ######################## + calstr = sprintf("%s (%s)",func,argstr) ; + ## "func(var1,dvar%sdv(:,%d:%d),...,varN)," + ## calstr = strrep(calstr,"dvar","dvar%sdv(:,(i-1)*sz(2)+1:i*sz(2))")(:)'; + + calstr = strrep(calstr,"dvar","dvar%sdv")(:)'; + + ## func(..,dvar+dv(:,1:sz(2)),..) - func(..) + calstr = strcat(calstr,"-",calstr) ; ## strcat(calstr,"-",calstr) ; + calstr = sprintf(calstr,"+","-") ; + tmp = calstr ; + ## sayif(verbose,"cdiff : calstr='%s'\n",calstr) ; + calstr = sprintf(strcat(" dv = zeros (sz); dv(1) = dx;\n",\ + " df0 = %s;\n",\ + " sr = size (df0);\n",\ + " df = zeros(prod (sr),ps); df(:,1) = df0(:);\n",\ + " for i = 2:ps,\n",\ + " dv(i) = dx; dv(i-1) = 0;\n",\ + " df(:,i) = (%s)(:);\n",\ + " end;\n",\ + " df ./= 2*dx;\n" + ), + calstr, tmp) ; + + + ## sayif(verbose,"cdiff : calstr='%s'\n",calstr) ; + + ## "func(var1,reshape(dvar(1:NV,1),SZ1,SZ2),...,varN)," , + ## "func(var1,reshape(dvar(1:NV,2),SZ1,SZ2),...,varN)," , ... + ## "func(var1,reshape(dvar(1:NV,NP),SZ1,SZ2),...,varN)" + ## sayif(verbose,"cdiff : calstr='%s'\n",calstr) ; +end +argstr = strrep (argstr, "...", "varargin"); +calstr = strrep (calstr, "...", "varargin{:}"); + +c = sprintf(strcat("function df = %s (%s)\n",\ + " ## Numerical differentiation of '%s' wrt to it's %d'th argument\n",\ + " ## This function has been written by 'cdiff()'\n",\ + " dx = %e;\n",\ + " sz = size (dvar);\n",\ + " ps = prod (sz);\n",\ + "%s",\ + "endfunction\n"),\ + dfunc,argstr,\ + func,wrt,\ + dx,\ + calstr) ; +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/d2_min.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,392 @@ +## Copyright (C) 2002 Etienne Grossmann. All rights reserved. +## +## This program 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. +## +## This 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. +## +## Changelog: +## 2002 / 05 / 09 : Heuristic for negative hessian + +## [x,v,nev,h,args] = d2_min(f,d2f,args,ctl,code) - Newton-like minimization +## +## Minimize f(x) using 1st and 2nd derivatives. Any function w/ second +## derivatives can be minimized, as in Newton. f(x) decreases at each +## iteration, as in Levenberg-Marquardt. This function is inspired from the +## Levenberg-Marquardt algorithm found in the book "Numerical Recipes". +## +## ARGUMENTS : +## f : string : Cost function's name +## +## d2f : string : Name of function returning the cost (1x1), its +## differential (1xN) and its second differential or it's +## pseudo-inverse (NxN) (see ctl(5) below) : +## +## [v,dv,d2v] = d2f (x). +## +## args : list : f and d2f's arguments. By default, minimize the 1st +## or matrix : argument. +## +## ctl : vector : Control arguments (see below) +## or struct +## +## code : string : code will be evaluated after each outer loop that +## produced some (any) improvement. Variables visible from +## "code" include "x", the best parameter found, "v" the +## best value and "args", the list of all arguments. All can +## be modified. This option can be used to re-parameterize +## the argument space during optimization +## +## CONTROL VARIABLE ctl : (optional). May be a struct or a vector of length +## ---------------------- 5 or less where NaNs are ignored. Default values +## are written <value>. +## FIELD VECTOR +## NAME POS +## +## ftol, f N/A : Stop search when value doesn't improve, as tested by +## +## f > Deltaf/max(|f(x)|,1) +## +## where Deltaf is the decrease in f observed in the last +## iteration. <10*sqrt(eps)> +## +## utol, u N/A : Stop search when updates are small, as tested by +## +## u > max { dx(i)/max(|x(i)|,1) | i in 1..N } +## +## where dx is the change in the x that occured in the last +## iteration. <NaN> +## +## dtol, d N/A : Stop search when derivative is small, as tested by +## +## d > norm (dv) <eps> +## +## crit, c ctl(1) : Set one stopping criterion, 'ftol' (c=1), 'utol' (c=2) +## or 'dtol' (c=3) to the value of by the 'tol' option. <1> +## +## tol, t ctl(2) : Threshold in termination test chosen by 'crit' <10*eps> +## +## narg, n ctl(3) : Position of the minimized argument in args <1> +## maxev,m ctl(4) : Maximum number of function evaluations <inf> +## maxout,m : Maximum number of outer loops <inf> +## id2f, i ctl(5) : 0 if d2f returns the 2nd derivatives, 1 if <0> +## it returns its pseudo-inverse. +## +## verbose, v N/A : Be more or less verbose (quiet=0) <0> + +function [xbest,vbest,nev,hbest,args] = d2_min (f,d2f,args,ctl,code) + +## Author : Etienne Grossmann <etienne@cs.uky.edu> +## + +maxout = inf; +maxinner = 30 ; + +tcoeff = 0.5 ; # Discount on total weight +ncoeff = 0.5 ; # Discount on weight of newton +ocoeff = 1.5 ; # Factor for outwards searching + +report = 0 ; # Never report +verbose = 0 ; # Be quiet +prudent = 1 ; # Check coherence of d2f and f? + +niter = 0 ; + +crit = 0; # Default control variables +ftol = 10 * sqrt (eps); +dtol = eps; +utol = tol = nan; +narg = 1; +maxev = inf; +id2f = 0; + +if nargin >= 4 # Read arguments + if isnumeric (ctl) + if length (ctl)>=1 && !isnan (ctl(1)), crit = ctl(1); end + if length (ctl)>=2 && !isnan (ctl(2)), tol = ctl(2); end + if length (ctl)>=3 && !isnan (ctl(3)), narg = ctl(3); end + if length (ctl)>=4 && !isnan (ctl(4)), maxev = ctl(4); end + if length (ctl)>=5 && !isnan (ctl(5)), id2f = ctl(5); end + elseif isstruct (ctl) + if struct_contains (ctl, "crit") , crit = ctl.crit ; end + if struct_contains (ctl, "tol") , tol = ctl.tol ; end + if struct_contains (ctl, "narg") , narg = ctl.narg ; end + if struct_contains (ctl, "maxev") , maxev = ctl.maxev ; end + if struct_contains (ctl, "maxout") , maxout = ctl.maxout ; end + if struct_contains (ctl, "id2f") , id2f = ctl.id2f ; end + if struct_contains (ctl, "verbose"), verbose = ctl.verbose; end + if struct_contains (ctl, "code") , code = ctl.code ; end + else + error ("The 'ctl' argument should be either a vector or a struct"); + end +end + +if crit == 1, ftol = tol; +elseif crit == 2, utol = tol; +elseif crit == 3, dtol = tol; +elseif crit, error ("crit is %i. Should be 1,2 or 3.\n"); +end + + +if nargin < 5, code = "" ; end + +if is_list (args) # List of arguments + x = nth (args, narg); +else # Single argument + x = args; + args = list (args); +end + +############################## Checking ############################## +if narg > length (args) + error ("d2_min : narg==%i, length (args)==%i\n", + narg, length (args)); +end + +if tol <= 0 + printf ("d2_min : tol=%8.3g <= 0\n",tol) ; +end + +if !ischar (d2f) || !ischar (f) + printf ("d2_min : f and d2f should be strings!\n"); +end + +sz = size (x); N = prod (sz); + +v = leval (f, args); +nev = [1,0]; + +if prudent && (! isnumeric (v) || isnan (v) || any (size (v)>1)) + error ("Function '%s' returns inadequate output", f); +end + +xbest = x = x(:); +vold = vbest = nan ; # Values of f +hbest = nan ; # Inv. Hessian + +if verbose + printf ( "d2_min : Initially, v=%8.3g\n",v); +end + +while niter++ <= maxout && nev(1) < maxev + + [v,d,h] = leval (d2f, splice (args, narg, 1, list (reshape (x,sz)))); + nev(2)++; + + if prudent && niter <= 1 && \ + (! isnumeric (v) || isnan (v) || any (size (v)>1) || \ + ! isnumeric (d) || length (d(:)) != N || \ + ! isnumeric (h) || any (size (h) != N)) + error ("Function '%s' returns inadequate output", d2f); + end + + if ! id2f, h = pinv (h); end + d = d(:); + + if prudent + v2 = leval (f, splice (args, narg, 1, list (reshape (x,sz)))); + nev(1)++; + if abs(v2-v) > 0.001 * sqrt(eps) * max (abs(v2), 1) + printf ("d2_min : f and d2f disagree %8.3g\n",abs(v2-v)); + end + end + + xbest = x ; + if ! isnan (vbest) # Check that v ==vbest + if abs (vbest - v) > 1000*eps * max (vbest, 1) + printf ("d2_min : vbest changed at beginning of outer loop\n"); + end + end + vold = vbest = v ; + hbest = h ; + + if length (code), abest = args; end # Eventually stash all args + + if verbose || (report && rem(niter,max(report,1)) == 1) + printf ("d2_min : niter=%d, v=%8.3g\n",niter,v ); + end + + if norm (d) < dtol # Check for small derivative + if verbose || report + printf ("d2_min : Exiting because of low gradient\n"); + end + break; # Exit outer loop + end + + dnewton = -h*d ; # Newton step + # Heuristic for negative hessian + if dnewton'*d > 0, dnewton = -100*d; end + wn = 1 ; # Weight of Newton step + wt = 1 ; # Total weight + + ninner = done_inner = 0; # 0=not found. 1=Ready to quit inner. + + # ########################################## + while ninner++ < maxinner # Inner loop ############################### + + # Proposed step + dx = wt*(wn*dnewton - (1-wn)*d) ; + xnew = x+dx ; + + if verbose + printf (["Weight : total=%8.3g, newtons's=%8.3g vbest=%8.3g ",... + "Norm:Newton=%8.3g, deriv=%8.3g\n"],... + wt,wn,vbest,norm(wt*wn*dnewton),norm(wt*(1-wn)*d)); + end + if any(isnan(xnew)) + printf ("d2_min : Whoa!! any(isnan(xnew)) (1)\n"); + end + + vnew = leval (f, splice (args, narg, 1, list (reshape (xnew,sz)))); + nev(1)++ ; + + if vnew<vbest # Stash best values + dbest = dx ; + vbest = vnew; + xbest = xnew; + + done_inner = 1 ; # Will go out at next increase + if verbose + printf ( "d2_min : Found better value\n"); + end + + elseif done_inner == 1 # Time to go out + if verbose + printf ( "d2_min : Quitting %d th inner loop\n",niter); + end + break; # out of inner loop + end + wt = wt*tcoeff ; # Reduce norm of proposed step + wn = wn*ncoeff ; # And bring it closer to derivative + + end # End of inner loop ######################## + # ########################################## + + wbest = 0; # Best coeff for dbest + + if ninner >= maxinner # There was a problem + if verbose + printf ( "d2_min : Too many inner loops (vnew=%8.3g)\n",vnew); + end + + # ########################################## + else # Look for improvement along dbest + wn = ocoeff ; + xnew = x+wn*dbest; + if any(isnan(xnew)), + printf ("d2_min : Whoa!! any(isnan(xnew)) (2)\n"); + end + vnew = leval (f, splice (args, narg, 1, list (reshape (xnew,sz)))); + nev(1)++; + + while vnew < vbest, + vbest = vnew; # Stash best values + wbest = wn; + xbest = xnew; + wn = wn*ocoeff ; + xnew = x+wn*dbest; + vnew = leval (f, splice (args, narg, 1, list (reshape (xnew,sz)))); + if verbose + printf ( "Looking farther : v = %8.3g\n",vnew); + end + nev(1)++; + end + end # End of improving along dbest + # ########################################## + + if verbose || rem(niter,max(report,1)) == 1 + if vold, + if verbose + printf ("d2_min : Inner loop : vbest=%8.5g, vbest/vold=%8.5g\n",\ + vbest,vbest/vold); + end + else + if verbose + printf ( "d2_min : Inner loop : vbest=%8.5g, vold=0\n", vbest); + end + end + end + + if vbest < vold + ## "improvement found" + if prudent + tmpv = leval (f, splice (args, narg, 1, list (reshape (xbest,sz)))); + nev(1)++; + + if abs (tmpv-vbest) > eps + printf ("d2_min : Whoa! Value at xbest changed by %g\n",\ + abs(tmpv-vbest)); + end + end + v = vbest; x = xbest; + if ! isempty (code) + if verbose + printf ("d2_min : Going to eval (\"%s\")\n",code); + end + + xstash = xbest; + astash = abest; + args = abest; # Here : added 2001/11/07. Is that right? + x = xbest; + eval (code, "printf (\"code fails\\n\");"); + xbest = x; + abest = args; + # Check whether eval (code) changes value + if prudent + tmpv = leval (f, splice (args, narg, 1, list (reshape (x,sz)))); + nev(1)++; + if abs (tmpv-vbest) > max (min (100*eps,0.00001*abs(vbest)), eps) , + printf ("d2_min : Whoa! Value changes by %g after eval (code)\n",\ + abs (tmpv-vbest)); + end + end + end + end + + if ! isnan (ftol) && ftol > (vold-vbest)/max(vold,1), + if verbose || report + printf ("d2_min : Quitting, niter=%-3d v=%8.3g, ",niter,v); + if vold, printf ("v/vold=%8.3g \n",v/vold); + else printf ("vold =0 \n",v); + end + end + break ; # out of outer loop + end + if ! isnan (utol) && utol > max (abs (wbest*dbest)) / max(abs (xbest),1) + if verbose || report + printf ("d2_min : Quitting, niter=%-3d v=%8.3g, ",niter,v); + if vold, printf ("v/vold=%8.3g \n",v/vold); + else printf ("vold =0 \n",v); + end + end + break ; # out of outer loop + end +end # End of outer loop ################## + +xbest = reshape (xbest, sz); +if length (code) + args = abest; + args(narg) = xbest; +end + +if niter > maxout + if verbose + printf ( "d2_min : Outer loop lasts forever\n"); + end +end + + # One last check +if prudent + err = leval (f, splice (args, narg, 1, list (reshape (xbest,sz)))); + nev(1)++; + + if abs (err-vbest) > eps, + printf ("d2_min : Whoa!! xbest does not eval to vbest\n"); + printf (" : %8.3e - %8.3e = %8.3e != 0\n",err,vbest,err-vbest); + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/deriv.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,85 @@ +## Copyright (C) 2000 Ben Sapp. All rights reserved. +## +## This program 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. +## +## This 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. + +## deriv(f,x0[,h,O,N]) + +## Reference -> Numerical Methods for Mathematics, Science, and +## Engineering by John H. Mathews. + +function dx = deriv(f,x0,varargin) + + if(nargin < 2) + error("not enough arguments\n"); + endif + if(!ischar(f)) + error("The first argument must be a string\n"); + endif + if(!is_scalar(x0)) + error("The second argument must be a scalar.\n"); + endif + if(nargin >= 3) + va_arg_cnt = 1; + h = nth (varargin, va_arg_cnt++); + if(!is_scalar(h)) + error("h must be a scalar."); + endif + if(nargin >= 4) + O = nth (varargin, va_arg_cnt++); + if((O != 2) && (O != 4)) + error("Only order 2 or 4 is supported.\n"); + endif + if(nargin >= 5) + N = nth (varargin, va_arg_cnt++); + if((N > 4)||(N < 1)) + error("Only 1st,2nd,3rd or 4th order derivatives are acceptable.\n"); + endif + if(nargin >= 6) + warning("Ignoring arguements beyond the 5th.\n"); + endif + endif + endif + else + h = 0.0000001; + O = 2; + endif + + switch O + case (2) + switch N + case (1) + dx = (feval(f,x0+h)-feval(f,x0-h))/(2*h); + case (2) + dx = (feval(f,x0+h)-2*feval(f,x0)+feval(f,x0-h))/(h^2); + case (3) + dx = (feval(f,x0+2*h)-2*feval(f,x0+h)+2*feval(f,x0-h)-feval(f,x0-2*h))/(2*h^3); + case (4) + dx = (feval(f,x0+2*h)-4*feval(f,x0+h)+6*feval(f,x0)-4*feval(f,x0-h)+feval(f,x0-2*h))/(h^4); + otherwise + error("I can only take the 1st,2nd,3rd or 4th derivative\n"); + endswitch + case (4) + switch N + case (1) + dx = (-feval(f,x0+2*h)+8*feval(f,x0+h)-8*feval(f,x0-h)+feval(f,x0-2*h))/(12*h); + case (2) + dx = (-feval(f,x0+2*h)+16*feval(f,x0+h)-30*feval(f,x0)+16*feval(f,x0-h)-feval(f,x0-2*h))/(12*h^2); + case (3) + dx = (-feval(f,x0+3*h)+8*feval(f,x0+2*h)-13*feval(f,x0+h)+13*feval(f,x0-h)-8*feval(f,x0-2*h)+feval(f,x0-3*h))/(8*h^3); + case (4) + dx = (-feval(f,x0+3*h)+12*feval(f,x0+2*h)-39*feval(f,x0+h)+56*feval(f,x0)-39*feval(f,x0-h)+12*feval(f,x0-2*h)-feval(f,x0-3*h))/(6*h^4); + otherwise + error("I can only take the 1st,2nd,3rd or 4th derivative\n"); + endswitch + otherwise + error("Only order 4 or 2 supported\n"); + endswitch +endfunction
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/dfdp.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,53 @@ +% Copyright (C) 1992-1994 Richard Shrager +% Copyright (C) 1992-1994 Arthur Jutan +% Copyright (C) 1992-1994 Ray Muzic +% +% This program 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 of the License, or +% (at your option) any later version. +% +% This program 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 this program; if not, write to the Free Software +% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +function prt=dfdp(x,f,p,dp,func) +% numerical partial derivatives (Jacobian) df/dp for use with leasqr +% --------INPUT VARIABLES--------- +% x=vec or matrix of indep var(used as arg to func) x=[x0 x1 ....] +% f=func(x,p) vector initialsed by user before each call to dfdp +% p= vec of current parameter values +% dp= fractional increment of p for numerical derivatives +% dp(j)>0 central differences calculated +% dp(j)<0 one sided differences calculated +% dp(j)=0 sets corresponding partials to zero; i.e. holds p(j) fixed +% func=string naming the function (.m) file +% e.g. to calc Jacobian for function expsum prt=dfdp(x,f,p,dp,'expsum') +%----------OUTPUT VARIABLES------- +% prt= Jacobian Matrix prt(i,j)=df(i)/dp(j) +%================================ + +m=size(x,1); if (m==1), m=size(x,2); end %# PAK: in case #cols > #rows +n=length(p); %dimensions +ps=p; prt=zeros(m,n);del=zeros(n,1); % initialise Jacobian to Zero +for j=1:n + del(j)=dp(j) .*p(j); %cal delx=fract(dp)*param value(p) + if p(j)==0 + del(j)=dp(j); %if param=0 delx=fraction + end + p(j)=ps(j) + del(j); + if del(j)~=0, f1=feval(func,x,p); + if dp(j) < 0, prt(:,j)=(f1-f)./del(j); + else + p(j)=ps(j)- del(j); + prt(:,j)=(f1-feval(func,x,p))./(2 .*del(j)); + end + end + p(j)=ps(j); %restore p(j) +end +return
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/expdemo.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,16 @@ +## An example of expfit in action + +## Author: Paul Kienzle +## This program is public domain +x0 = 1.5; step = 0.05; xend = 5; +a = [1.3, 2]' +c = [2, -0.5]' +v = 1e-4 + +x = x0:step:xend; +y = exp ( x(:) * a(:).' ) * c(:); +err = randn(size(y))*v; +plot(x,y+err); + +[a_out, c_out, rms] = expfit(2, x0, step, y+err) +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/expfit.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,128 @@ +## USAGE [alpha,c,rms] = expfit( deg, x1, h, y ) +## +## Prony's method for non-linear exponential fitting +## +## Fit function: \sum_1^{deg} c(i)*exp(alpha(i)*x) +## +## Elements of data vector y must correspond to +## equidistant x-values starting at x1 with stepsize h +## +## The method is fully compatible with complex linear +## coefficients c, complex nonlinear coefficients alpha +## and complex input arguments y, x1, non-zero h . +## Fit-order deg must be a real positive integer. +## +## Returns linear coefficients c, nonlinear coefficients +## alpha and root mean square error rms. This method is +## known to be more stable than 'brute-force' non-linear +## least squares fitting. +## +## Example +## x0 = 0; step = 0.05; xend = 5; x = x0:step:xend; +## y = 2*exp(1.3*x)-0.5*exp(2*x); +## error = (rand(1,length(y))-0.5)*1e-4; +## [alpha,c,rms] = expfit(2,x0,step,y+error) +## +## alpha = +## 2.0000 +## 1.3000 +## c = +## -0.50000 +## 2.00000 +## rms = 0.00028461 +## +## The fit is very sensitive to the number of data points. +## It doesn't perform very well for small data sets. +## Theoretically, you need at least 2*deg data points, but +## if there are errors on the data, you certainly need more. +## +## Be aware that this is a very (very,very) ill-posed problem. +## By the way, this algorithm relies heavily on computing the +## roots of a polynomial. I used 'roots.m', if there is +## something better please use that code. +## +## Copyright (C) 2000 Gert Van den Eynde +## SCK-CEN (Nuclear Energy Research Centre) +## Boeretang 200 +## 2400 Mol +## Belgium +## na.gvandeneynde@na-net.ornl.gov +## +## This code is under the GNU Public License (GPL) version 2 or later. +## I hope that it is useful, but it is WITHOUT ANY WARRANTY, without +## even the implied warranty of MERCHANTABILITY or FITNESS FOR A +## PARTICULAR PURPOSE. +## __________________________________________________________________ +## Modified for full compatibility with complex fit-functions by +## Rolf Fabian <fabian@tu-cottbus.de> 2002-Sep-23 +## Brandenburg University of Technology Cottbus +## Dep. of Air Chemistry and Pollution Control +## +## Demo for a complex fit-function: +## deg= 2; N= 20; x1= -(1+i), x= linspace(x1,1+i/2,N).'; +## h = x(2) - x(1) +## y= (2+i)*exp( (-1-2i)*x ) + (-1+3i)*exp( (2+3i)*x ); +## A= 5e-2; y+= A*(randn(N,1)+randn(N,1)*i); % add complex noise +## [alpha,c,rms]= expfit( deg, x1, h, y ) +## __________________________________________________________________ + + +function [a,c,rms] = expfit(deg,x1,h,y) + +% Check input +if deg<1, error('expfit: deg must be >= 1'); end +if ~h, error('expfit: vanishing stepsize h'); end + +if ( N=length( y=y(:) ) ) < 2*deg + error('expfit: less than %d samples',2*deg); +end + +% Solve for polynomial coefficients +A = hankel( y(1:N-deg),y(N-deg:N) ); +s = - A(:,1:deg) \ A(:,deg+1); + +% Compose polynomial +p = flipud([s;1]); + +% Compute roots +u = roots(p); + +% nonlinear coefficients +a = log(u)/h; + +% Compose second matrix A(i,j) = u(j)^(i-1) +A = ( ones(N,1) * u(:).' ) .^ ( [0:N-1](:) * ones(1,deg) ); + +% Solve linear system +f = A\y; + +% linear coefficients +c = f./exp( a*x1 ); + +% Compute rms of y - approx +% where approx(i) = sum_k ( c(k) * exp(x(i)*a(k)) ) +if nargout > 2 + x = x1+h*[0:N-1]; + approx = exp( x(:) * a(:).' ) * c(:); + rms = sqrt( sumsq(approx - y) ); +end + +endfunction + +% Two demos for users of P. Kienzle's 'demo'-feature : + +%!demo % same as in help - part +%! deg= 2; N= 20; x1= -(1+i), x= linspace(x1,1+i/2,N).'; +%! h = x(2) - x(1) +%! y= (2+i)*exp( (-1-2i)*x ) + (-1+3i)*exp( (2+3i)*x ); +%! A= 5e-2; y+= A*(randn(N,1)+randn(N,1)*i); % add complex noise +%! [alpha,c,rms]= expfit( deg, x1, h, y ) + +%!demo % demo for stepsize with negative real part +%! deg= 2; N= 20; x1= +3*(1+i), x= linspace(x1,1+i/3,N).'; +%! h = x(2) - x(1) +%! y= (2+i)*exp( (-1-2i)*x ) + (-1+3i)*exp( (2+3i)*x ); +%! A= 5e-2; y+= A*(randn(N,1)+randn(N,1)*i); % add complex noise +%! [alpha,c,rms]= expfit( deg, x1, h, y ) + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/fmin.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,21 @@ +## Copyright (C) 2001 Paul Kienzle +## +## This program 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 of the License, or +## (at your option) any later version. +## +## This program 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 this program; if not, write to the Free Software +## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +function ret=fmin(varargin) + + ret = fminbnd(varargin{:}); + +endfunction
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/fminbnd.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,66 @@ +## Copyright (C) 2000 Ben Sapp. All rights reserved. +## Modification by Andreas Helms +## This program 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. +## +## This 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. + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{x}] =} fminbnd(@var{f},@var{lb},@var{ub},@var{[options]},@var{P1},@var{P2}, ...) +## +## Find the minimum of a scalar function with the Golden Search method. +## +## @strong{Inputs} +## @table @var +## @item f +## A string contining the name of the function to minimiz +## @item lb +## Value to use as an initial lower bound on @var{x}. +## @item ub +## Value to use as an initial upper bound on @var{x}. +## @item options +## Vector with control parameters (For compatibily with MATLAB, not used +## here) +## @item P1,P2, ... +## Optional parameter for function @var{f} +## +## @end table +## @end deftypefn + +## 2001-09-24 Andreas Helms <helms@astro.physik.uni-potsdam.de> +## * modified for use with functions of more than one parameter + +function min = fminbnd(_func,lb,ub, options, varargin) + + delta = 1e-17; + gr = (sqrt(5)-1)/2; + width = (ub-lb); + out = [ lb:(width/3):ub ]; + out(2) = out(4)-gr*width; + out(3) = out(1)+gr*width; + upper = feval(_func,out(3), varargin{:}); + lower = feval(_func,out(2), varargin{:}); + while((out(3)-out(2)) > delta) #this will not work for symmetric funcs + if(upper > lower) + out(4) = out(3); + out(3) = out(2); + width = out(4)-out(1); + out(2) = out(4)-gr*width; + upper = lower; + lower = feval(_func,out(2), varargin{:}); + else + out(1) = out(2); + out(2) = out(3); + width = out(4)-out(1); + out(3) = out(1)+width*gr; + lower = upper; + upper = feval(_func,out(3), varargin{:}); + endif + endwhile + min = out(2); +endfunction
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/fmins.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,79 @@ +## Copyright (C) 2003 Andy Adler +## +## This program 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 of the License, or +## (at your option) any later version. +## +## This program 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 this program; if not, write to the Free Software +## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{x}] =} fmins(@var{f},@var{X0},@var{options},@var{grad},@var{P1},@var{P2}, ...) +## +## Find the minimum of a funtion of several variables. +## By default the method used is the Nelder&Mead Simplex algorithm +## +## Example usage: +## fmins(inline('(x(1)-5).^2+(x(2)-8).^4'),[0;0]) +## +## @strong{Inputs} +## @table @var +## @item f +## A string containing the name of the function to minimize +## @item X0 +## A vector of initial parameters fo the function @var{f}. +## @item options +## Vector with control parameters (not all parameters are used) +## @verbatim +## options(1) - Show progress (if 1, default is 0, no progress) +## options(2) - Relative size of simplex (default 1e-3) +## options(6) - Optimization algorithm +## if options(6)==0 - Nelder & Mead simplex (default) +## if options(6)==1 - Multidirectional search Method +## if options(6)==2 - Alternating Directions search +## options(5) +## if options(6)==0 && options(5)==0 - regular simplex +## if options(6)==0 && options(5)==1 - right-angled simplex +## Comment: the default is set to "right-angled simplex". +## this works better for me on a broad range of problems, +## although the default in nmsmax is "regular simplex" +## options(10) - Maximum number of function evaluations +## @end verbatim +## @item grad +## Unused (For compatibility with Matlab) +## @item P1,P2, ... +## Optional parameters for function @var{f} +## +## @end table +## @end deftypefn + +function ret=fmins(funfun, X0, options, grad, varargin) + stopit = [1e-3, inf, inf, 1, 0, -1]; + minfun = 'nmsmax'; + + if nargin < 3; options=[]; end + + if length(options)>=1; stopit(5)= options(1); end + if length(options)>=2; stopit(1)= options(2); end + if length(options)>=5; + if options(6)==0; minfun= 'nmsmax'; + if options(5)==0; stopit(4)= 0; + elseif options(5)==1; stopit(4)= 1; + else error('options(5): no associated simple strategy'); + end + elseif options(6)==1; minfun= 'mdsmax'; + elseif options(6)==2; minfun= 'adsmax'; + else error('options(6) does not correspond to known algorithm'); + end + end + if length(options)>=10; stopit(2)= options(10); end + + ret = feval(minfun, funfun, X0, stopit, [], varargin{:}); +endfunction
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/fminunc.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,154 @@ +## Copyright (C) 2002 Etienne Grossmann. All rights reserved. +## +## This program 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. +## +## This 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. + +## [x,v,flag,out,df,d2f] = fminunc (f,x,opt,...) - M*tlab-like optimization +## +## Imitation of m*tlab's fminunc(). The optional 'opt' argument is a struct, +## e.g. produced by 'optimset()'. +## +## Supported options +## ----------------- +## Diagnostics, [off|on] : Be verbose +## Display , [off|iter|notify|final] +## : Be verbose unless value is "off" +## GradObj , [off|on] : Function's 2nd return value is derivatives +## Hessian , [off|on] : Function's 2nd and 3rd return value are +## derivatives and Hessian. +## TolFun , scalar : Termination criterion (see 'ftol' in minimize()) +## TolX , scalar : Termination criterion (see 'utol' in minimize()) +## MaxFunEvals, int : Max. number of function evaluations +## MaxIter , int : Max. number of algorithm iterations +## +## These non-m*tlab are provided to facilitate porting code to octave: +## ----------------------- +## "MinEquiv" , [off|on] : Don't minimize 'fun', but instead return the +## option passed to minimize(). +## +## "Backend" , [off|on] : Don't minimize 'fun', but instead return +## [backend, opt], the name of the backend +## optimization function that is used and the +## optional arguments that will be passed to it. See +## the 'backend' option of minimize(). +## +## This function is a front-end to minimize(). +function [x,fval,flag,out,df,d2f] = fminunc (fun,x0,opt,varargin) + +if nargin < 3, opt = setfield (); end +if nargin > 3, + args = list (x0, varargin{:}); +else + args = list (x0); +end + +## Do some checks #################################################### +ws = es = ""; + +## Check for unknown options +## All known options +opn = [" DerivativeCheck Diagnostics DiffMaxChange DiffMinChange",\ + " Display GoalsExactAchieve GradConstr GradObj Hessian HessMult",\ + " HessPattern HessUpdate Jacobian JacobMult JacobPattern",\ + " LargeScale LevenbergMarquardt LineSearchType MaxFunEvals MaxIter",\ + " MaxPCGIter MeritFunction MinAbsMax PrecondBandWidth TolCon",\ + " TolFun TolPCG TolX TypicalX ",\ + " MinEquiv Backend "]; + +for [v,k] = opt + if ! findstr ([" ",k," "],opn) + es = [es,sprintf("Unknown option '%s'\n",k)]; + end +end + +## Check for ignored options +## All ignored options +iop = [" DerivativeCheck DiffMaxChange DiffMinChange",\ + " Display GoalsExactAchieve GradConstr HessMult",\ + " HessPattern HessUpdate JacobMult JacobPattern",\ + " LargeScale LevenbergMarquardt LineSearchType",\ + " MaxPCGIter MeritFunction MinAbsMax PrecondBandWidth TolCon",\ + " TolPCG TypicalX "]; +for [v,k] = opt + if ! findstr ([" ",k," "],iop) + ws = [ws,sprintf("Ignoring option '%s'\n",k)]; + end +end + +if length (ws) && ! length (es), warn (ws); +elseif length (es), error ([ws,es]); +end + +## Transform fminunc options into minimize() options + +opm = struct(); # minimize() options + +equiv = struct ("TolX" , "utol" , "TolFun" , "ftol",\ + "MaxFunEvals", "maxev" , "MaxIter" , "maxit",\ + "GradObj ", "jac" , "Hessian" , "hess",\ + "Display" , "verbose", "Diagnostics", "verbose",\ + "Backend" , "backend"); + +for [v,k] = equiv + if struct_contains (opt,k), opm = setfield (opm, getfield(equiv,k),v); end +end + + # Transform "off" into 0, other strings into + # 1. +for [v,k] = opm + if ischar (v) + if strcmp (v,"off") + opm = setfield (opm, k,0); + else + opm = setfield (opm, k,1); + end + end +end + +unary_opt = " hess jac backend verbose "; +opml = list (); +for [v,k] = opm + if findstr ([" ",k," "], unary_opt) + opml = append (opml, list (k)); + else + opml = append (opml, list (k, v)); + end +end + # Return only options to minimize() ## +if struct_contains (opt, "MinEquiv") + x = opml; + if nargout > 1 + warn ("Only 1 return value is defined with the 'MinEquiv' option"); + end + return + # Use the backend option ############# +elseif struct_contains (opm, "backend") + [x,fval] = minimize (fun, args, opml); + if nargout > 2 + warn ("Only 2 return values are defined with the 'Backend' option"); + end + return +else # Do the minimization ################ + [x,fval,out] = minimize (fun, args, opml); + + if struct_contains (opm, "maxev") + flag = out(1) < maxev; + else + flag = 1; + end + + if nargout > 4 + args = splice (args, 1, 1, list (x)); + [dummy,df,d2f] = leval (fun, args); + elseif nargout > 3 + args = splice (args, 1, 1, list (x)); + [dummy,df] = leval (fun, args); + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/fzero.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,446 @@ +## Copyright (C) 2004 £ukasz Bodzon <lllopezzz@o2.pl> +## +## This program 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 of the License, or +## (at your option) any later version. +## +## This program 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 this program; if not, write to the Free Software +## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +## +## REVISION HISTORY +## +## 2004-07-20, Piotr Krzyzanowski, <piotr.krzyzanowski@mimuw.edu.pl>: +## Options parameter and fall back to fsolve if only scalar APPROX argument +## supplied +## +## 2004-07-01, Lukasz Bodzon: +## Replaced f(a)*f(b) < 0 criterion by a more robust +## sign(f(a)) ~= sign(f(b)) +## +## 2004-06-18, Lukasz Bodzon: +## Original implementation of Brent's method of finding a zero of a scalar +## function + +## -*- texinfo -*- +## @deftypefn {Function File} {} [X, FX, INFO] = fzero (FCN, APPROX, OPTIONS) +## +## Given FCN, the name of a function of the form `F (X)', and an initial +## approximation APPROX, `fzero' solves the scalar nonlinear equation such that +## `F(X) == 0'. Depending on APPROX, `fzero' uses different algorithms to solve +## the problem: either the Brent's method or the Powell's method of `fsolve'. +## +## @deftypefnx {Function File} {} [X, FX, INFO] = fzero (FCN, APPROX, OPTIONS,P1,P2,...) +## +## Call FCN with FCN(X,P1,P2,...). +## +## @table @asis +## @item INPUT ARGUMENTS +## @end table +## +## @table @asis +## @item APPROX can be a vector with two components, +## @example +## A = APPROX(1) and B = APPROX(2), +## @end example +## which localizes the zero of F, that is, it is assumed that X lies between A and +## B. If APPROX is a scalar, it is treated as an initial guess for X. +## +## If APPROX is a vector of length 2 and F takes different signs at A and B, +## F(A)*F(B) < 0, then the Brent's zero finding algorithm [1] is used with error +## tolerance criterion +## @example +## reltol*|X|+abstol (see OPTIONS). +## @end example +## This algorithm combines +## superlinear convergence (for sufficiently regular functions) with the +## robustness of bisection. +## +## Whether F has identical signs at A and B, or APPROX is a single scalar value, +## then `fzero' falls back to another method and `fsolve(FCN, X0)' is called, with +## the starting value X0 equal to (A+B)/2 or APPROX, respectively. Only absolute +## residual tolerance, abstol, is used then, due to the limitations of the `fsolve_options' +## function. See OPTIONS and `help fsolve' for details. +## +## @item OPTIONS is a structure, with the following fields: +## +## @table @asis +## @item 'abstol' - absolute (error for Brent's or residual for fsolve) +## tolerance. Default = 1e-6. +## +## @item 'reltol' - relative error tolerance (only Brent's method). Default = 1e-6. +## +## @item 'prl' - print level, how much diagnostics to print. Default = 0, no +## diagnostics output. +## @end table +## +## If OPTIONS argument is omitted, or a specific field is not present in the +## OPTIONS structure, default values will be used. +## @end table +## +## @table @asis +## @item OUTPUT ARGUMENTS +## @end table +## +## @table @asis +## @item The computed approximation to the zero of FCN is returned in X. FX is then equal +## to FCN(X). If the iteration converged, INFO == 1. If Brent's method is used, +## and the function seems discontinuous, INFO is set to -5. If fsolve is used, +## INFO is determined by its convergence. +## @end table +## +## @table @asis +## @item EXAMPLES +## @end table +## +## @example +## fzero('sin',[-2 1]) will use Brent's method to find the solution to +## sin(x) = 0 in the interval [-2, 1] +## @end example +## +## @example +## [x, fx, info] = fzero('sin',-2) will use fsolve to find a solution to +## sin(x)=0 near -2. +## @end example +## +## @example +## options.abstol = 1e-2; fzero('sin',-2, options) will use fsolve to +## find a solution to sin(x)=0 near -2 with the absolute tolerance 1e-2. +## @end example +## +## @table @asis +## @item REFERENCES +## [1] Brent, R. P. "Algorithms for minimization without derivatives" (1971). +## @end table +## @end deftypefn +## @seealso{fsolve} + +function [Z, FZ, INFO] =fzero(Func,bracket,options,varargin) + + if (nargin < 2) + usage("[x, fx, info] = fzero(@fcn, [lo,hi]|start, options)"); + endif + + if !ischar(Func) && !isa(Func,"function handle") && !isa(Func,"inline function") + error("fzero expects a function as the first argument"); + endif + bracket = bracket(:); + if all(length(bracket)!=[1,2]) + error("fzero expects an initial value or a range"); + endif + + + set_default_options = false; + if (nargin >= 2) % check for the options + if (nargin == 2) + set_default_options = true; + options = []; + else % nargin > 2 + if ~isstruct(options) + if ~isempty(options) % empty indicates default chosen + warning('Options incorrect. Setting default values.'); + end + warning('Options incorrect. Setting default values.'); + set_default_options = true; + end + end + end + + if ~isfield(options,'abstol') + options.abstol = 1e-6; + end + if ~isfield(options,'reltol') + options.reltol = 1e-6; + end + % if ~isfield(options,'maxit') + % options.maxit = 100; + % end + if ~isfield(options,'prl') + options.prl = 0; % no diagnostics output + end + + fcount = 0; % counts function evaluations + if (length(bracket) > 1) + a = bracket(1); b = bracket(2); + use_brent = true; + else + b = bracket; + use_brent = false; + end + + + if (use_brent) + + fa=feval(Func,a,varargin{:}); fcount=fcount+1; + fb=feval(Func,b,varargin{:}); fcount=fcount+1; + + BOO=true; + tol=options.reltol*abs(b)+options.abstol; + + % check if one of the endpoints is the solution + if (fa == 0.0) + BOO = false; + c = b = a; + fc = fb = fa; + end + if (fb == 0.0) + BOO = false; + c = a = b; + fc = fa = fb; + end + + if ((sign(fa) == sign(fb)) & BOO) + warning ("fzero: equal signs at both ends of the interval.\n\ + Using fsolve('%s',%g) instead", Func, 0.5*(a+b)); + use_brent = false; + b = 0.5*(a+b); + endif + end + + + + if (use_brent) % it is reasonable to call Brent's method + if options.prl > 0 + fprintf(stderr,"============================\n"); + fprintf(stderr,"fzero: using Brent's method\n"); + fprintf(stderr,"============================\n"); + end + c=a; + fc=fa; + d=b-a; + e=d; + + while (BOO == true) % convergence check + + if (sign(fb) == sign(fc)) % rename a, b, c and adjust bounding interval + c=a; + fc=fa; + d=b-a; + e=d; + endif, + + ## We are preventing overflow and division by zero + ## while computing the new approximation by + ## linear interpolation. + ## After this step, we lose the chance for using + ## inverse quadratic interpolation (a==c). + + if (abs(fc) < abs(fb)) + a=b; + b=c; + c=a; + fa=fb; + fb=fc; + fc=fa; + endif, + + tol=options.reltol*abs(b)+options.abstol; + m=0.5*(c-b); + if options.prl > 0 + fprintf(stderr,'fzero: [%d feval] X = %8.4e\n', fcount, b); + if options.prl > 1 + fprintf(stderr,'fzero: m = %8.4e e = %8.4e [tol = %8.4e]\n', m, e, tol); + end + end + + if (abs(m) > tol & fb != 0) + + ## The second condition in following if-instruction + ## prevents overflow and division by zero + ## while computing the new approximation by + ## inverse quadratic interpolation. + + if (abs(e) < tol | abs(fa) <= abs(fb)) + d=m; % bisection + e=m; + + else + s=fb/fa; + + if (a == c) % attempt linear interpolation + p=2*m*s; % (the secant method) + q=1-s; + + else % attempt inverse quadratic interpolation + q=fa/fc; + r=fb/fc; + p=s*(2*m*q*(q-r)-(b-a)*(r-1)); + q=(q-1)*(r-1)*(s-1); + endif, + + if (p > 0) % fit signs + q=-q; % to the sign of (c-b) + + else + p=-p; + endif, + + s=e; + e=d; + + if (2*p < 3*m*q-abs(tol*q) & p < abs(0.5*s*q)) + d=p/q; % accept interpolation + + else % interpolation failed; + d=m; % take the bisection step + e=m; + endif, + + endif, + + a=b; + fa=fb; + + if (abs(d) > tol) % the step we take is never shorter + b=b+d; % than tol + + else + + if (m > 0) % fit signs + b=b+tol; % to the sign of (c-b) + + else + b=b-tol; + endif, + + endif, + + fb=feval(Func,b,varargin{:}); fcount=fcount+1; + + else + BOO=false; + endif, + + endwhile, + Z=b; + FZ = fb; + if abs(FZ) > 100*tol % large value of the residual may indicate a discontinuity point + INFO = -5; + else + INFO = 1; + end + % + % TODO: test if Z may be a singular point of F (ie F is discontinuous at Z + % Then return INFO = -5 + % + if (options.prl > 0 ) + fprintf(stderr,"\nfzero: summary\n"); + switch(INFO) + case 1 + MSG = "Solution converged within specified tolerance"; + case -5 + MSG = strcat("Probably a discontinuity/singularity point of F()\n encountered close to X = ", sprintf('%8.4e',Z),... + ".\n Value of the residual at X, |F(X)| = ",... + sprintf('%8.4e',abs(FZ)), ... + ".\n Another possibility is that you use too large tolerance parameters",... + ".\n Currently TOL = ", sprintf('%8.4e', tol), ... + ".\n Try fzero with smaller tolerance values"); + otherwise + MSG = "Something strange happened" + endswitch + fprintf(stderr,' %s.\n', MSG); + fprintf(stderr,' %d function evaluations.\n', fcount); + end + + else % fall back to fsolve + if options.prl > 0 + fprintf(stderr,"============================\n"); + fprintf(stderr,"fzero: using fsolve\n"); + fprintf(stderr,"============================\n"); + end + % check for zeros in APPROX + fb=feval(Func,b,varargin{:}); + fcount=fcount+1; + tol_save = fsolve_options('tolerance'); + fsolve_options("tolerance",options.abstol); + [Z, INFO, MSG] = fsolve(Func, b); + fsolve_options('tolerance',tol_save); + FZ = feval(Func,Z,varargin{:}); + if options.prl > 0 + fprintf(stderr,"\nfzero: summary\n"); + fprintf(stderr,' %s.\n', MSG); + end + end +endfunction; + +%!## usage and error testing +%!## the Brent's method +%!test +%! options.abstol=0; +%! assert (fzero('sin',[-1,2],options), 0) +%!test +%! options.abstol=0.01; +%! options.reltol=1e-3; +%! assert (fzero('tan',[-0.5,1.41],options), 0, 0.01) +%!test +%! options.abstol=1e-3; +%! assert (fzero('atan',[-(10^300),10^290],options), 0, 1e-3) +%!test +%! testfun=inline('(x-1)^3','x'); +%! options.abstol=0; +%! options.reltol=eps; +%! assert (fzero(testfun,[0,3],options), 1, -eps) +%!test +%! testfun=inline('(x-1)^3+y+z','x','y','z'); +%! options.abstol=0; +%! options.reltol=eps; +%! assert (fzero(testfun,[-3,0],options,22,5), -2, eps) +%!test +%! testfun=inline('x.^2-100','x'); +%! options.abstol=1e-4; +%! assert (fzero(testfun,[-9,300],options),10,1e-4) +%!## `fsolve' +%!test +%! options.abstol=0.01; +%! assert (fzero('tan',-0.5,options), 0, 0.01) +%!test +%! options.abstol=0; +%! assert (fzero('sin',[0.5,1],options), 0) +%! +%!demo +%! bracket=[-1,1.2]; +%! [X,FX,MSG]=fzero('tan',bracket) +%!demo +%! bracket=1; # `fsolve' will be used +%! [X,FX,MSG]=fzero('sin',bracket) +%!demo +%! bracket=[-1,2]; +%! options.abstol=0; options.prl=1; +%! X=fzero('sin',bracket,options) +%!demo +%! bracket=[0.5,1]; +%! options.abstol=0; options.reltol=eps; options.prl=1; +%! fzero('sin',bracket,options) +%!demo +%! demofun=inline('2*x.*exp(-4)+1 - 2*exp(-4*x)','x'); +%! bracket=[0, 1]; +%! options.abstol=1e-14; options.reltol=eps; options.prl=2; +%! [X,FX]=fzero(demofun,bracket,options) +%!demo +%! demofun=inline('x^51','x'); +%! bracket=[-12,10]; +%! # too large tolerance parameters +%! options.abstol=1; options.reltol=1; options.prl=1; +%! [X,FX]=fzero(demofun,bracket,options) +%!demo +%! # points of discontinuity inside the bracket +%! demofun=inline('0.5*(sign(x-1e-7)+sign(x+1e-7))','x'); +%! bracket=[-5,7]; +%! options.prl=1; +%! [X,FX]=fzero(demofun,bracket,options) +%!demo +%! demofun=inline('2*x*exp(-x^2)','x'); +%! bracket=1; +%! options.abstol=1e-14; options.prl=2; +%! [X,FX]=fzero(demofun,bracket,options) +%!demo +%! demofun=inline('2*x.*exp(-x.^2)','x'); +%! bracket=[-10,1]; +%! options.abstol=1e-14; options.prl=2; +%! [X,FX]=fzero(demofun,bracket,options)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/leasqr.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,349 @@ +% Copyright (C) 1992-1994 Richard Shrager, Arthur Jutan, Ray Muzic +% +% This program 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 of the License, or +% (at your option) any later version. +% +% This program 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 this program; if not, write to the Free Software +% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +function [f,p,kvg,iter,corp,covp,covr,stdresid,Z,r2]= ... + leasqr(x,y,pin,F,stol,niter,wt,dp,dFdp,options) +%function [f,p,kvg,iter,corp,covp,covr,stdresid,Z,r2]= +% leasqr(x,y,pin,F,{stol,niter,wt,dp,dFdp,options}) +% +% Levenberg-Marquardt nonlinear regression of f(x,p) to y(x). +% +% Version 3.beta +% {}= optional parameters +% x=vec or mat of indep variables, 1 row/observation: x=[x0 x1....xm] +% y=vec of obs values, same no. of rows as x. +% wt=vec(dim=length(x)) of statistical weights. These should be set +% to be proportional to (sqrt of var(y))^-1; (That is, the covariance +% matrix of the data is assumed to be proportional to diagonal with diagonal +% equal to (wt.^2)^-1. The constant of proportionality will be estimated.), +% default=ones(length(y),1). +% pin=vector of initial parameters to be adjusted by leasqr. +% dp=fractional incr of p for numerical partials,default= .001*ones(size(pin)) +% dp(j)>0 means central differences. +% dp(j)<0 means one-sided differences. +% Note: dp(j)=0 holds p(j) fixed i.e. leasqr wont change initial guess: pin(j) +% F=name of function in quotes,of the form y=f(x,p) +% dFdp=name of partials M-file in quotes default is prt=dfdp(x,f,p,dp,F) +% stol=scalar tolerances on fractional improvement in ss,default stol=.0001 +% niter=scalar max no. of iterations, default = 20 +% options=matrix of n rows (same number of rows as pin) containing +% column 1: desired fractional precision in parameter estimates. +% Iterations are terminated if change in parameter vector (chg) on two +% consecutive iterations is less than their corresponding elements +% in options(:,1). [ie. all(abs(chg*current parm est) < options(:,1)) +% on two consecutive iterations.], default = zeros(). +% column 2: maximum fractional step change in parameter vector. +% Fractional change in elements of parameter vector is constrained to be +% at most options(:,2) between sucessive iterations. +% [ie. abs(chg(i))=abs(min([chg(i) options(i,2)*current param estimate])).], +% default = Inf*ones(). +% +% OUTPUT VARIABLES +% f=vec function values computed in function func. +% p=vec trial or final parameters. i.e, the solution. +% kvg=scalar: =1 if convergence, =0 otherwise. +% iter=scalar no. of interations used. +% corp= correlation matrix for parameters +% covp= covariance matrix of the parameters +% covr = diag(covariance matrix of the residuals) +% stdresid= standardized residuals +% Z= matrix that defines confidence region +% r2= coefficient of multiple determination +% +% All Zero guesses not acceptable + +% A modified version of Levenberg-Marquardt +% Non-Linear Regression program previously submitted by R.Schrager. +% This version corrects an error in that version and also provides +% an easier to use version with automatic numerical calculation of +% the Jacobian Matrix. In addition, this version calculates statistics +% such as correlation, etc.... +% +% Version 3 Notes +% Errors in the original version submitted by Shrager (now called version 1) +% and the improved version of Jutan (now called version 2) have been corrected. +% Additional features, statistical tests, and documentation have also been +% included along with an example of usage. BEWARE: Some the the input and +% output arguments were changed from the previous version. +% +% Ray Muzic <rfm2@ds2.uh.cwru.edu> +% Arthur Jutan <jutan@charon.engga.uwo.ca> + +% Richard I. Shrager (301)-496-1122 +% Modified by A.Jutan (519)-679-2111 +% Modified by Ray Muzic 14-Jul-1992 +% 1) add maxstep feature for limiting changes in parameter estimates +% at each step. +% 2) remove forced columnization of x (x=x(:)) at beginning. x could be +% a matrix with the ith row of containing values of the +% independent variables at the ith observation. +% 3) add verbose option +% 4) add optional return arguments covp, stdresid, chi2 +% 5) revise estimates of corp, stdev +% Modified by Ray Muzic 11-Oct-1992 +% 1) revise estimate of Vy. remove chi2, add Z as return values +% Modified by Ray Muzic 7-Jan-1994 +% 1) Replace ones(x) with a construct that is compatible with versions +% newer and older than v 4.1. +% 2) Added global declaration of verbose (needed for newer than v4.x) +% 3) Replace return value var, the variance of the residuals with covr, +% the covariance matrix of the residuals. +% 4) Introduce options as 10th input argument. Include +% convergence criteria and maxstep in it. +% 5) Correct calculation of xtx which affects coveraince estimate. +% 6) Eliminate stdev (estimate of standard deviation of parameter +% estimates) from the return values. The covp is a much more +% meaningful expression of precision because it specifies a confidence +% region in contrast to a confidence interval.. If needed, however, +% stdev may be calculated as stdev=sqrt(diag(covp)). +% 7) Change the order of the return values to a more logical order. +% 8) Change to more efficent algorithm of Bard for selecting epsL. +% 9) Tighten up memory usage by making use of sparse matrices (if +% MATLAB version >= 4.0) in computation of covp, corp, stdresid. +% Modified by Francesco Potorti +% for use in Octave +% +% References: +% Bard, Nonlinear Parameter Estimation, Academic Press, 1974. +% Draper and Smith, Applied Regression Analysis, John Wiley and Sons, 1981. +% +%set default args + +% argument processing +% + +%if (sscanf(version,'%f') >= 4), +vernum= sscanf(version,'%f'); +if vernum(1) >= 4, + global verbose + plotcmd='plot(x(:,1),y,''+'',x(:,1),f); figure(gcf)'; +else + plotcmd='plot(x(:,1),y,''+'',x(:,1),f); shg'; +end; +if (exist('OCTAVE_VERSION')) + global verbose + plotcmd='plot(x(:,1),y,"+;data;",x(:,1),f,";fit;");'; +end; + +if(exist('verbose')~=1), %If verbose undefined, print nothing + verbose=0; %This will not tell them the results +end; + +if (nargin <= 8), dFdp='dfdp'; end; +if (nargin <= 7), dp=.001*(pin*0+1); end; %DT +if (nargin <= 6), wt=ones(length(y),1); end; % SMB modification +if (nargin <= 5), niter=20; end; +if (nargin == 4), stol=.0001; end; +% + +y=y(:); wt=wt(:); pin=pin(:); dp=dp(:); %change all vectors to columns +% check data vectors- same length? +m=length(y); n=length(pin); p=pin;[m1,m2]=size(x); +if m1~=m ,error('input(x)/output(y) data must have same number of rows ') ,end; + +if (nargin <= 9), + options=[zeros(n,1), Inf*ones(n,1)]; + nor = n; noc = 2; +else + [nor, noc]=size(options); + if (nor ~= n), + error('options and parameter matrices must have same number of rows'), + end; + if (noc ~= 2), + options=[options(:,1), Inf*ones(nor,1)]; + end; +end; +pprec=options(:,1); +maxstep=options(:,2); +% + +% set up for iterations +% +f=feval(F,x,p); fbest=f; pbest=p; +r=wt.*(y-f); +ss=r'*r; +sbest=ss; +nrm=zeros(n,1); +chgprev=Inf*ones(n,1); +kvg=0; +epsLlast=1; +epstab=[.1, 1, 1e2, 1e4, 1e6]; + +% do iterations +% +for iter=1:niter, + pprev=pbest; + prt=feval(dFdp,x,fbest,pprev,dp,F); + r=wt.*(y-fbest); + sprev=sbest; + sgoal=(1-stol)*sprev; + for j=1:n, + if dp(j)==0, + nrm(j)=0; + else + prt(:,j)=wt.*prt(:,j); + nrm(j)=prt(:,j)'*prt(:,j); + if nrm(j)>0, + nrm(j)=1/sqrt(nrm(j)); + end; + end + prt(:,j)=nrm(j)*prt(:,j); + end; +% above loop could ? be replaced by: +% prt=prt.*wt(:,ones(1,n)); +% nrm=dp./sqrt(diag(prt'*prt)); +% prt=prt.*nrm(:,ones(1,m))'; + [prt,s,v]=svd(prt,0); + s=diag(s); + g=prt'*r; + for jjj=1:length(epstab), + epsL = max(epsLlast*epstab(jjj),1e-7); + se=sqrt((s.*s)+epsL); + gse=g./se; + chg=((v*gse).*nrm); +% check the change constraints and apply as necessary + ochg=chg; + idx = ~isinf(maxstep); + limit = abs(maxstep(idx).*pprev(idx)); + chg(idx) = min(max(chg(idx),-limit),limit); + if (verbose & any(ochg ~= chg)), + disp(['Change in parameter(s): ', ... + sprintf('%d ',find(ochg ~= chg)), 'were constrained']); + end; + aprec=abs(pprec.*pbest); %--- +% ss=scalar sum of squares=sum((wt.*(y-f))^2). + if (any(abs(chg) > 0.1*aprec)),%--- % only worth evaluating function if + p=chg+pprev; % there is some non-miniscule change + f=feval(F,x,p); + r=wt.*(y-f); + ss=r'*r; + if ss<sbest, + pbest=p; + fbest=f; + sbest=ss; + end; + if ss<=sgoal, + break; + end; + end; %--- + end; + epsLlast = epsL; + if (verbose), + eval(plotcmd); + end; + if ss<eps, + break; + end + aprec=abs(pprec.*pbest); +% [aprec, chg, chgprev] + if (all(abs(chg) < aprec) & all(abs(chgprev) < aprec)), + kvg=1; + if (verbose), + fprintf('Parameter changes converged to specified precision\n'); + end; + break; + else + chgprev=chg; + end; + if ss>sgoal, + break; + end; +end; + +% set return values +% +p=pbest; +f=fbest; +ss=sbest; +kvg=((sbest>sgoal)|(sbest<=eps)|kvg); +if kvg ~= 1 , disp(' CONVERGENCE NOT ACHIEVED! '), end; + +% CALC VARIANCE COV MATRIX AND CORRELATION MATRIX OF PARAMETERS +% re-evaluate the Jacobian at optimal values +jac=feval(dFdp,x,f,p,dp,F); +msk = dp ~= 0; +n = sum(msk); % reduce n to equal number of estimated parameters +jac = jac(:, msk); % use only fitted parameters + +%% following section is Ray Muzic's estimate for covariance and correlation +%% assuming covariance of data is a diagonal matrix proportional to +%% diag(1/wt.^2). +%% cov matrix of data est. from Bard Eq. 7-5-13, and Row 1 Table 5.1 + +if exist('sparse') % save memory + Q=sparse(1:m,1:m,1./wt.^2); + Qinv=sparse(1:m,1:m,wt.^2); +else + Q=diag((0*wt+1)./(wt.^2)); + Qinv=diag(wt.*wt); +end +resid=y-f; %un-weighted residuals +covr=resid'*Qinv*resid*Q/(m-n); %covariance of residuals +Vy=1/(1-n/m)*covr; % Eq. 7-13-22, Bard %covariance of the data + +jtgjinv=inv(jac'*Qinv*jac); %argument of inv may be singular +covp=jtgjinv*jac'*Qinv*Vy*Qinv*jac*jtgjinv; % Eq. 7-5-13, Bard %cov of parm est +d=sqrt(abs(diag(covp))); +corp=covp./(d*d'); + +if exist('sparse') + covr=spdiags(covr,0); + stdresid=resid./sqrt(spdiags(Vy,0)); +else + covr=diag(covr); % convert returned values to compact storage + stdresid=resid./sqrt(diag(Vy)); % compute then convert for compact storage +end +Z=((m-n)*jac'*Qinv*jac)/(n*resid'*Qinv*resid); + +%%% alt. est. of cov. mat. of parm.:(Delforge, Circulation, 82:1494-1504, 1990 +%%disp('Alternate estimate of cov. of param. est.') +%%acovp=resid'*Qinv*resid/(m-n)*jtgjinv + +%Calculate R^2 (Ref Draper & Smith p.46) +% +r=corrcoef([y(:),f(:)]); +r2=r(1,2).^2; + +% if someone has asked for it, let them have it +% +if (verbose), + eval(plotcmd); + disp(' Least Squares Estimates of Parameters') + disp(p') + disp(' Correlation matrix of parameters estimated') + disp(corp) + disp(' Covariance matrix of Residuals' ) + disp(covr) + disp(' Correlation Coefficient R^2') + disp(r2) + sprintf(' 95%% conf region: F(0.05)(%.0f,%.0f)>= delta_pvec''*Z*delta_pvec',n,m-n) + Z +% runs test according to Bard. p 201. + n1 = sum((f-y) < 0); + n2 = sum((f-y) > 0); + nrun=sum(abs(diff((f-y)<0)))+1; + if ((n1>10)&(n2>10)), % sufficent data for test? + zed=(nrun-(2*n1*n2/(n1+n2)+1)+0.5)/(2*n1*n2*(2*n1*n2-n1-n2)... + /((n1+n2)^2*(n1+n2-1))); + if (zed < 0), + prob = erfc(-zed/sqrt(2))/2*100; + disp([num2str(prob),'% chance of fewer than ',num2str(nrun),' runs.']); + else, + prob = erfc(zed/sqrt(2))/2*100; + disp([num2str(prob),'% chance of greater than ',num2str(nrun),' runs.']); + end; + end; +end;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/leasqrdemo.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,84 @@ +% Copyright (C) 1992-1994 Richard Shrager +% Copyright (C) 1992-1994 Arthur Jutan +% Copyright (C) 1992-1994 Ray Muzic +% +% This program 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 of the License, or +% (at your option) any later version. +% +% This program 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 this program; if not, write to the Free Software +% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +% leasqrdemo +% +% An example showing how to use non-linear least squares to fit +% simulated data to the function: +% +% y = a e^{-bx} + +% 2001-02-05 Paul Kienzle +% * collected example into a single script + +function leasqrdemo + % generate test data + t = [1:10:100]'; + p = [1; 0.1]; + data = leasqrfunc (t, p); + + rnd = [ 0.352509 + -0.040607 + -1.867061 + -1.561283 + 1.473191 + 0.580767 + 0.841805 + 1.632203 + -0.179254 + 0.345208 ]; + + % add noise + % wt1 = 1 /sqrt of variances of data + % 1 / wt1 = sqrt of var = standard deviation + wt1 = (1 + 0 * t) ./ sqrt (data); + data = data + 0.05 * rnd ./ wt1; + + % Note by Thomas Walter <walter@pctc.chemie.uni-erlangen.de>: + % + % Using a step size of 1 to calculate the derivative is WRONG !!!! + % See numerical mathbooks why. + % A derivative calculated from central differences need: s + % step = 0.001...1.0e-8 + % And onesided derivative needs: + % step = 1.0e-5...1.0e-8 and may be still wrong + + F = @leasqrfunc; + dFdp = @leasqrdfdp; % exact derivative + % dFdp = @dfdp; % estimated derivative + dp = [0.001; 0.001]; + pin = [.8; .05]; + stol=0.001; niter=50; + minstep = [0.01; 0.01]; + maxstep = [0.8; 0.8]; + options = [minstep, maxstep]; + + global verbose; + verbose=1; + [f1, p1, kvg1, iter1, corp1, covp1, covr1, stdresid1, Z1, r21] = ... + leasqr (t, data, pin, F, stol, niter, wt1, dp, dFdp, options); + +function y = leasqrfunc(x,p) + % sprintf('called leasqrfunc(x,[%e %e]\n', p(1),p(2)) + % y = p(1)+p(2)*x; + y=p(1)*exp(-p(2)*x); + +function y = leasqrdfdp(x,f,p,dp,func) + % y = [0*x+1, x]; + y= [exp(-p(2)*x), -p(1)*x.*exp(-p(2)*x)]; +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/line_min.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,69 @@ +## Copyright (C) 2000 Ben Sapp. All rights reserved. +## +## This program 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. +## +## This 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. + +## [a,fx,nev] = line_min (f, dx, args, narg) - Minimize f() along dx +## +## INPUT ---------- +## f : string : Name of minimized function +## dx : matrix : Direction along which f() is minimized +## args : list : List of argument of f +## narg : integer : Position of minimized variable in args. Default=1 +## +## OUTPUT --------- +## a : scalar : Value for which f(x+a*dx) is a minimum (*) +## fx : scalar : Value of f(x+a*dx) at minimum (*) +## nev : integer : Number of function evaluations +## +## (*) The notation f(x+a*dx) assumes that args == list (x). + +## Author: Ben Sapp <bsapp@lanl.gov> +## Reference: David G Luenberger's Linear and Nonlinear Programming +## +## Changelog : ----------- +## 2002-01-28 Paul Kienzle +## * save two function evaluations by inlining the derivatives +## * pass through varargin{:} to the function +## 2002-03-13 Paul Kienzle +## * simplify update expression +## 2002-04-17 Etienne Grossmann <etienne@isr.ist.utl.pt> +## * Rename nrm.m to line_min.m (in order not to break dfp, which uses nrm) +## * Use list of args, suppress call to __pseudo_func__ +## * Add nargs argument, assume args is a list +## * Change help text +function [a,fx,nev] = line_min (f, dx, args, narg) + velocity = 1; + acceleration = 1; + + if nargin < 4, narg = 1; end + + nev = 0; + h = 0.001; # Was 0.01 here + x = nth (args,narg); + a = 0; + # was 1e-4 + while (abs (velocity) > 0.000001) + fx = leval (f,splice (args, narg, 1, list (x+a*dx))); + fxph = leval (f,splice (args, narg,1,list (x+(a+h)*dx))); + fxmh = leval (f,splice (args, narg,1,list (x+(a-h)*dx))); + + velocity = (fxph - fxmh)/(2*h); + acceleration = (fxph - 2*fx + fxmh)/(h^2); + if abs(acceleration) <= eps, acceleration = 1; end # Don't do div by zero + # Use abs(accel) to avoid problems due to + # concave function + a = a - velocity/abs(acceleration); + nev += 3; + endwhile +endfunction + +## Rem : Although not clear from the code, the returned a always seems to +## correspond to (nearly) optimal fx. \ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/mdsmax.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,184 @@ +function [x, fmax, nf] = mdsmax(fun, x, stopit, savit, varargin) +%MDSMAX Multidirectional search method for direct search optimization. +% [x, fmax, nf] = MDSMAX(FUN, x0, STOPIT, SAVIT) attempts to +% maximize the function FUN, using the starting vector x0. +% The method of multidirectional search is used. +% Output arguments: +% x = vector yielding largest function value found, +% fmax = function value at x, +% nf = number of function evaluations. +% The iteration is terminated when either +% - the relative size of the simplex is <= STOPIT(1) +% (default 1e-3), +% - STOPIT(2) function evaluations have been performed +% (default inf, i.e., no limit), or +% - a function value equals or exceeds STOPIT(3) +% (default inf, i.e., no test on function values). +% The form of the initial simplex is determined by STOPIT(4): +% STOPIT(4) = 0: regular simplex (sides of equal length, the default), +% STOPIT(4) = 1: right-angled simplex. +% Progress of the iteration is not shown if STOPIT(5) = 0 (default 1). +% If a non-empty fourth parameter string SAVIT is present, then +% `SAVE SAVIT x fmax nf' is executed after each inner iteration. +% NB: x0 can be a matrix. In the output argument, in SAVIT saves, +% and in function calls, x has the same shape as x0. +% MDSMAX(fun, x0, STOPIT, SAVIT, P1, P2,...) allows additional +% arguments to be passed to fun, via feval(fun,x,P1,P2,...). + +% This implementation uses 2n^2 elements of storage (two simplices), where x0 +% is an n-vector. It is based on the algorithm statement in [2, sec.3], +% modified so as to halve the storage (with a slight loss in readability). + +% From Matrix Toolbox +% Copyright (C) 2002 N.J.Higham +% www.maths.man.ac.uk/~higham/mctoolbox +% distributed under the terms of the GNU General Public License +% +% Modifications for octave by A.Adler 2003 +% $Id$ + +% References: +% [1] V. J. Torczon, Multi-directional search: A direct search algorithm for +% parallel machines, Ph.D. Thesis, Rice University, Houston, Texas, 1989. +% [2] V. J. Torczon, On the convergence of the multidirectional search +% algorithm, SIAM J. Optimization, 1 (1991), pp. 123-145. +% [3] N. J. Higham, Optimization by direct search in matrix computations, +% SIAM J. Matrix Anal. Appl, 14(2): 317-333, 1993. +% [4] N. J. Higham, Accuracy and Stability of Numerical Algorithms, +% Second edition, Society for Industrial and Applied Mathematics, +% Philadelphia, PA, 2002; sec. 20.5. + +x0 = x(:); % Work with column vector internally. +n = length(x0); + +mu = 2; % Expansion factor. +theta = 0.5; % Contraction factor. + +% Set up convergence parameters etc. +if nargin < 3 + stopit(1) = 1e-3; +elseif isempty(stopit) + stopit(1) = 1e-3; +endif +tol = stopit(1); % Tolerance for cgce test based on relative size of simplex. +if length(stopit) == 1, stopit(2) = inf; end % Max no. of f-evaluations. +if length(stopit) == 2, stopit(3) = inf; end % Default target for f-values. +if length(stopit) == 3, stopit(4) = 0; end % Default initial simplex. +if length(stopit) == 4, stopit(5) = 1; end % Default: show progress. +trace = stopit(5); +if length(stopit) == 5, stopit(6) = 1; end % Default: maximize +dirn= stopit(6); +if nargin < 4, savit = []; end % File name for snapshots. + +V = [zeros(n,1) eye(n)]; T = V; +f = zeros(n+1,1); ft = f; +V(:,1) = x0; f(1) = dirn*feval(fun,x,varargin{:}); +fmax_old = f(1); + +if trace, fprintf('f(x0) = %9.4e\n', f(1)), end + +k = 0; m = 0; + +% Set up initial simplex. +scale = max(norm(x0,inf),1); +if stopit(4) == 0 + % Regular simplex - all edges have same length. + % Generated from construction given in reference [18, pp. 80-81] of [1]. + alpha = scale / (n*sqrt(2)) * [ sqrt(n+1)-1+n sqrt(n+1)-1 ]; + V(:,2:n+1) = (x0 + alpha(2)*ones(n,1)) * ones(1,n); + for j=2:n+1 + V(j-1,j) = x0(j-1) + alpha(1); + x(:) = V(:,j); f(j) = dirn*feval(fun,x,varargin{:}); + end +else + % Right-angled simplex based on co-ordinate axes. + alpha = scale*ones(n+1,1); + for j=2:n+1 + V(:,j) = x0 + alpha(j)*V(:,j); + x(:) = V(:,j); f(j) = dirn*feval(fun,x,varargin{:}); + end +end +nf = n+1; +size = 0; % Integer that keeps track of expansions/contractions. +flag_break = 0; % Flag which becomes true when ready to quit outer loop. + +while 1 %%%%%% Outer loop. +k = k+1; + +% Find a new best vertex x and function value fmax = f(x). +[fmax,j] = max(f); +V(:,[1 j]) = V(:,[j 1]); v1 = V(:,1); +if ~isempty(savit), x(:) = v1; eval(['save ' savit ' x fmax nf']), end +f([1 j]) = f([j 1]); +if trace + fprintf('Iter. %2.0f, inner = %2.0f, size = %2.0f, ', k, m, size) + fprintf('nf = %3.0f, f = %9.4e (%2.1f%%)\n', nf, fmax, ... + 100*(fmax-fmax_old)/(abs(fmax_old)+eps)) +end +fmax_old = fmax; + +% Stopping Test 1 - f reached target value? +if fmax >= stopit(3) + msg = ['Exceeded target...quitting\n']; + break % Quit. +end + +m = 0; +while 1 %%% Inner repeat loop. + m = m+1; + + % Stopping Test 2 - too many f-evals? + if nf >= stopit(2) + msg = ['Max no. of function evaluations exceeded...quitting\n']; + flag_break = 1; break % Quit. + end + + % Stopping Test 3 - converged? This is test (4.3) in [1]. + size_simplex = norm(V(:,2:n+1)- v1(:,ones(1,n)),1) / max(1, norm(v1,1)); + if size_simplex <= tol + msg = sprintf('Simplex size %9.4e <= %9.4e...quitting\n', ... + size_simplex, tol); + flag_break = 1; break % Quit. + end + + for j=2:n+1 % ---Rotation (reflection) step. + T(:,j) = 2*v1 - V(:,j); + x(:) = T(:,j); ft(j) = dirn*feval(fun,x,varargin{:}); + end + nf = nf + n; + + replaced = ( max(ft(2:n+1)) > fmax ); + + if replaced + for j=2:n+1 % ---Expansion step. + V(:,j) = (1-mu)*v1 + mu*T(:,j); + x(:) = V(:,j); f(j) = dirn*feval(fun,x,varargin{:}); + end + nf = nf + n; + % Accept expansion or rotation? + if max(ft(2:n+1)) > max(f(2:n+1)) + V(:,2:n+1) = T(:,2:n+1); f(2:n+1) = ft(2:n+1); % Accept rotation. + else + size = size + 1; % Accept expansion (f and V already set). + end + else + for j=2:n+1 % ---Contraction step. + V(:,j) = (1+theta)*v1 - theta*T(:,j); + x(:) = V(:,j); f(j) = dirn*feval(fun,x,varargin{:}); + end + nf = nf + n; + replaced = ( max(f(2:n+1)) > fmax ); + % Accept contraction (f and V already set). + size = size - 1; + end + + if replaced, break, end + if trace & rem(m,10) == 0, fprintf(' ...inner = %2.0f...\n',m), end + end %%% Of inner repeat loop. + +if flag_break, break, end +end %%%%%% Of outer loop. + +% Finished. +if trace, fprintf(msg), end +x(:) = v1;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/minimize.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,300 @@ +## Copyright (C) 2002 Etienne Grossmann. All rights reserved. +## +## This program 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. +## +## This 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. + +## [x,v,nev,...] = minimize (f,args,...) - Minimize f +## +## ARGUMENTS +## f : string : Name of function. Must return a real value +## args : list or : List of arguments to f (by default, minimize the first) +## matrix : f's only argument +## +## RETURNED VALUES +## x : matrix : Local minimum of f. Let's suppose x is M-by-N. +## v : real : Value of f in x0 +## nev : integer : Number of function evaluations +## or 1 x 2 : Number of function and derivative evaluations (if +## derivatives are used) +## +## +## Extra arguments are either a succession of option-value pairs or a single +## list or struct of option-value pairs (for unary options, the value in the +## struct is ignored). +## +## OPTIONS : DERIVATIVES Derivatives may be used if one of these options +## --------------------- uesd. Otherwise, the Nelder-Mean (see +## nelder_mead_min) method is used. +## +## 'd2f', d2f : Name of a function that returns the value of f, of its +## 1st and 2nd derivatives : [fx,dfx,d2fx] = feval (d2f, x) +## where fx is a real number, dfx is 1x(M*N) and d2fx is +## (M*N)x(M*N). A Newton-like method (d2_min) will be used. +## +## 'hess' : Use [fx,dfx,d2fx] = leval (f, args) to compute 1st and +## 2nd derivatives, and use a Newton-like method (d2_min). +## +## 'd2i', d2i : Name of a function that returns the value of f, of its +## 1st and pseudo-inverse of second derivatives : +## [fx,dfx,id2fx] = feval (d2i, x) where fx is a real +## number, dfx is 1x(M*N) and d2ix is (M*N)x(M*N). +## A Newton-like method will be used (see d2_min). +## +## 'ihess' : Use [fx,dfx,id2fx] = leval (f, args) to compute 1st +## derivative and the pseudo-inverse of 2nd derivatives, +## and use a Newton-like method (d2_min). +## +## NOTE : df, d2f or d2i take the same arguments as f. +## +## 'order', n : Use derivatives of order n. If the n'th order derivative +## is not specified by 'df', 'd2f' or 'd2i', it will be +## computed numerically. Currently, only order 1 works. +## +## 'ndiff' : Use a variable metric method (bfgs) using numerical +## differentiation. +## +## OPTIONS : STOPPING CRITERIA Default is to use 'tol' +## --------------------------- +## 'ftol', ftol : Stop search when value doesn't improve, as tested by +## +## ftol > Deltaf/max(|f(x)|,1) +## +## where Deltaf is the decrease in f observed in the last +## iteration. Default=10*eps +## +## 'utol', utol : Stop search when updates are small, as tested by +## +## tol > max { dx(i)/max(|x(i)|,1) | i in 1..N } +## +## where dx is the change in the x that occured in the last +## iteration. +## +## 'dtol',dtol : Stop search when derivatives are small, as tested by +## +## dtol > max { df(i)*max(|x(i)|,1)/max(v,1) | i in 1..N } +## +## where x is the current minimum, v is func(x) and df is +## the derivative of f in x. This option is ignored if +## derivatives are not used in optimization. +## +## MISC. OPTIONS +## ------------- +## 'maxev', m : Maximum number of function evaluations <inf> +## +## 'narg' , narg : Position of the minimized argument in args <1> +## 'isz' , step : Initial step size (only for 0 and 1st order method) <1> +## Should correspond to expected distance to minimum +## 'verbose' : Display messages during execution +## +## 'backend' : Instead of performing the minimization itself, return +## [backend, control], the name and control argument of the +## backend used by minimize(). Minimimzation can then be +## obtained without the overhead of minimize by calling, if +## a 0 or 1st order method is used : +## +## [x,v,nev] = feval (backend, args, control) +## +## or, if a 2nd order method is used : +## +## [x,v,nev] = feval (backend, control.d2f, args, control) +## +function [x,v,nev,varargout] = minimize (f,args,varargin) + +## Oldies +## +## 'df' , df : Name of a function that returns the derivatives of f +## in x : dfx = feval (df, x) where dfx is 1x(M*N). A +## variable metric method (see bfgs) will be used. +## +## 'jac' : Use [fx, dfx] = leval(f, args) to compute derivatives +## and use a variable metric method (bfgs). +## + + +# #################################################################### +# Read the options ################################################### +# #################################################################### +# Options with a value +op1 = "ftol utol dtol df d2f d2i order narg maxev isz"; +# Boolean options +op0 = "verbose backend jac hess ihess ndiff" ; + +default = struct ("backend",0,"verbose",0,\ + "df","", "df", "","d2f","","d2i","", \ + "hess", 0, "ihess", 0, "jac", 0,"ndiff", 0, \ + "ftol" ,nan, "utol",nan, "dtol", nan,\ + "order",nan, "narg",nan, "maxev",nan,\ + "isz", nan); + +if nargin == 3 # Accomodation to struct and list optional + va_arg_cnt = 1; # args + tmp = nth (varargin, va_arg_cnt++); + + if isstruct (tmp) + opls = list (); + for [v,k] = tmp # Treat separately unary and binary opts + if findstr ([" ",k," "],op0) + opls = append (opls, k); + else + opls = append (opls, k, v); + end + end + elseif is_list (tmp) + opls = tmp; + else + opls = list (tmp); + end +else + opls = varargin; +end +ops = read_options (opls,\ + "op0",op0, "op1",op1, "default",default); + +backend=ops.backend; verbose=ops.verbose; +df=ops.df; d2f=ops.d2f; d2i=ops.d2i; +hess=ops.hess; ihess=ops.ihess; jac=ops.jac; +ftol=ops.ftol; utol=ops.utol; dtol=ops.dtol; +order=ops.order; narg=ops.narg; maxev=ops.maxev; +isz=ops.isz; ndiff=ops.ndiff; + +if length (df), error ("Option 'df' doesn't exist any more. Sorry.\n");end +if jac, error ("Option 'jac' doesn't exist any more. Sorry.\n");end + + # Basic coherence checks ############# + +ws = ""; # Warning string +es = ""; # Error string + + # Warn if more than 1 differential is given +if !!length (df) + !!length (d2f) + !!length (d2i) + jac + hess + ihess + \ + ndiff > 1 + # Order of preference of + if length (d2i), ws = [ws,"d2i='",d2i,"', "]; end + if length (d2f), ws = [ws,"d2f='",d2f,"', "]; end + if length (df), ws = [ws,"df='",df,"', "]; end + if hess , ws = [ws,"hess, "]; end + if ihess , ws = [ws,"ihess, "]; end + if jac , ws = [ws,"jac, "]; end + if ndiff , ws = [ws,"ndiff, "]; end + ws = ws(1:length(ws)-2); + ws = ["Options ",ws," were passed. Only one will be used\n"] +end + + # Check that enough args are passed to call + # f(), unless backend is specified, in which + # case I don't need to call f() +if ! isnan (narg) && ! backend + if is_list (args) + if narg > length (args) + es = [es,sprintf("narg=%i > length(args)=%i\n",narg, length(args))]; + end + elseif narg > 1 + es = [es,sprintf("narg=%i, but a single argument was passed\n",narg)]; + end +end + +if length (ws), warn (ws); end +if length (es), error (es); end # EOF Basic coherence checks ######### + + +op = 0; # Set if any option is passed and should be + # passed to backend + +if ! isnan (ftol) , ctls.ftol = ftol; op = 1; end +if ! isnan (utol) , ctls.utol = utol; op = 1; end +if ! isnan (dtol) , ctls.dtol = dtol; op = 1; end +if ! isnan (maxev) , ctls.maxev = maxev; op = 1; end +if ! isnan (narg) , ctls.narg = narg; op = 1; end +if ! isnan (isz) , ctls.isz = isz; op = 1; end +if verbose , ctls.verbose = 1; op = 1; end + + # defaults That are used in this function : +if isnan (narg), narg = 1; end + + # ########################################## + # Choose one optimization method ########### + # Choose according to available derivatives +if ihess, d2f = f; ctls.id2f = 1; op = 1; +elseif hess, d2f = f; +end + + +if length (d2i), method = "d2_min"; ctls.id2f = 1; op = 1; d2f = d2i; +elseif length (d2f), method = "d2_min"; +### elseif length (df) , method = "bfgsmin"; ctls.df = df; op = 1; +### elseif jac , method = "bfgsmin"; ctls.jac = 1 ; op = 1; + ## else method = "nelder_mead_min"; + ## end + # Choose method because ndiff is passed #### +elseif ndiff , method = "bfgsmin"; + + # Choose method by specifying order ######## +elseif ! isnan (order) + + if order == 0, method = "nelder_mead_min"; + elseif order == 1 + method = "bfgsmin"; + + elseif order == 2 + if ! (length (d2f) || length (d2i)) + error ("minimize(): 'order' is 2, but 2nd differential is missing\n"); + end + else + error ("minimize(): 'order' option only implemented for order<=2\n"); + end +else # Default is nelder_mead_min + method = "nelder_mead_min"; +end # EOF choose method ######################## + +if verbose + printf ("minimize(): Using '%s' as back-end\n",method); +end + + # More checks ############################## +ws = ""; +if !isnan (isz) && strcmp (method,"d2_min") + ws = [ws,"option 'isz' is passed to method that doesn't use it"]; +end +if length (ws), warn (ws); end + # EOF More checks ########################## + +if strcmp (method, "d2_min"), all_args = list (f, d2f, args); +elseif strcmp (method, "bfgsmin"),all_args = list (f, args); +else all_args = list (f, args); +end + # Eventually add ctls to argument list +if op, all_args = append (all_args, list (ctls)); end + +if ! backend # Call the backend ################### + if strcmp (method, "d2_min"), + [x,v,nev,h] = leval (method, all_args); + # Eventually return inverse of Hessian + if nargout > 3, vr_val_cnt = 1; varargout{vr_val_cnt++} = h; end + elseif strcmp (method, "bfgsmin") + nev = nan; + if is_list (args),tmp={};for i=1:length(args),tmp{i}=nth(args,i);end;args=tmp;end + if !iscell(args), args = {args}; end + if isnan (ftol), ftol = 1e-12; end # Use bfgsmin's defaults + if isnan (utol), utol = 1e-6; end + if isnan (dtol), dtol = 1e-5; end + if isnan (maxev), maxev = inf; end + [x, v, okcv] = bfgsmin (f, args, {maxev,verbose,1,narg},{ftol,utol,dtol}); + else + [x,v,nev] = leval (method, all_args); + end + +else # Don't call backend, just return its name + # and arguments. + + x = method; + if op, v = ctls; else v = []; end +end + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/nelder_mead_min.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,347 @@ +## Copyright (C) 2002 Etienne Grossmann. All rights reserved. +## +## This program 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. +## +## This 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. +## +## Changelog: +## 2002 / 05 / 09 : Default is no restart next to solution + +## [x0,v,nev] = nelder_mead_min (f,args,ctl) - Nelder-Mead minimization +## +## Minimize 'f' using the Nelder-Mead algorithm. This function is inspired +## from the that found in the book "Numerical Recipes". +## +## ARGUMENTS +## --------- +## f : string : Name of function. Must return a real value +## args : list : Arguments passed to f. +## or matrix : f's only argument +## ctl : vector : (Optional) Control variables, described below +## or struct +## +## RETURNED VALUES +## --------------- +## x0 : matrix : Local minimum of f +## v : real : Value of f in x0 +## nev : number : Number of function evaluations +## +## CONTROL VARIABLE : (optional) may be named arguments (i.e. "name",value +## ------------------ pairs), a struct, or a vector of length <= 6, where +## NaN's are ignored. Default values are written <value>. +## OPT. VECTOR +## NAME POS +## ftol,f N/A : Stopping criterion : stop search when values at simplex +## vertices are all alike, as tested by +## +## f > (max_i (f_i) - min_i (f_i)) /max(max(|f_i|),1) +## +## where f_i are the values of f at the vertices. <10*eps> +## +## rtol,r N/A : Stop search when biggest radius of simplex, using +## infinity-norm, is small, as tested by : +## +## ctl(2) > Radius <10*eps> +## +## vtol,v N/A : Stop search when volume of simplex is small, tested by +## +## ctl(2) > Vol +## +## crit,c ctl(1) : Set one stopping criterion, 'ftol' (c=1), 'rtol' (c=2) +## or 'vtol' (c=3) to the value of the 'tol' option. <1> +## +## tol, t ctl(2) : Threshold in termination test chosen by 'crit' <10*eps> +## +## narg ctl(3) : Position of the minimized argument in args <1> +## maxev ctl(4) : Maximum number of function evaluations. This number <inf> +## may be slightly exceeded. +## isz ctl(5) : Size of initial simplex, which is : <1> +## +## { x + e_i | i in 0..N } +## +## Where x == nth (args, narg) is the initial value +## e_0 == zeros (size (x)), +## e_i(j) == 0 if j != i and e_i(i) == ctl(5) +## e_i has same size as x +## +## Set ctl(5) to the distance you expect between the starting +## point and the minimum. +## +## rst ctl(6) : When a minimum is found the algorithm restarts next to +## it until the minimum does not improve anymore. ctl(6) is +## the maximum number of restarts. Set ctl(6) to zero if +## you know the function is well-behaved or if you don't +## mind not getting a true minimum. <0> +## +## verbose, v Be more or less verbose (quiet=0) <0> +function [x,v,nev] = nelder_mead_min (f, args, varargin) + +## Author : Etienne Grossmann <etienne@cs.uky.edu> + + +verbose = 0; + + # Default control variables +ftol = rtol = 10*eps; # Stop either by likeness of values or +vtol = nan; # radius, but don't care about volume. +crit = 0; # Stopping criterion ctl(1) +tol = 10*eps; # Stopping test's threshold ctl(2) +narg = 1; # Position of minimized arg ctl(3) +maxev = inf; # Max num of func evaluations ctl(4) +isz = 1; # Initial size ctl(5) +rst = 0; # Max # of restarts + + +if nargin >= 3, # Read control arguments + va_arg_cnt = 1; + if nargin > 3, ctl = struct (varargin{:}); else ctl = nth (varargin, va_arg_cnt++); end + if isnumeric (ctl) + if length (ctl)>=1 && !isnan (ctl(1)), crit = ctl(1); end + if length (ctl)>=2 && !isnan (ctl(2)), tol = ctl(2); end + if length (ctl)>=3 && !isnan (ctl(3)), narg = ctl(3); end + if length (ctl)>=4 && !isnan (ctl(4)), maxev = ctl(4); end + if length (ctl)>=5 && !isnan (ctl(5)), isz = ctl(5); end + if length (ctl)>=6 && !isnan (ctl(6)), rst = ctl(6); end + else + if struct_contains (ctl, "crit") && ! isnan (ctl.crit ), crit = ctl.crit ; end + if struct_contains (ctl, "tol") && ! isnan (ctl.tol ), tol = ctl.tol ; end + if struct_contains (ctl, "ftol") && ! isnan (ctl.ftol ), ftol = ctl.ftol ; end + if struct_contains (ctl, "rtol") && ! isnan (ctl.rtol ), rtol = ctl.rtol ; end + if struct_contains (ctl, "vtol") && ! isnan (ctl.vtol ), vtol = ctl.vtol ; end + if struct_contains (ctl, "narg") && ! isnan (ctl.narg ), narg = ctl.narg ; end + if struct_contains (ctl,"maxev") && ! isnan (ctl.maxev), maxev = ctl.maxev; end + if struct_contains (ctl, "isz") && ! isnan (ctl.isz ), isz = ctl.isz ; end + if struct_contains (ctl, "rst") && ! isnan (ctl.rst ), rst = ctl.rst ; end + if struct_contains(ctl,"verbose")&& !isnan(ctl.verbose),verbose=ctl.verbose;end + end +end + + +if crit == 1, ftol = tol; +elseif crit == 2, rtol = tol; +elseif crit == 3, vtol = tol; +elseif crit, error ("crit is %i. Should be 1,2 or 3.\n"); +end + +if is_list (args), # List of arguments + x = nth (args, narg); +else # Single argument + x = args; + args = list (args); +end +## args + +if narg > length (args) # Check + error ("nelder_mead_min : narg==%i, length (args)==%i\n", + narg, length (args)); +end + +[R,C] = size (x); +N = R*C; # Size of argument +x = x(:); + # Initial simplex +u = isz * eye (N+1,N) + ones(N+1,1)*x'; + + +for i = 1:N+1, + y(i) = leval (f, splice (args, narg, 1, list (reshape (u(i,:),R,C)))); +end ; +nev = N+1; + +[ymin,imin] = min(y); +ymin0 = ymin; +## y +nextprint = 0 ; +v = nan; +while nev <= maxev, + + ## ymin, ymax, ymx2 : lowest, highest and 2nd highest function values + ## imin, imax, imx2 : indices of vertices with these values + [ymin,imin] = min(y); [ymax,imax] = max(y) ; + y(imax) = ymin ; + [ymx2,imx2] = max(y) ; + y(imax) = ymax ; + + ## ymin may be > ymin0 after restarting + ## if ymin > ymin0 , + ## "nelder-mead : Whoa 'downsimplex' Should be renamed 'upsimplex'" + ## keyboard + ## end + + # Compute stopping criterion + done = 0; + if ! isnan (ftol), done |= (max(y)-min(y)) / max(1,max(abs(y))) < ftol;end + if ! isnan (rtol), done |= 2*max (max (u) - min (u)) < rtol; end + if ! isnan (vtol) + done |= abs (det (u(1:N,:)-ones(N,1)*u(N+1,:)))/factorial(N) < vtol; + end + ## [ 2*max (max (u) - min (u)), abs (det (u(1:N,:)-ones(N,1)*u(N+1,:)))/factorial(N);\ + ## rtol, vtol] + + # Eventually print some info + if verbose && nev > nextprint && ! done + + printf("nev=%-5d imin=%-3d ymin=%-8.3g done=%i\n",\ + nev,imin,ymin,done) ; + + nextprint = nextprint + 100 ; + end + + if done # Termination test + if (rst > 0) && (isnan (v) || v > ymin) + rst--; + if verbose + if isnan (v), + printf ("Restarting next to minimum %10.3e\n",ymin); + else + printf ("Restarting next to minimum %10.3e\n",ymin-v); + end + end + # Keep best minimum + x = reshape (u(imin,:), R, C) ; + v = ymin ; + + jumplen = 10 * max (max (u) - min (u)); + + u += jumplen * randn (size (u)); + for i = 1:N+1, y(i) = \ + leval (f, splice (args, narg, 1, list (reshape (u(i,:),R,C)))); + end + nev += N+1; + [ymin,imin] = min(y); [ymax,imax] = max(y); + y(imax) = ymin; + [ymx2,imx2] = max(y); + y(imax) = ymax ; + else + if isnan (v), + x = reshape (u(imin,:), R, C) ; + v = ymin ; + end + if verbose, + printf("nev=%-5d imin=%-3d ymin=%-8.3g done=%i. Done\n",\ + nev,imin,ymin,done) ; + end + return + end + + end + ## [ y' u ] + + tra = 0 ; # 'trace' debug var contains flags + if verbose > 1, str = sprintf (" %i : %10.3e --",done,ymin); end + + # Look for a new point + xsum = sum(u) ; # Consider reflection of worst vertice + # around centroid. + ## f1 = (1-(-1))/N = 2/N; + ## f2 = f1 - (-1) = 2/N + 1 = (N+2)/N + xnew = (2*xsum - (N+2)*u(imax,:)) / N; + ## xnew = (2*xsum - N*u(imax,:)) / N; + ynew = leval (f, splice (args, narg, 1, list ( reshape (xnew, R,C)))); + nev++; + + if ynew <= ymin , # Reflection is good + + tra += 1 ; + if verbose > 1 + str = [str,sprintf(" %3i : %10.3e good refl >>",nev,ynew-ymin)]; + end + y(imax) = ynew; u(imax,:) = xnew ; + ## ymin = ynew; + ## imin = imax; + xsum = sum(u) ; + + ## f1 = (1-2)/N = -1/N + ## f2 = f1 - 2 = -1/N - 2 = -(2*N+1)/N + xnew = ( -xsum + (2*N+1)*u(imax,:) ) / N; + ynew = leval (f, splice (args, narg, 1, list ( reshape (xnew, R,C)))); + nev++; + + if ynew <= ymin , # expansion improves + tra += 2 ; + ## 'expanded reflection' + y(imax) = ynew ; u(imax,:) = xnew ; + xsum = sum(u) ; + if verbose > 1 + str = [str,sprintf(" %3i : %10.3e expd refl",nev,ynew-ymin)]; + end + else + tra += 4 ; + ## 'plain reflection' + ## Updating of y and u has already been done + if verbose > 1 + str = [str,sprintf(" %3i : %10.3e plain ref",nev,ynew-ymin)]; + end + end + # Reflexion is really bad + elseif ynew >= ymax , + + tra += 8 ; + if verbose > 1 + str = [str,sprintf(" %3i : %10.3e intermedt >>",nev,ynew-ymin)]; + end + ## look for intermediate point + # Bring worst point closer to centroid + ## f1 = (1-0.5)/N = 0.5/N + ## f2 = f1 - 0.5 = 0.5*(1 - N)/N + xnew = 0.5*(xsum + (N-1)*u(imax,:)) / N; + ynew = leval (f, splice (args, narg, 1, list (reshape (xnew, R,C)))); + nev++; + + if ynew >= ymax , # New point is even worse. Contract whole + # simplex + + nev += N + 1 ; + ## u0 = u; + u = (u + ones(N+1,1)*u(imin,:)) / 2; + ## keyboard + + ## Code that doesn't care about value of empty_list_elements_ok + if imin == 1 , ii = 2:N+1; + elseif imin == N+1, ii = 1:N; + else ii = [1:imin-1,imin+1:N+1]; end + for i = ii + y(i) = \ + leval (f, splice (args, narg, 1, list (reshape (u(i,:),R,C)))); + end + ## 'contraction' + tra += 16 ; + if verbose > 1 + str = [str,sprintf(" %3i contractn",nev)]; + end + else # Replace highest point + y(imax) = ynew ; u(imax,:) = xnew ; + xsum = sum(u) ; + ## 'intermediate' + tra += 32 ; + if verbose > 1 + str = [str,sprintf(" %3i : %10.3e intermedt",nev,ynew-ymin)]; + end + end + + else # Reflexion is neither good nor bad + y(imax) = ynew ; u(imax,:) = xnew ; + xsum = sum(u) ; + ## 'plain reflection (2)' + tra += 64 ; + if verbose > 1 + str = [str,sprintf(" %3i : %10.3e keep refl",nev,ynew-ymin)]; + end + end + if verbose > 1, printf ("%s\n",str); end +end + +if verbose >= 0 + printf ("nelder_mead : Too many iterations. Returning\n"); +end + +if isnan (v) || v > ymin, + x = reshape (u(imin,:), R, C) ; + v = ymin ; +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/nmsmax.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,198 @@ +function [x, fmax, nf] = nmsmax(fun, x, stopit, savit, varargin) +%NMSMAX Nelder-Mead simplex method for direct search optimization. +% [x, fmax, nf] = NMSMAX(FUN, x0, STOPIT, SAVIT) attempts to +% maximize the function FUN, using the starting vector x0. +% The Nelder-Mead direct search method is used. +% Output arguments: +% x = vector yielding largest function value found, +% fmax = function value at x, +% nf = number of function evaluations. +% The iteration is terminated when either +% - the relative size of the simplex is <= STOPIT(1) +% (default 1e-3), +% - STOPIT(2) function evaluations have been performed +% (default inf, i.e., no limit), or +% - a function value equals or exceeds STOPIT(3) +% (default inf, i.e., no test on function values). +% The form of the initial simplex is determined by STOPIT(4): +% STOPIT(4) = 0: regular simplex (sides of equal length, the default) +% STOPIT(4) = 1: right-angled simplex. +% Progress of the iteration is not shown if STOPIT(5) = 0 (default 1). +% STOPIT(6) indicates the direction (ie. minimization or +% maximization.) Default is 1, maximization. +% set STOPIT(6)=-1 for minimization +% If a non-empty fourth parameter string SAVIT is present, then +% `SAVE SAVIT x fmax nf' is executed after each inner iteration. +% NB: x0 can be a matrix. In the output argument, in SAVIT saves, +% and in function calls, x has the same shape as x0. +% NMSMAX(fun, x0, STOPIT, SAVIT, P1, P2,...) allows additional +% arguments to be passed to fun, via feval(fun,x,P1,P2,...). + +% From Matrix Toolbox +% Copyright (C) 2002 N.J.Higham +% www.maths.man.ac.uk/~higham/mctoolbox +% distributed under the terms of the GNU General Public License +% +% Modifications for octave by A.Adler 2003 +% $Id$ + +% References: +% N. J. Higham, Optimization by direct search in matrix computations, +% SIAM J. Matrix Anal. Appl, 14(2): 317-333, 1993. +% C. T. Kelley, Iterative Methods for Optimization, Society for Industrial +% and Applied Mathematics, Philadelphia, PA, 1999. + +x0 = x(:); % Work with column vector internally. +n = length(x0); + +% Set up convergence parameters etc. +if nargin < 3 | isempty(stopit), stopit(1) = 1e-3; end +tol = stopit(1); % Tolerance for cgce test based on relative size of simplex. +if length(stopit) == 1, stopit(2) = inf; end % Max no. of f-evaluations. +if length(stopit) == 2, stopit(3) = inf; end % Default target for f-values. +if length(stopit) == 3, stopit(4) = 0; end % Default initial simplex. +if length(stopit) == 4, stopit(5) = 1; end % Default: show progress. +trace = stopit(5); +if length(stopit) == 5, stopit(6) = 1; end % Default: maximize +dirn= stopit(6); +if nargin < 4, savit = []; end % File name for snapshots. + +V = [zeros(n,1) eye(n)]; +f = zeros(n+1,1); +V(:,1) = x0; +f(1) = dirn*feval(fun,x,varargin{:}); +fmax_old = f(1); + +if trace, fprintf('f(x0) = %9.4e\n', f(1)), end + +k = 0; m = 0; + +% Set up initial simplex. +scale = max(norm(x0,inf),1); +if stopit(4) == 0 + % Regular simplex - all edges have same length. + % Generated from construction given in reference [18, pp. 80-81] of [1]. + alpha = scale / (n*sqrt(2)) * [ sqrt(n+1)-1+n sqrt(n+1)-1 ]; + V(:,2:n+1) = (x0 + alpha(2)*ones(n,1)) * ones(1,n); + for j=2:n+1 + V(j-1,j) = x0(j-1) + alpha(1); + x(:) = V(:,j); + f(j) = dirn*feval(fun,x,varargin{:}); + end +else + % Right-angled simplex based on co-ordinate axes. + alpha = scale*ones(n+1,1); + for j=2:n+1 + V(:,j) = x0 + alpha(j)*V(:,j); + x(:) = V(:,j); + f(j) = dirn*feval(fun,x,varargin{:}); + end +end +nf = n+1; +how = 'initial '; + +[temp,j] = sort(f); +j = j(n+1:-1:1); +f = f(j); V = V(:,j); + +alpha = 1; beta = 1/2; gamma = 2; + +while 1 %%%%%% Outer (and only) loop. +k = k+1; + + fmax = f(1); + if fmax > fmax_old + if ~isempty(savit) + x(:) = V(:,1); eval(['save ' savit ' x fmax nf']) + end + end + if trace + fprintf('Iter. %2.0f,', k) + fprintf([' how = ' how ' ']); + fprintf('nf = %3.0f, f = %9.4e (%2.1f%%)\n', nf, fmax, ... + 100*(fmax-fmax_old)/(abs(fmax_old)+eps)) + end + fmax_old = fmax; + + %%% Three stopping tests from MDSMAX.M + + % Stopping Test 1 - f reached target value? + if fmax >= stopit(3) + msg = ['Exceeded target...quitting\n']; + break % Quit. + end + + % Stopping Test 2 - too many f-evals? + if nf >= stopit(2) + msg = ['Max no. of function evaluations exceeded...quitting\n']; + break % Quit. + end + + % Stopping Test 3 - converged? This is test (4.3) in [1]. + v1 = V(:,1); + size_simplex = norm(V(:,2:n+1)-v1(:,ones(1,n)),1) / max(1, norm(v1,1)); + if size_simplex <= tol + msg = sprintf('Simplex size %9.4e <= %9.4e...quitting\n', ... + size_simplex, tol); + break % Quit. + end + + % One step of the Nelder-Mead simplex algorithm + % NJH: Altered function calls and changed CNT to NF. + % Changed each `fr < f(1)' type test to `>' for maximization + % and re-ordered function values after sort. + + vbar = (sum(V(:,1:n)')/n)'; % Mean value + vr = (1 + alpha)*vbar - alpha*V(:,n+1); + x(:) = vr; + fr = dirn*feval(fun,x,varargin{:}); + nf = nf + 1; + vk = vr; fk = fr; how = 'reflect, '; + if fr > f(n) + if fr > f(1) + ve = gamma*vr + (1-gamma)*vbar; + x(:) = ve; + fe = dirn*feval(fun,x,varargin{:}); + nf = nf + 1; + if fe > f(1) + vk = ve; fk = fe; + how = 'expand, '; + end + end + else + vt = V(:,n+1); ft = f(n+1); + if fr > ft + vt = vr; ft = fr; + end + vc = beta*vt + (1-beta)*vbar; + x(:) = vc; + fc = dirn*feval(fun,x,varargin{:}); + nf = nf + 1; + if fc > f(n) + vk = vc; fk = fc; + how = 'contract,'; + else + for j = 2:n + V(:,j) = (V(:,1) + V(:,j))/2; + x(:) = V(:,j); + f(j) = dirn*feval(fun,x,varargin{:}); + end + nf = nf + n-1; + vk = (V(:,1) + V(:,n+1))/2; + x(:) = vk; + fk = dirn*feval(fun,x,varargin{:}); + nf = nf + 1; + how = 'shrink, '; + end + end + V(:,n+1) = vk; + f(n+1) = fk; + [temp,j] = sort(f); + j = j(n+1:-1:1); + f = f(j); V = V(:,j); + +end %%%%%% End of outer (and only) loop. + +% Finished. +if trace, fprintf(msg), end +x(:) = V(:,1);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/nrm.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,41 @@ +## Copyright (C) 2000 Ben Sapp. All rights reserved. +## +## This program 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. +## +## This 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. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{xmin} =} nrm(@var{f},@var{x0}) +## Using @var{x0} as a starting point find a minimum of the scalar +## function @var{f}. The Newton-Raphson method is used. +## @end deftypefn + +## Author: Ben Sapp <bsapp@lanl.gov> +## Reference: David G Luenberger's Linear and Nonlinear Programming + +## 2002-01-28 Paul Kienzle +## * save two function evaluations by inlining the derivatives +## * pass through varargin{:} to the function +## 2002-03-13 Paul Kienzle +## * simplify update expression + +function x = nrm(f,x,varargin) + velocity = 1; + acceleration = 1; + + h = 0.01; + while(abs(velocity) > 0.0001) + fx = feval(f,x,varargin{:}); + fxph = feval(f,x+h,varargin{:}); + fxmh = feval(f,x-h,varargin{:}); + velocity = (fxph - fxmh)/(2*h); + acceleration = (fxph - 2*fx + fxmh)/(h^2); + x = x - velocity/abs(acceleration); + endwhile +endfunction
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/optimset.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,64 @@ +## Copyright (C) 2002 Etienne Grossmann. All rights reserved. +## +## This program 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. +## +## This 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. + +## opt = optimset (...) - manipulate m*tlab-style options structure +## +## This function returns a m*tlab-style options structure that can be used +## with the fminunc() function. +## +## INPUT : Input consist in one or more structs followed by option-value +## pairs. The option that can be passed are those of m*tlab's 'optimset'. +## Whether fminunc() accepts them is another question (see fminunc()). +## +## Two extra options are supported which indicate how to use directly octave +## optimization tools (such as minimize() and other backends): +## +## "MinEquiv", [on|off] : Tell 'fminunc()' not to minimize 'fun', but +## instead return the option passed to minimize(). +## +## "Backend", [on|off] : Tell 'fminunc()' not to minimize 'fun', but +## instead return the [backend, opt], the name of the +## backend optimization function that is used and the +## optional arguments that will be passed to it. See +## the 'backend' option of minimize(). +## +function opt = optimset (varargin) + +## Diagnostics , ["on"|{"off"}] : +## DiffMaxChange, [scalar>0] : N/A (I don't know what it does) +## DiffMinChange, [scalar>0] : N/A (I don't know what it does) +## Display , ["off","iter","notify","final"] +## : N/A + +args = varargin; + +opt = struct (); + + # Integrate all leading structs + +while length (args) && isstruct (o = nth (args, 1)) + + args = args(2:length(args)); # Remove 1st element of args + # Add key/value pairs + for [v,k] = o, opt = setfield (opt,k,v); end +end + +## All the option +op1 = [" DerivativeCheck Diagnostics DiffMaxChange DiffMinChange",\ + " Display GoalsExactAchieve GradConstr GradObj Hessian HessMult",\ + " HessPattern HessUpdate Jacobian JacobMult JacobPattern",\ + " LargeScale LevenbergMarquardt LineSearchType MaxFunEvals MaxIter",\ + " MaxPCGIter MeritFunction MinAbsMax PrecondBandWidth TolCon",\ + " TolFun TolPCG TolX TypicalX ",\ + " MinEquiv Backend "]; + +opt = read_options (args, "op1",op1, "default",opt,"prefix",1,"nocase",1);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/poly_2_ex.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,51 @@ +## Copyright (C) 2002 Etienne Grossmann. All rights reserved. +## +## This program 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. +## +## This 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. + +## ex = poly_2_ex (l, f) - Extremum of a 1-var deg-2 polynomial +## +## l : 3 : Values of variable at which polynomial is known. +## f : 3 : f(i) = Value of the degree-2 polynomial at l(i). +## +## ex : 1 : Value for which f reaches its extremum +## +## Assuming that f(i) = a*l(i)^2 + b*l(i) + c = P(l(i)) for some a, b, c, +## ex is the extremum of the polynome P. +## +function ex = poly_2_ex (l, f) + + +### This somewhat helps if solution is very close to one of the points. +[f,i] = sort (f); +l = l(i); + + +m = (l(2) - l(1))/(l(3) - l(1)); +d = (2*(f(1)*(m-1)+f(2)-f(3)*m)); +if abs (d) < eps, + printf ("poly_2_ex : divisor is small (solution at infinity)\n"); + printf ("%8.3e %8.3e %8.3e, %8.3e %8.3e\n",\ + f(1), diff (f), diff (sort (l))); + + ex = (2*(l(1)>l(2))-1)*inf; + ## keyboard +else + ex = ((l(3) - l(1))*((f(1)*(m^2-1) + f(2) - f(3)*m^2))) / d ; + +## Not an improvement +# n = ((l(2)+l(3))*(l(2)-l(3)) + 2*(l(3)-l(2))*l(1)) / (l(3)-l(1))^2 ; +# ex = ((l(3) - l(1))*((f(1)*n + f(2) - f(3)*m^2))) / \ +# (2*(f(1)*(m-1)+f(2)-f(3)*m)); +# if ex != ex0, +# ex - ex0 +# end + ex = l(1) + ex; +end \ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/polyconf.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,138 @@ +## [y,dy] = polyconf(p,x,s) +## +## Produce prediction intervals for the fitted y. The vector p +## and structure s are returned from polyfit or wpolyfit. The +## x values are where you want to compute the prediction interval. +## +## polyconf(...,['ci'|'pi']) +## +## Produce a confidence interval (range of likely values for the +## mean at x) or a prediction interval (range of likely values +## seen when measuring at x). The prediction interval tells +## you the width of the distribution at x. This should be the same +## regardless of the number of measurements you have for the value +## at x. The confidence interval tells you how well you know the +## mean at x. It should get smaller as you increase the number of +## measurements. Error bars in the physical sciences usually show +## a 1-alpha confidence value of erfc(1/sqrt(2)), representing +## one standandard deviation of uncertainty in the mean. +## +## polyconf(...,1-alpha) +## +## Control the width of the interval. If asking for the prediction +## interval 'pi', the default is .05 for the 95% prediction interval. +## If asking for the confidence interval 'ci', the default is +## erfc(1/sqrt(2)) for a one standard deviation confidence interval. +## +## Example: +## [p,s] = polyfit(x,y,1); +## xf = linspace(x(1),x(end),150); +## [yf,dyf] = polyconf(p,xf,s,'ci'); +## plot(xf,yf,'g-;fit;',xf,yf+dyf,'g.;;',xf,yf-dyf,'g.;;',x,y,'xr;data;'); +## plot(x,y-polyval(p,x),';residuals;',xf,dyf,'g-;;',xf,-dyf,'g-;;'); + +## Author: Paul Kienzle +## This program is granted to the public domain. +function [y,dy] = polyconf(p,x,varargin) + alpha = s = []; + typestr = 'pi'; + for i=1:length(varargin) + v = varargin{i}; + if isstruct(v), s = v; + elseif ischar(v), typestr = v; + elseif isscalar(v), alpha = v; + else s = []; + end + end + if (nargout>1 && (isempty(s)||nargin<3)) || nargin < 2 + usage("[y,dy] = polyconf(p,x,s,alpha,['ci'|'pi'])"); + end + + if isempty(s) + y = polyval(p,x); + + else + ## For a polynomial fit, x is the set of powers ( x^n ; ... ; 1 ). + n=length(p)-1; + k=length(x(:)); + if columns(s.R) == n, ## fit through origin + A = (x(:) * ones (1, n)) .^ (ones (k, 1) * (n:-1:1)); + p = p(1:n); + else + A = (x(:) * ones (1, n+1)) .^ (ones (k, 1) * (n:-1:0)); + endif + y = dy = x; + [y(:),dy(:)] = confidence(A,p,s,alpha,typestr); + + end +end + +%!test +%! # data from Hocking, RR, "Methods and Applications of Linear Models" +%! temperature=[40;40;40;45;45;45;50;50;50;55;55;55;60;60;60;65;65;65]; +%! strength=[66.3;64.84;64.36;69.70;66.26;72.06;73.23;71.4;68.85;75.78;72.57;76.64;78.87;77.37;75.94;78.82;77.13;77.09]; +%! [p,s] = polyfit(temperature,strength,1); +%! [y,dy] = polyconf(p,40,s,0.05,'ci'); +%! assert([y,dy],[66.15396825396826,1.71702862681486],200*eps); +%! [y,dy] = polyconf(p,40,s,0.05,'pi'); +%! assert(dy,4.45345484470743,200*eps); + +## [y,dy] = confidence(A,p,s) +## +## Produce prediction intervals for the fitted y. The vector p +## and structure s are returned from wsolve. The matrix A is +## the set of observation values at which to evaluate the +## confidence interval. +## +## confidence(...,['ci'|'pi']) +## +## Produce a confidence interval (range of likely values for the +## mean at x) or a prediction interval (range of likely values +## seen when measuring at x). The prediction interval tells +## you the width of the distribution at x. This should be the same +## regardless of the number of measurements you have for the value +## at x. The confidence interval tells you how well you know the +## mean at x. It should get smaller as you increase the number of +## measurements. Error bars in the physical sciences usually show +## a 1-alpha confidence value of erfc(1/sqrt(2)), representing +## one standandard deviation of uncertainty in the mean. +## +## confidence(...,1-alpha) +## +## Control the width of the interval. If asking for the prediction +## interval 'pi', the default is .05 for the 95% prediction interval. +## If asking for the confidence interval 'ci', the default is +## erfc(1/sqrt(2)) for a one standard deviation confidence interval. +## +## Confidence intervals for linear system are given by: +## x' p +/- sqrt( Finv(1-a,1,df) var(x' p) ) +## where for confidence intervals, +## var(x' p) = sigma^2 (x' inv(A'A) x) +## and for prediction intervals, +## var(x' p) = sigma^2 (1 + x' inv(A'A) x) +## +## Rather than A'A we have R from the QR decomposition of A, but +## R'R equals A'A. Note that R is not upper triangular since we +## have already multiplied it by the permutation matrix, but it +## is invertible. Rather than forming the product R'R which is +## ill-conditioned, we can rewrite x' inv(A'A) x as the equivalent +## x' inv(R) inv(R') x = t t', for t = x' inv(R) +## Since x is a vector, t t' is the inner product sumsq(t). +## Note that LAPACK allows us to do this simultaneously for many +## different x using sqrt(sumsq(X/R,2)), with each x on a different row. +## +## Note: sqrt(F(1-a;1,df)) = T(1-a/2;df) +## +## For non-linear systems, use x = dy/dp and ignore the y output. +function [y,dy] = confidence(A,p,S,alpha,typestr) + if nargin < 4, alpha = []; end + if nargin < 5, typestr = 'ci'; end + y = A*p(:); + switch typestr, + case 'ci', pred = 0; default_alpha=erfc(1/sqrt(2)); + case 'pi', pred = 1; default_alpha=0.05; + otherwise, error("use 'ci' or 'pi' for interval type"); + end + if isempty(alpha), alpha = default_alpha; end + s = t_inv(1-alpha/2,S.df)*S.normr/sqrt(S.df); + dy = s*sqrt(pred+sumsq(A/S.R,2));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/rosenbrock.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,31 @@ +# Copyright (C) 2004 Michael Creel <michael.creel@uab.es> +# +# This program 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 of the License, or +# (at your option) any later version. +# +# This program 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 this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +# Rosenbrock function - used to create example obj. fns. +# +# Function value and gradient vector of the rosenbrock function +# The minimizer is at the vector (1,1,..,1), +# and the minimized value is 0. +# +function [obj_value, gradient] = rosenbrock(x); + dimension = length(x); + obj_value = sum(100*(x(2:dimension)-x(1:dimension-1).^2).^2 + (1-x(1:dimension-1)).^2); + if nargout > 1 + gradient = zeros(dimension, 1); + gradient(1:dimension-1) = - 400*x(1:dimension-1).*(x(2:dimension)-x(1:dimension-1).^2) - 2*(1-x(1:dimension-1)); + gradient(2:dimension) = gradient(2:dimension) + 200*(x(2:dimension)-x(1:dimension-1).^2); + endif +endfunction
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/samin_example.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,71 @@ +# Copyright (C) 2004 Michael Creel <michael.creel@uab.es> +# +# This program 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 of the License, or +# (at your option) any later version. +# +# This program 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 this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +# samin_example: example script that contains examples of how to call +# samin for minimization using simulated annealing. +# Edit the script to see how samin may be used. +# +# usage: samin_example + +1; # this is a script file + +# Example objective function +# remember that cos(0)=1, so +# "a" has a local minimum at 0 (each dimension) +# "b" makes the function value 0 at min +# "c" adds some curvature to make the min +# at (0,0,...,0) global. +# the closer is "curvature" to zero the more alike are +# the local mins, so the harder the global min is to find + +function f = obj(theta, curvature); + dim = rows(theta); + a = sum(exp(-cos(theta))); + b = - dim*exp(-1); + c = sum(curvature*theta .^ 2); + f = a + b + c; +endfunction + +k = 5; # dimensionality +theta = rand(k,1)*10 - 5; # random start value + +# if you set "curvature" very small, +# you will need to increase nt, ns, and rt +# to minimize sucessfully +curvature = 0.01; + + +# SA controls +ub = 10*ones(rows(theta),1); +lb = -ub; +nt = 20; +ns = 5; +rt = 0.5; # careful - this is too low for many problems +maxevals = 1e10; +neps = 5; +functol = 1e-10; +paramtol = 1e-3; +verbosity = 1; +minarg = 1; +control = { lb, ub, nt, ns, rt, maxevals, neps, functol, paramtol, verbosity, 1}; + + +# do sa +t=cputime(); +[theta, obj_value, convergence] = samin("obj", {theta, curvature}, control); +t = cputime() - t; +printf("Elapsed time = %f\n\n\n",t); +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/test_d2_min_1.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,183 @@ +## Copyright (C) 2002 Etienne Grossmann. All rights reserved. +## +## This program 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. +## +## This 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. + +## Test whether d2_min() functions correctly +## +## Gives a simple quadratic programming problem (function ff below). +## +## Sets a ok variable to 1 in case of success, 0 in case of failure +## +## If a variables "verbose" is set, then some comments are output. + +## Author: Etienne Grossmann <etienne@cs.uky.edu> + +1 ; + +if ! exist ("verbose"), verbose = 0; end + +if verbose + printf ("\n Testing d2_min () on a quadratic programming problem\n\n"); +end + +P = 10+floor(30*rand(1)) ; # Nparams +R = P+floor(30*rand(1)) ; # Nobses +noise = 0 ; +global obsmat ; +obsmat = randn(R,P) ; +global truep ; +truep = randn(P,1) ; +xinit = randn(P,1) ; + +global obses ; +obses = obsmat*truep ; +if noise, obses = adnois(obses,noise); end + + + +function v = ff(x) + global obsmat; + global obses; + v = msq (obses - obsmat*x ) ; +endfunction + +function [v,dv,d2v] = d2ff(x) # Return pseudo-inverse + global obsmat; + global obses; + er = -obses + obsmat*x ; + dv = er'*obsmat ; + v = msq(er ) ; + d2v = pinv (obsmat'*obsmat ) ; +endfunction + +function [v,dv,d2v] = d2ff_2(x) # Return 2nd derivs, not pseudo-inv + global obsmat; + global obses; + er = -obses + obsmat*x ; + dv = er'*obsmat ; + v = msq(er ) ; + d2v = obsmat'*obsmat ; +endfunction + +## dt = mytic() +## +## Returns the cputime since last call to 'mytic'. + +function dt = mytic() + static last_mytic = 0 ; + [t,u,s] = cputime() ; + dt = t - last_mytic ; + last_mytic = t ; +endfunction + +## s = msq(x) - Mean squared value, ignoring nans +## +## s == mean(x(:).^2) , but ignores NaN's + + +function s = msq(x) +try + s = mean(x(find(!isnan(x))).^2); +catch + s = nan; +end +endfunction + +cnt = 1; +ok = 1; + +ctl = nan*zeros(1,5); ctl(5) = 1; + +if verbose + printf ("Going to call d2_min\n"); +end +mytic() ; +[xlev,vlev,nev] = d2_min ("ff","d2ff",xinit,ctl); +tlev = mytic() ; + +if verbose, + printf("d2_min should find in one iteration + one more to check\n"); + printf(["d2_min : niter=%-4d nev=%-4d nobs=%-4d,nparams=%-4d\n",... + " time=%-8.3g errx=%-8.3g minv=%-8.3g\n"],... + nev([2,1]),R,P,tlev,max(abs(xlev-truep )),vlev); +end + + + +if nev(2) != 2, + if verbose + printf ("Too many iterations for this function\n"); + end + ok = 0; +else + if verbose + printf ("Ok: single iteration (%i)\n",cnt); + end +end + +if max (abs(xlev-truep )) > sqrt (eps), + if verbose + printf ("Error is too big : %-8.3g\n", max (abs (xlev-truep))); + end + ok = 0; +else + if verbose + printf ("Ok: single error amplitude (%i)\n",cnt); + end +end + +cnt++; + +if verbose + printf ("Going to call d2_min() \n"); +end +mytic() ; +[xlev,vlev,nev] = d2_min("ff","d2ff_2",xinit) ; +tlev = mytic() ; + +if verbose, + printf("d2_min should find in one iteration + one more to check\n"); + printf(["d2_min : niter=%-4d nev=%-4d nobs=%-4d,nparams=%-4d\n",... + " time=%-8.3g errx=%-8.3g minv=%-8.3g\n"],... + nev([2,1]),R,P,tlev,max(abs(xlev-truep )),vlev); +end + + +if nev(2) != 2, + if verbose + printf ("Too many iterations for this function\n"); + end + ok = 0; +else + if verbose + printf ("Ok: single iteration (%i)\n",cnt); + end +end + +if max (abs(xlev-truep )) > sqrt (eps), + if verbose + printf ("Error is too big : %-8.3g\n", max (abs (xlev-truep))); + end + ok = 0; +else + if verbose + printf ("Ok: single error amplitude (%i)\n",cnt); + end +end + +if verbose + if ok + printf ("All tests ok\n"); + else + printf ("Some tests failed\n"); + end +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/test_d2_min_2.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,114 @@ +## Copyright (C) 2002 Etienne Grossmann. All rights reserved. +## +## This program 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. +## +## This 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. + +## Test whether d2_min() functions correctly, with two args +## +## Gives a simple quadratic programming problem (function ff below). +## +## Sets a ok variable to 1 in case of success, 0 in case of failure +## +## If a variables "verbose" is set, then some comments are output. + +## Author: Etienne Grossmann <etienne@cs.uky.edu> + +1 ; + +ok = 0; + +if ! exist ("verbose"), verbose = 0; end + +if verbose + printf ("\n Testing d2_min () on a quadratic programming problem\n\n"); +end + +P = 10+floor(30*rand(1)) ; # Nparams +R = P+floor(30*rand(1)) ; # Nobses +noise = 0 ; +obsmat = randn(R,P) ; +truep = randn(P,1) ; +xinit = randn(P,1) ; + +obses = obsmat*truep ; +if noise, obses = adnois(obses,noise); end + +y.obses = obses; +y.obsmat = obsmat; + +function v = ff (x, y) + v = msq( y.obses - y.obsmat*x ) ; +endfunction + + +function [v,dv,d2v] = d2ff (x, y) + er = -y.obses + y.obsmat*x ; + dv = er'*y.obsmat ; + v = msq( er ) ; + d2v = pinv( y.obsmat'*y.obsmat ) ; +endfunction + +## dt = mytic() +## +## Returns the cputime since last call to 'mytic'. + +function dt = mytic() + static last_mytic = 0 ; + [t,u,s] = cputime() ; + dt = t - last_mytic ; + last_mytic = t ; +endfunction + +## s = msq(x) - Mean squared value, ignoring nans +## +## s == mean(x(:).^2) , but ignores NaN's + + +function s = msq(x) +try + s = mean(x(find(!isnan(x))).^2); +catch + s = nan; +end +endfunction + + +ctl = nan*zeros(1,5); ctl(5) = 1; + +if verbose, printf ( "Going to call d2_min()\n"); end +mytic() ; +[xlev,vlev,nev] = d2_min ("ff", "d2ff", list (xinit,y), ctl) ; +tlev = mytic (); + +if verbose, + printf("d2_min should find in one iteration + one more to check\n"); + printf(["d2_min : niter=%-4d nev=%-4d nobs=%-4d nparams=%-4d\n",\ + " time=%-8.3g errx=%-8.3g minv=%-8.3g\n"],... + nev([2,1]), R, P, tlev, max (abs (xlev-truep)), vlev); +end + +ok = 1; +if nev(2) != 2, + if verbose + printf ( "Too many iterations for this function\n"); + end + ok = 0; +end + +if max (abs(xlev-truep )) > sqrt (eps), + if verbose + printf ( "Error is too big : %-8.3g\n", max (abs (xlev-truep))); + end + ok = 0; +end + +if verbose && ok + printf ( "All tests ok\n"); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/test_d2_min_3.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,102 @@ +## Copyright (C) 2002 Etienne Grossmann. All rights reserved. +## +## This program 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. +## +## This 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. + +## Test whether d2_min() functions correctly +## +## Gives a 2-dim function with strange shape ("ff", defined below). +## +## Sets a ok variable to 1 in case of success, 0 in case of failure +## +## If a variables "verbose" is set, then some comments are output. + +## Author: Etienne Grossmann <etienne@cs.uky.edu> + + +1 ; + +ok = 0; + +if ! exist ("verbose"), verbose = 0; end + +if verbose + printf ("\n Testing d2_min () on a strange 2-dimensional function\n\n"); +end + +P = 2; # Nparams +noise = 0 ; +truep = [0;0] ; +xinit = randn(P,1) ; + +if noise, obses = adnois(obses,noise); end + +y = nan; + + +function v = ff (x, y) + v = x(1)^2 * (1+sin(x(2)*3*pi)^2) + x(2)^2; +endfunction + + +function [w,dv,d2v] = d2ff (x, y) + u = x(1); v = x(2); + w = u^2 * (1+sin(v*3*pi)^2) + v^2; + + dv = [2*u * (1+sin(v*3*pi)^2), u^2 * sin(v*2*3*pi) + 2*v ]; + + d2v = [2*(1+sin(v*3*pi)^2), 2*u * sin(v*2*3*pi) ; + 2*u * sin(v*2*3*pi), u^2 * 2*3*pi* cos(v*2*3*pi) + 2 ]; + d2v = inv (d2v); +endfunction + +## dt = mytic() +## +## Returns the cputime since last call to 'mytic'. + +function dt = mytic() + static last_mytic = 0 ; + [t,u,s] = cputime() ; + dt = t - last_mytic ; + last_mytic = t ; +endfunction + + +ctl = nan*zeros(1,5); ctl(5) = 1; + +if verbose + printf ( "Going to call d2_min\n"); +end +mytic() ; +[xlev,vlev,nev] = d2_min ("ff", "d2ff", list (xinit,y),ctl) ; +tlev = mytic (); + +if verbose, + printf("d2_min should find minv = 0 (plus a little error)\n"); + printf(["d2_min : niter=%-4d nev=%-4d nparams=%-4d\n",... + " time=%-8.3g errx=%-8.3g minv=%-8.3g\n"],... + nev([2,1]), P, tlev, max (abs (xlev-truep)), vlev); +end + +ok = 1; + +if max (abs(xlev-truep )) > sqrt (eps), + if verbose + printf ( "Error is too big : %-8.3g\n", max (abs (xlev-truep))); + end + ok = 0; +end + +if verbose && ok + printf ( "All tests ok\n"); +end + + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/test_fminunc_1.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,142 @@ +## Copyright (C) 2002 Etienne Grossmann. All rights reserved. +## +## This program 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. +## +## This 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. + +## test_fminunc_1 - Test that fminunc and optimset work +## +## A quadratic function is fminuncd. Various options are tested. Options +## are passed incomplete (to see if properly completed) and +## case-insensitive. + +ok = 1; # Remains set if all ok. Set to 0 otherwise +cnt = 0; # Test counter +page_screen_output = 0; +page_output_immediately = 1; +do_fortran_indexing = 1; +warn_fortran_indexing = 0; + +if ! exist ("verbose"), verbose = 0; end + +N = 2; + +x0 = randn(N,1) ; +y0 = randn(N,1) ; + +## Return value +function v = ff(x,y,t) + A = [1 -1;1 1]; M = A'*diag([100,1])*A; + v = ((x - y)(1:2))'*M*((x-y)(1:2)) + 1; +endfunction + + +## Return value, diff and 2nd diff +function [v,dv,d2v] = d2ff(x,y,t) + if nargin < 3, t = 1; end + if t == 1, N = length (x); else N = length (y); end + A = [1 -1;1 1]; M = A'*diag([100,1])*A; + v = ((x - y)(1:2))'*M*((x-y)(1:2)) + 1; + dv = 2*((x-y)(1:2))'*M; + d2v = zeros (N); d2v(1:2,1:2) = 2*M; + if N>2, dv = [dv, zeros(1,N-2)]; end + if t == 2, dv = -dv; end +endfunction + + +## PRint Now +function prn (varargin), printf (varargin{:}); fflush (stdout); end + + +if verbose + prn ("\n Testing that fminunc() works as it should\n\n"); + prn (" Nparams = N = %i\n",N); + fflush (stdout); +end + +## Plain run, just to make sure ###################################### +## Minimum wrt 'x' is y0 +opt = optimset (); +[xlev,vlev] = fminunc ("ff",x0,opt,y0,1); + +cnt++; +if max (abs (xlev-y0)) > 100*sqrt (eps) + if verbose + prn ("Error is too big : %8.3g\n", max (abs (xlev-y0))); + end + ok = 0; +elseif verbose, prn ("ok %i\n",cnt); +end + +## See what 'backend' gives in that last case ######################## +opt = optimset ("backend","on"); +[method,ctl] = fminunc ("ff",x0, opt, y0,1); + +cnt++; +if ! ischar (method) || ! strcmp (method,"nelder_mead_min") + if verbose + if ischar (method) + prn ("Wrong method '%s' != 'nelder_mead_min' was chosen\n", method); + else + prn ("fminunc pretends to use a method that isn't a string\n"); + end + return + end + ok = 0; +elseif verbose, prn ("ok %i\n",cnt); +end + +[xle2,vle2,nle2] = feval (method, "ff",list (x0,y0,1), ctl); +cnt++; + # nelder_mead_min is not very repeatable + # because of restarts from random positions +if max (abs (xlev-xle2)) > 100*sqrt (eps) + if verbose + prn ("Error is too big : %8.3g\n", max (abs (xlev-xle2))); + end + ok = 0; +elseif verbose, prn ("ok %i\n",cnt); +end + + +## Run, w/ differential returned by function ('jac' option) ########## +## Minimum wrt 'x' is y0 + +opt = optimset ("GradO","on"); +[xlev,vlev,nlev] = fminunc ("d2ff",x0,opt,y0,1); + +cnt++; +if max (abs (xlev-y0)) > 100*sqrt (eps) + if verbose + prn ("Error is too big : %8.3g\n", max (abs (xlev-y0))); + end + ok = 0; +elseif verbose, prn ("ok %i\n",cnt); +end + + +## Use the 'hess' option, when f can return 2nd differential ######### +## Minimum wrt 'x' is y0 +opt = optimset ("hessian","on"); +[xlev,vlev,nlev] = fminunc ("d2ff",x0,opt,y0,1); + +cnt++; +if max (abs (xlev-y0)) > 100*sqrt (eps) + if verbose + prn ("Error is too big : %8.3g\n", max (abs (xlev-y0))); + end + ok = 0; +elseif verbose, prn ("ok %i\n",cnt); +end + + +if verbose && ok + prn ( "All tests ok\n"); +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/test_min_1.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,104 @@ +## Copyright (C) 2002 Etienne Grossmann. All rights reserved. +## +## This program 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. +## +## This 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. + + +## +## Test an optimization function with the same synopsis as bfgs.m +## +## modified 2004-05-20 by Michael Creel to adapt to bfgsmin + +if ! exist ("optim_func"), optim_func = "bfgsmin"; end + +ok = 1; + +if ! exist ("verbose"), verbose = 0; end + +if verbose + printf ("\n Testing '%s' on a quadratic programming problem\n\n",\ + optim_func); + printf ([" Set 'optim_func' to the name of the optimization\n",\ + " function you want to test (must have same synopsis\n",\ + " as 'bfgs')\n\n"]); +end + + + +N = 1+floor(30*rand(1)) ; +global truemin ; +truemin = randn(N,1) ; + +global offset ; +offset = 10*randn(1) ; + +global metric ; +metric = randn(2*N,N) ; +metric = metric'*metric ; + +if N>1, + [u,d,v] = svd(metric); + d = (0.1+[0:(1/(N-1)):1]).^2 ; + metric = u*diag(d)*u' ; +end + +function v = testfunc(x) + global offset ; + global truemin ; + global metric ; + v = sum((x-truemin)'*metric*(x-truemin))+offset ; +end + +function df = dtestf(x) + global truemin ; + global metric ; + df = 2*(x-truemin)'*metric ; +end + +xinit = 10*randn(N,1) ; + +if verbose, + printf ([" Dimension is %i\n",\ + " Condition is %f\n"],\ + N, cond (metric)); + fflush (stdout); +end + +## [x,v,niter] = feval (optim_func, "testfunc","dtestf", xinit); +ctl.df = "dtestf"; +if strcmp(optim_func,"bfgsmin") + ctl = {-1,2,1,1}; + xinit2 = {xinit}; +else xinit2 = xinit; +endif +[x,v,niter] = feval (optim_func, "testfunc", xinit2, ctl); + +if verbose + printf ("nev=%d N=%d errx=%8.3g errv=%8.3g\n",\ + niter(1),N,max(abs( x-truemin )),v-offset); +end + +if any (abs (x-truemin) > 1e-4) + ok = 0; + if verbose, printf ("not ok 1 (best argument is wrong)\n"); end +elseif verbose, printf ("ok 1\n"); +end + +if v-offset > 1e-8 + ok = 0; + if verbose, printf ("not ok 2 (best function value is wrong)\n"); end +elseif verbose, printf ("ok 2\n"); +end + +if verbose + if ok, printf ("All tests ok\n"); + else printf ("Whoa!! Some test(s) failed\n"); + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/test_min_2.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,121 @@ +## Copyright (C) 2002 Etienne Grossmann. All rights reserved. +## +## This program 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. +## +## This 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. + +## test_min_2 - Test that bfgs works +## +## Defines some simple functions and verifies that calling +## +## bfgs on them returns the correct minimum. +## +## Sets 'ok' to 1 if success, 0 otherwise + +## The name of the optimizing function +## modified 2004-05-20 by Michael Creel to adapt to bfgsmin +if ! exist ("optim_func"), optim_func = "bfgsmin"; end + +ok = 1; + +if ! exist ("verbose"), verbose = 0; end + +P = 15; +R = 20; # must have R >= P + + +global obsmat ; +## Make test_min_2 reproducible by using fixed obsmat +## obsmat = randn(R,P) ; +obsmat = zeros (R,P); +obsmat(sub2ind([R,P],1:R,1+rem(0:R-1,P))) = 1:R; + +global truep ; + +## Make test_min_2 reproducible by using fixed starting point +## truep = randn(P,1) ; +## xinit = randn(P,1) ; +truep = rem (1:P, P/4)'; +xinit = truep + 2*(1:P)'/(P); + +global obses ; +obses = obsmat*truep ; + + +function v = ff(x) + global obsmat; + global obses; + v = mean ((obses - obsmat*x).^2) + 1 ; +endfunction + + +function dv = dff(x) + global obsmat; + global obses; + er = -obses + obsmat*x ; + dv = 2*er'*obsmat / rows(obses) ; + ## dv = 2*er'*obsmat ; +endfunction + +## dt = mytic() +## +## Returns the cputime since last call to 'mytic'. + +function dt = mytic() + static last_mytic = 0 ; + [t,u,s] = cputime() ; + dt = t - last_mytic ; + last_mytic = t ; +endfunction + + +if verbose + printf ("\n Testing %s on a quadratic problem\n\n", optim_func); + + printf ([" Set 'optim_func' to the name of the optimization\n",\ + " function you want to test (must have same synopsis\n",\ + " as 'bfgs')\n\n"]); + + printf (" Nparams = P = %i, Nobses = R = %i\n",P,R); + fflush (stdout); +end + +ctl.df = "dff"; +ctl.ftol = eps; +ctl.dtol = 1e-7; +mytic() ; +if strcmp(optim_func,"bfgsmin") + ctl = {-1,2,1,1}; + xinit2 = {xinit}; +else xinit2 = xinit; +endif +## [xlev,vlev,nlev] = feval(optim_func, "ff", "dff", xinit) ; +[xlev,vlev,nlev] = feval(optim_func, "ff", xinit2, ctl) ; +tlev = mytic() ; + + +if max (abs(xlev-truep)) > 1e-4, + if verbose + printf ("Error is too big : %8.3g\n", max (abs (xlev-truep))); + end + ok = 0; +elseif verbose, printf ("ok 1\n"); +end + +if verbose, + printf (" Costs : init=%8.3g, final=%8.3g, best=%8.3g\n",\ + ff(xinit), vlev, ff(truep)); +end +if verbose + printf ( " time : %8.3g\n",tlev); +end +if verbose && ok + printf ( "All tests ok (there's just one test)\n"); +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/test_min_3.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,111 @@ +## Copyright (C) 2002 Etienne Grossmann. All rights reserved. +## +## This program 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. +## +## This 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. + + +## ok - Test that bfgs works with extra +## arguments +## +## Defines some simple functions and verifies that calling +## bfgs on them returns the correct minimum. +## +## Sets 'ok' to 1 if success, 0 otherwise + +## The name of the optimizing function +## modified 2004-05-20 by Michael Creel to adapt to bfgsmin +if ! exist ("optim_func"), optim_func = "bfgsmin"; end + +ok = 1; + +if ! exist ("verbose"), verbose = 0; end + +P = 2; +R = 3; + +## Make tests reproducible +## obsmat = randn(R,P) ; +obsmat = zeros (R,P); +obsmat(sub2ind([R,P],1:R,1+rem(0:R-1,P))) = 1:R; + +## Make test_min_2 repeatable by using fixed starting point +## truep = randn(P,1) ; +## xinit = randn(P,1) ; +truep = rem (1:P, P/4)'; +xinit = truep + 2*(1:P)'/(P); + + +## global obses ; +obses = obsmat*truep ; + +extra = list (obsmat, obses); + + +function v = ff(x, obsmat, obses) + v = mean ( (obses - obsmat*x)(:).^2 ) + 1 ; +endfunction + + +function dv = dff(x, obsmat, obses) + er = -obses + obsmat*x ; + dv = 2*er'*obsmat / rows(obses) ; + ## dv = 2*er'*obsmat ; +endfunction + + + +if verbose + printf (" Checking that extra arguments are accepted\n\n"); + + printf ([" Set 'optim_func' to the name of the optimization\n",\ + " function you want to test (must have same synopsis\n",\ + " as 'bfgs')\n\n"]); + + printf (" Tested function : %s\n",optim_func); + printf (" Nparams = P = %i, Nobses = R = %i\n",P,R); + fflush (stdout); +end +function dt = mytic() + static last_mytic = 0 ; + [t,u,s] = cputime() ; + dt = t - last_mytic ; + last_mytic = t ; +endfunction + +ctl.df = "dff"; +mytic() ; +## [xlev,vlev,nlev] = feval (optim_func, "ff", "dff", xinit, "extra", extra) ; +## [xlev,vlev,nlev] = feval \ +## (optim_func, "ff", "dff", list (xinit, obsmat, obses)); +if strcmp(optim_func,"bfgsmin") + ctl = {-1,2,1,1}; +endif +[xlev,vlev,nlev] = feval \ + (optim_func, "ff", {xinit, obsmat, obses}, ctl); +tlev = mytic() ; + + +if max (abs(xlev-truep)) > 1e-4, + if verbose, + printf ("Error is too big : %8.3g\n", max (abs (xlev-truep))); + end + ok = 0; +end +if verbose, + printf (" Costs : init=%8.3g, final=%8.3g, best=%8.3g\n",\ + ff(xinit,obsmat,obses), vlev, ff(truep,obsmat,obses)); +end +if verbose + printf ( " time : %8.3g\n",tlev); +end +if verbose && ok + printf ( "All tests ok\n"); +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/test_min_4.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,117 @@ +## Copyright (C) 2002 Etienne Grossmann. All rights reserved. +## +## This program 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. +## +## This 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. + +## test_bfgs - Test that bfgs works +## +## Check that bfgs treats struct options correctly +## +## Sets 'ok' to 1 if success, 0 otherwise + +## The name of the optimizing function +if ! exist ("optim_func"), optim_func = "bfgsmin"; end + +ok = 1; +cnt = 0; + +if ! exist ("verbose"), verbose = 0; end + +N = 2; + +## Make test reproducible +## x0 = randn(N,1) ; +## y0 = randn(N,1) ; +x0 = (1:N)'/N; +y0 = (N:-1:1)'/N; + +function v = ff(x,y,t) + A = [1 -1;1 1]; M = A'*diag([100,1])*A; + v = ((x - y)(1:2))'*M*((x-y)(1:2)) + 1; +endfunction + + +function dv = dff(x,y,t) + if nargin < 3, t = 1; end + if t == 1, N = length (x); else N = length (y); end + A = [1 -1;1 1]; M = A'*diag([100,1])*A; + dv = 2*((x-y)(1:2))'*M; + if N>2, dv = [dv, zeros(1,N-2)]; end + if t == 2, dv = -dv; end +endfunction + + +if verbose + printf ("\n Testing that %s accepts struct control variable\n\n",\ + optim_func); + + printf ([" Set 'optim_func' to the name of the optimization\n",\ + " function you want to test (must have same synopsis\n",\ + " as 'bfgsmin')\n\n"]); + + printf (" Nparams = N = %i\n",N); + fflush (stdout); +end + +## Plain run, just to make sure ###################################### +## Minimum wrt 'x' is y0 +## [xlev,vlev,nlev] = feval (optim_func, "ff", "dff", list (x0,y0,1)); +## ctl.df = "dff"; +[xlev,vlev,nlev] = feval (optim_func, "ff", {x0,y0,1}); + +cnt++; +if max (abs (xlev-y0)) > 100*sqrt (eps) + if verbose + printf ("Error is too big : %8.3g\n", max (abs (xlev-y0))); + end + ok = 0; +elseif verbose, printf ("ok %i\n",cnt); +end + +## Minimize wrt 2nd arg ############################################## +## Minimum wrt 'y' is x0 +## ctl = struct ("narg", 2,"df","dff"); +## ctl = [nan,nan,2]; +## [xlev,vlev,nlev] = feval (optim_func, "ff", list (x0,y0,2),ctl); + +[xlev,vlev,nlev] = feval (optim_func, "ff", {x0,y0,2},{inf,0,1,2}); + +cnt++; +if max (abs (xlev-x0)) > 100*sqrt (eps) + if verbose + printf ("Error is too big : %8.3g\n", max (abs (xlev-x0))); + end + ok = 0; +elseif verbose, printf ("ok %i\n",cnt); +end + +## Set the verbose option ############################################ +## Minimum wrt 'x' is y0 +## ctl = struct ("narg", 1,"verbose",verbose, "df", "dff"); +## ctl = [nan,nan,2]; +## [xlev,vlev,nlev] = feval (optim_func, "ff", "dff", list (x0,y0,1),ctl); +[xlev,vlev,nlev] = feval (optim_func, "ff", {x0,y0,1},{inf,1,1,1}); + +cnt++; +if max (abs (xlev-y0)) > 100*sqrt (eps) + if verbose + printf ("Error is too big : %8.3g\n", max (abs (xlev-y0))); + end + ok = 0; +elseif verbose, printf ("ok %i\n",cnt); +end + + + + +if verbose && ok + printf ( "All tests ok\n"); +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/test_minimize_1.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,253 @@ +## Copyright (C) 2002 Etienne Grossmann. All rights reserved. +## +## This program 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. +## +## This 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. + +## ok = test_minimize - Test that minimize works +## + +ok = 1; # Remains set if all ok. Set to 0 otherwise +cnt = 0; # Test counter +page_screen_output = 0; +page_output_immediately = 1; + +if ! exist ("verbose"), verbose = 0; end + +N = 2; + +x0 = randn(N,1) ; +y0 = randn(N,1) ; + +## Return value +function v = ff(x,y,t) + A = [1 -1;1 1]; M = A'*diag([100,1])*A; + v = ((x - y)(1:2))'*M*((x-y)(1:2)) + 1; +endfunction + +## Return differential +function dv = dff(x,y,t) + if nargin < 3, t = 1; end + if t == 1, N = length (x); else N = length (y); end + A = [1 -1;1 1]; M = A'*diag([100,1])*A; + dv = 2*((x-y)(1:2))'*M; + if N>2, dv = [dv, zeros(1,N-2)]; end + if t == 2, dv = -dv; end +endfunction + +## Return value, diff and 2nd diff +function [v,dv,d2v] = d2ff(x,y,t) + if nargin < 3, t = 1; end + if t == 1, N = length (x); else N = length (y); end + A = [1 -1;1 1]; M = A'*diag([100,1])*A; + v = ((x - y)(1:2))'*M*((x-y)(1:2)) + 1; + dv = 2*((x-y)(1:2))'*M; + d2v = zeros (N); d2v(1:2,1:2) = 2*M; + if N>2, dv = [dv, zeros(1,N-2)]; end + if t == 2, dv = -dv; end +endfunction + +## Return value, diff and inv of 2nd diff +function [v,dv,d2v] = d2iff(x,y,t) + if nargin < 3, t = 1; end + if t == 1, N = length (x); else N = length (y); end + A = [1 -1;1 1]; M = A'*diag([100,1])*A; + v = ((x - y)(1:2))'*M*((x-y)(1:2)) + 1; + dv = 2*((x-y)(1:2))'*M; + d2v = zeros (N); d2v(1:2,1:2) = inv (2*M); + if N>2, dv = [dv, zeros(1,N-2)]; end + if t == 2, dv = -dv; end +endfunction + +## PRint Now +function prn (varargin), printf (varargin{:}); fflush (stdout); end + + +if verbose + prn ("\n Testing that minimize() works as it should\n\n"); + prn (" Nparams = N = %i\n",N); + fflush (stdout); +end + +## Plain run, just to make sure ###################################### +## Minimum wrt 'x' is y0 +[xlev,vlev,nlev] = minimize ("ff",list (x0,y0,1)); + +cnt++; +if max (abs (xlev-y0)) > 100*sqrt (eps) + if verbose + prn ("Error is too big : %8.3g\n", max (abs (xlev-y0))); + end + ok = 0; +elseif verbose, prn ("ok %i\n",cnt); +end + +## See what 'backend' gives in that last case ######################## +[method,ctl] = minimize ("ff",list (x0,y0,1),"order",0,"backend"); + +cnt++; +if ! ischar (method) || ! strcmp (method,"nelder_mead_min") + if verbose + if ischar (method) + prn ("Wrong method '%s' != 'nelder_mead_min' was chosen\n", method); + else + prn ("minimize pretends to use a method that isn't a string\n"); + end + return + end + ok = 0; +elseif verbose, prn ("ok %i\n",cnt); +end + +[xle2,vle2,nle2] = feval (method, "ff",list (x0,y0,1), ctl); +cnt++; + # nelder_mead_min is not very repeatable + # because of restarts from random positions +if max (abs (xlev-xle2)) > 100*sqrt (eps) + if verbose + prn ("Error is too big : %8.3g\n", max (abs (xlev-xle2))); + end + ok = 0; +elseif verbose, prn ("ok %i\n",cnt); +end + + +## Run, w/ differential, just to make sure ########################### +## Minimum wrt 'x' is y0 + +# [xlev,vlev,nlev] = minimize ("ff",list (x0,y0,1),"df","dff"); + +# cnt++; +# if max (abs (xlev-y0)) > 100*sqrt (eps) +# if verbose +# prn ("Error is too big : %8.3g\n", max (abs (xlev-y0))); +# end +# ok = 0; +# elseif verbose, prn ("ok %i\n",cnt); +# en + +## Run, w/ differential returned by function ('jac' option) ########## +## Minimum wrt 'x' is y0 +# [xlev,vlev,nlev] = minimize ("d2ff",list (x0,y0,1),"jac"); + +# cnt++; +# if max (abs (xlev-y0)) > 100*sqrt (eps) +# if verbose +# prn ("Error is too big : %8.3g\n", max (abs (xlev-y0))); +# end +# ok = 0; +# elseif verbose, prn ("ok %i\n",cnt); +# end + +## Run, w/ 2nd differential, just to make sure ####################### +## Minimum wrt 'x' is y0 +[xlev,vlev,nlev] = minimize ("ff",list (x0,y0,1),"d2f","d2ff"); + +cnt++; +if max (abs (xlev-y0)) > 100*sqrt (eps) + if verbose + prn ("Error is too big : %8.3g\n", max (abs (xlev-y0))); + end + ok = 0; +elseif verbose, prn ("ok %i\n",cnt); +end + +## Use the 'hess' option, when f can return 2nd differential ######### +## Minimum wrt 'x' is y0 +[xlev,vlev,nlev] = minimize ("d2ff",list (x0,y0,1),"hess"); + +cnt++; +if max (abs (xlev-y0)) > 100*sqrt (eps) + if verbose + prn ("Error is too big : %8.3g\n", max (abs (xlev-y0))); + end + ok = 0; +elseif verbose, prn ("ok %i\n",cnt); +end + +## Run, w/ inverse of 2nd differential, just to make sure ############ +## Minimum wrt 'x' is y0 +[xlev,vlev,nlev] = minimize ("ff",list (x0,y0,1),"d2i","d2iff"); + +cnt++; +if max (abs (xlev-y0)) > 100*sqrt (eps) + if verbose + prn ("Error is too big : %8.3g\n", max (abs (xlev-y0))); + end + ok = 0; +elseif verbose, prn ("ok %i\n",cnt); +end + +## Use the 'ihess' option, when f can return pinv of 2nd differential +## Minimum wrt 'x' is y0 +[xlev,vlev,nlev] = minimize ("d2iff",list (x0,y0,1),"ihess"); + +cnt++; +if max (abs (xlev-y0)) > 100*sqrt (eps) + if verbose + prn ("Error is too big : %8.3g\n", max (abs (xlev-y0))); + end + ok = 0; +elseif verbose, prn ("ok %i\n",cnt); +end + +## Run, w/ numerical differential #################################### +## Minimum wrt 'x' is y0 +[xlev,vlev,nlev] = minimize ("ff",list (x0,y0,1),"ndiff"); + +cnt++; +if max (abs (xlev-y0)) > 100*sqrt (eps) + if verbose + prn ("Error is too big : %8.3g\n", max (abs (xlev-y0))); + end + ok = 0; +elseif verbose, prn ("ok %i\n",cnt); +end + +## Run, w/ numerical differential, specified by "order" ############## +## Minimum wrt 'x' is y0 +[xlev,vlev,nlev] = minimize ("ff",list (x0,y0,1),"order",1); + +cnt++; +if max (abs (xlev-y0)) > 100*sqrt (eps) + if verbose + prn ("Error is too big : %8.3g\n", max (abs (xlev-y0))); + end + ok = 0; +elseif verbose, prn ("ok %i\n",cnt); +end + +# ## See what 'backend' gives in that last case ######################## +# [method,ctl] = minimize ("ff",list (x0,y0,1),"order",1,"backend"); + +# cnt++; +# if ! strcmp (method,"bfgsmin") +# if verbose +# prn ("Wrong method '%s' != 'bfgsmin' was chosen\n", method); +# end +# ok = 0; +# elseif verbose, prn ("ok %i\n",cnt); +# end + +## [xle2,vle2,nle2] = feval (method, "ff",list (x0,y0,1), ctl); +[xle2,vle2,nle2] = minimize ("ff",list (x0,y0,1),"order",1); +cnt++; +if max (abs (xlev-xle2)) > 100*eps + if verbose + prn ("Error is too big : %8.3g\n", max (abs (xlev-y0))); + end + ok = 0; +elseif verbose, prn ("ok %i\n",cnt); +end + + +if verbose && ok + prn ( "All tests ok\n"); +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/test_nelder_mead_min_1.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,190 @@ +## Copyright (C) 2002 Etienne Grossmann. All rights reserved. +## +## This program 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. +## +## This 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. + + +## +## Checks wether the function 'nelder_mead_min' works, by making it minimize a +## quadratic function. +## + +## Author: Etienne Grossmann <etienne@cs.uky.edu> + +ok = 1; +cnt = 1; + +if ! exist ("verbose"), verbose = 0; end +if verbose, printf (" test_nelder_mead : \n"); end + +if ! exist ("inspect"), inspect = 0; end + +tol = 100*sqrt (eps); + +R = 3 ; +C = 2; + +if verbose, + printf (" optimization problem has dimension %i\n",R*C); +end + +function c = my_quad_func (x,y,z) + c = 1 + sum ((x-y)(:)'*z*((x-y)(:))); +end + +function c = non_quad_func_1 (x,y,z) + tmp = sum ((x-y)(:)'*z*((x-y)(:))); + c = 1 + 1.1*tmp + sin (sqrt(tmp)); +end + +function c = non_quad_func_2 (x,y,z) + tmp1 = sum ((x-y)(:)'*z*((x-y)(:))); + tmp2 = max (abs ((x-y)(:)))^2; + c = 1 + 1.1*tmp1 + tmp2 ; +end + +## dt = mytic() +## +## Returns the cputime since last call to 'mytic'. + +function dt = mytic() + static last_mytic = 0 ; + [t,u,s] = cputime() ; + dt = t - last_mytic ; + last_mytic = t ; +endfunction + +fnames = list ( "my_quad_func", "non_quad_func_1", "non_quad_func_2"); + +x0 = randn(R,C) ; +x1 = x0 + randn(R,C) ; +z = randn (R*C); z = z*z'; + +for i = 1:length (fnames) + fname = nth (fnames, i); + if verbose, + printf ("trying to minimize '%s'\n", fname); + end + ctl = nan*zeros (1,6); + + mytic (); + [x2,v,nf] = nelder_mead_min (fname, list (x1,x0,z), ctl) ; + t0 = mytic (); + + if any (abs (x2-x0)(:) > 100*tol), + if verbose || inspect, printf ("not ok %i\n",cnt); end + [max(abs (x2-x0)(:)), 100*tol] + if inspect, keyboard; end + ok = 0 ; + else + if verbose, + printf ("ok %i\n function evaluations = %i\n",cnt,nf); + end + end + cnt++; + + # Use vanilla nelder_mead_min + mytic (); + [x2,v,nf] = nelder_mead_min (fname, list (x1,x0,z)) ; + t1 = mytic (); + + if any (abs (x2-x0)(:) > 100*tol), + if verbose || inspect, printf ("not ok %i\n",cnt); end + [max(abs (x2-x0)(:)), 100*tol] + if inspect, keyboard; end + ok = 0 ; + else + if verbose, + printf ("ok %i\n function evaluations = %i\n",cnt,nf); + end + end + cnt++; + + + # Optimize wrt 2nd arg. + ctl = nan * zeros (1,6); + ctl(6) = 0; + ctl(3) = 2; + + mytic (); + [x2,v,nf] = nelder_mead_min (fname, list (x1,x0,z), ctl) ; + t0 = mytic (); + + if any (abs (x2-x1)(:) > 100*tol), + if verbose || inspect, printf ("not ok %i\n",cnt); end + [max(abs (x2-x0)(:)), 100*tol] + if inspect, keyboard; end + ok = 0 ; + else + if verbose, + printf ("ok %i\n function evaluations = %i\n",cnt,nf); + end + end + cnt++; + + # Optimize wrt 2nd arg. + ctl = nan * zeros (1,6); + ctl(3) = 2; + + mytic (); + [x2,v,nf] = nelder_mead_min (fname, list (x1,x0,z), ctl) ; + t1 = mytic (); + + if any (abs (x2-x1)(:) > tol), + if verbose || inspect, printf ("not ok %i\n",cnt); end + [max(abs (x2-x0)(:)), 100*tol] + if inspect, keyboard; end + ok = 0 ; + else + if verbose, + printf ("ok %i\n function evaluations = %i\n",cnt,nf); + end + end + cnt++; + if 0 + # Check with struct control variable + ctls = struct ("narg", 2); + [x2bis,vbis,nfbis] = nelder_mead_min (fname, list (x1,x0,z), ctls) ; + t1 = mytic (); + ## [nf,nfbis] + if any ((x2-x2bis)(:)) + if verbose || inspect, printf ("not ok %i\n",cnt); end + printf (" struct ctl : x2 - x2bis -> %g\n", max(abs (x2-x2bis)(:))); + if inspect, keyboard; end + ok = 0 ; + else + if verbose, + printf ("ok %i\n function evaluations = %i\n",cnt,nfbis); + end + end + cnt++; + + # Check with named args + [x2bis,vbis,nfbis] = nelder_mead_min (fname, list (x1,x0,z), "narg", 2) ; + t1 = mytic (); + ## [nf,nfbis] + if any ((x2-x2bis)(:)) + if verbose || inspect, printf ("not ok %i\n",cnt); end + printf (" named arg : x2 - x2bis -> %g\n", max(abs (x2-x2bis)(:))); + if inspect, keyboard; end + ok = 0 ; + else + if verbose, + printf ("ok %i\n function evaluations = %i\n",cnt,nfbis); + end + end + cnt++; + end +end + +if verbose && ok + printf ("All tests ok\n"); +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/test_nelder_mead_min_2.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,155 @@ +## Copyright (C) 2002 Etienne Grossmann. All rights reserved. +## +## This program 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. +## +## This 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. + + +## +## Checks wether the function 'nelder_mead_min' accepts options properly +## + +## Author: Etienne Grossmann <etienne@cs.uky.edu> + +ok = 1; +cnt = 1; + +if ! exist ("verbose"), verbose = 0; end +if ! exist ("inspect"), inspect = 0; end + +if verbose, + printf (["test_nelder_mead_2\n",\ + " Check whether nelder_mead_min accepts options properly\n\n"]); +end + +N = 2; +x1 = zeros (1,N); +small = 1e-3; +vol = (small^N) / factorial (N); + +## Define simple 2D function : [x,y] -> x^2, start from [0,0] +## + +function c = my_func (x) + c = x(1)^2; +end + +###################################################################### +## Test using volume ################################################# + +## Choose vtol and initial simplex so that algo should stop immediately. +ctl = struct ("verbose",verbose, "isz",small, "vtol",vol*1.01, "rst",0); + +[x2,v,nev] = nelder_mead_min ("my_func", x1, ctl); + +if nev != N+1 + if verbose || inspect, printf ("not ok %i\n",cnt); end + if inspect, keyboard; end + ok = 0 ; +else + if verbose, + printf ("ok %i\n",cnt); + end +end +cnt++; + +## Choose vtol and initial simplex so that algo should stop after one +## iteration (should be a reflexion and a tentative extension). Total is 5 +## evaluations. +ctl = struct ("verbose",verbose, "isz",small, "vtol",vol*0.99, "rst",0); + +x1 = [0,0]; + +[x2,v,nev] = nelder_mead_min ("my_func", x1, ctl); + +if nev != N+3 + if verbose || inspect, printf ("not ok %i\n",cnt); end + if inspect, keyboard; end + ok = 0 ; +else + if verbose, + printf ("ok %i\n",cnt); + end +end +cnt++; + +###################################################################### +## Test using radius ################################################# + +## Choose rtol and initial simplex so that algo stops immediately. +ctl = struct ("verbose",verbose, "isz",small, "rtol",small*2.01, "rst",0); + +[x2,v,nev] = nelder_mead_min ("my_func", x1, ctl); + +if nev != N+1 + if verbose || inspect, printf ("not ok %i\n",cnt); end + if inspect, keyboard; end + ok = 0 ; +else + if verbose, + printf ("ok %i\n",cnt); + end +end +cnt++; + +## Choose rtol and initial simplex so that algo does not stop immediately. +ctl = struct ("verbose",verbose, "isz",small, "rtol",small*1.99, "rst",0); + +[x2,v,nev] = nelder_mead_min ("my_func", x1, ctl); + +if nev <= N+1 + if verbose || inspect, printf ("not ok %i\n",cnt); end + if inspect, keyboard; end + ok = 0 ; +else + if verbose, + printf ("ok %i\n",cnt); + end +end +cnt++; + +###################################################################### +## Test using values ################################################# + +## Choose rtol and initial simplex so that algo should stop immediately. +ctl = struct ("verbose",verbose, "isz",small, "ftol",1.01*small^2, "rst",0); + +[x2,v,nev] = nelder_mead_min ("my_func", x1, ctl); + +if nev != N+1 + if verbose || inspect, printf ("not ok %i\n",cnt); end + if inspect, keyboard; end + ok = 0 ; +else + if verbose, + printf ("ok %i\n",cnt); + end +end +cnt++; + +## Choose rtol and initial simplex so that algo does not stop immediately. +ctl = struct ("verbose",verbose, "isz",small, "ftol",0.99*small^2, "rst",0); + +[x2,v,nev] = nelder_mead_min ("my_func", x1, ctl); + +if nev <= N+1 + if verbose || inspect, printf ("not ok %i\n",cnt); end + if inspect, keyboard; end + ok = 0 ; +else + if verbose + printf ("ok %i\n",cnt); + end +end +cnt++; + +cnt--; +if verbose && ok + printf ("All %i tests ok\n", cnt); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/test_wpolyfit.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,512 @@ +## Tests for wpolyfit. +## +## Test cases are taken from the NIST Statistical Reference Datasets +## http://www.itl.nist.gov/div898/strd/ + +## Author: Paul Kienzle +## This program is public domain + +1; + +function do_test(n,x,y,p,dp,varargin) + [myp,s] = wpolyfit(x,y,n,varargin{:}); + %if length(varargin)==0, [myp,s] = polyfit(x,y,n); else return; end + mydp = sqrt(sumsq(inv(s.R'))'/s.df)*s.normr; + if length(varargin)>0, mydp = [mydp;0]; end %origin + %[svdp,j,svddp] = svdfit(x,y,n); + disp('parameter certified value rel. error'); + [myp(:), p, abs((myp(:)-p)./p)] %, svdp, abs((svdp-p)./p) ] + disp('p-error certified value rel. error'); + [mydp(:), dp, abs((mydp(:) - dp)./dp)] %, svdp, abs((svddp - dp)./dp)] + input('Press <Enter> to proceed to the next test'); +endfunction + +## x y dy +data = [0.0013852 0.2144023 0.0020470 + 0.0018469 0.2516856 0.0022868 + 0.0023087 0.3070443 0.0026362 + 0.0027704 0.3603186 0.0029670 + 0.0032322 0.4260864 0.0033705 + 0.0036939 0.4799956 0.0036983 ]; +x=data(:,1); y=data(:,2); dy=data(:,3); +wpolyfit(x,y,dy,1); +disp('computing parameter uncertainty from monte carlo simulation...'); +fflush(stdout); +n=100; p=zeros(2,n); +for i=1:n, p(:,i)=(polyfit(x,y+randn(size(y)).*dy,1)).'; end +printf("%15s %15s\n", "Coefficient", "Error"); +printf("%15g %15g\n", [mean(p'); std(p')]); +input('Press <Enter> to see some sample regression lines: '); +t = [x(1), x(length(x))]; +[p,s] = wpolyfit(x,y,dy,1); dp=sqrt(sumsq(inv(s.R'))'/s.df)*s.normr; +hold off; +for i=1:15, plot(t,polyval(p(:)+randn(size(dp)).*dp,t),'-g;;'); hold on; end +errorbar(x,y,dy,"~b;;"); +[yf,dyf]=polyconf(p,x,s,0.05,'ci'); +plot(x,yf-dyf,"-r;;",x,yf+dyf,'-r;95% confidence interval;') +hold off; +input('Press <Enter> to continue with the tests: '); + + +##Procedure: Linear Least Squares Regression +##Reference: Filippelli, A., NIST. +##Model: Polynomial Class +## 11 Parameters (B0,B1,...,B10) +## +## y = B0 + B1*x + B2*(x**2) + ... + B9*(x**9) + B10*(x**10) + e + +##Data: +## y x +data = [ 0.8116 -6.860120914 + 0.9072 -4.324130045 + 0.9052 -4.358625055 + 0.9039 -4.358426747 + 0.8053 -6.955852379 + 0.8377 -6.661145254 + 0.8667 -6.355462942 + 0.8809 -6.118102026 + 0.7975 -7.115148017 + 0.8162 -6.815308569 + 0.8515 -6.519993057 + 0.8766 -6.204119983 + 0.8885 -5.853871964 + 0.8859 -6.109523091 + 0.8959 -5.79832982 + 0.8913 -5.482672118 + 0.8959 -5.171791386 + 0.8971 -4.851705903 + 0.9021 -4.517126416 + 0.909 -4.143573228 + 0.9139 -3.709075441 + 0.9199 -3.499489089 + 0.8692 -6.300769497 + 0.8872 -5.953504836 + 0.89 -5.642065153 + 0.891 -5.031376979 + 0.8977 -4.680685696 + 0.9035 -4.329846955 + 0.9078 -3.928486195 + 0.7675 -8.56735134 + 0.7705 -8.363211311 + 0.7713 -8.107682739 + 0.7736 -7.823908741 + 0.7775 -7.522878745 + 0.7841 -7.218819279 + 0.7971 -6.920818754 + 0.8329 -6.628932138 + 0.8641 -6.323946875 + 0.8804 -5.991399828 + 0.7668 -8.781464495 + 0.7633 -8.663140179 + 0.7678 -8.473531488 + 0.7697 -8.247337057 + 0.77 -7.971428747 + 0.7749 -7.676129393 + 0.7796 -7.352812702 + 0.7897 -7.072065318 + 0.8131 -6.774174009 + 0.8498 -6.478861916 + 0.8741 -6.159517513 + 0.8061 -6.835647144 + 0.846 -6.53165267 + 0.8751 -6.224098421 + 0.8856 -5.910094889 + 0.8919 -5.598599459 + 0.8934 -5.290645224 + 0.894 -4.974284616 + 0.8957 -4.64454848 + 0.9047 -4.290560426 + 0.9129 -3.885055584 + 0.9209 -3.408378962 + 0.9219 -3.13200249 + 0.7739 -8.726767166 + 0.7681 -8.66695597 + 0.7665 -8.511026475 + 0.7703 -8.165388579 + 0.7702 -7.886056648 + 0.7761 -7.588043762 + 0.7809 -7.283412422 + 0.7961 -6.995678626 + 0.8253 -6.691862621 + 0.8602 -6.392544977 + 0.8809 -6.067374056 + 0.8301 -6.684029655 + 0.8664 -6.378719832 + 0.8834 -6.065855188 + 0.8898 -5.752272167 + 0.8964 -5.132414673 + 0.8963 -4.811352704 + 0.9074 -4.098269308 + 0.9119 -3.66174277 + 0.9228 -3.2644011]; + +##Certified values: +## p dP +target = [ -1467.48961422980 298.084530995537 + -2772.17959193342 559.779865474950 + -2316.37108160893 466.477572127796 + -1127.97394098372 227.204274477751 + -354.478233703349 71.6478660875927 + -75.1242017393757 15.2897178747400 + -10.8753180355343 2.23691159816033 + -1.06221498588947 0.221624321934227 + -0.670191154593408E-01 0.142363763154724E-01 + -0.246781078275479E-02 0.535617408889821E-03 + -0.402962525080404E-04 0.896632837373868E-05]; +if 1 + disp("Filippelli, A., NIST."); + do_test(10, data(:,2),data(:,1),flipud(target(:,1)),flipud(target(:,2))); +endif + +##Procedure: Linear Least Squares Regression +## +##Reference: Pontius, P., NIST. +## Load Cell Calibration. +## +##Model: Quadratic Class +## 3 Parameters (B0,B1,B2) +## y = B0 + B1*x + B2*(x**2) + + +##Data: y x +data = [ \ + .11019 150000 + .21956 300000 + .32949 450000 + .43899 600000 + .54803 750000 + .65694 900000 + .76562 1050000 + .87487 1200000 + .98292 1350000 + 1.09146 1500000 + 1.20001 1650000 + 1.30822 1800000 + 1.41599 1950000 + 1.52399 2100000 + 1.63194 2250000 + 1.73947 2400000 + 1.84646 2550000 + 1.95392 2700000 + 2.06128 2850000 + 2.16844 3000000 + .11052 150000 + .22018 300000 + .32939 450000 + .43886 600000 + .54798 750000 + .65739 900000 + .76596 1050000 + .87474 1200000 + .98300 1350000 + 1.09150 1500000 + 1.20004 1650000 + 1.30818 1800000 + 1.41613 1950000 + 1.52408 2100000 + 1.63159 2250000 + 1.73965 2400000 + 1.84696 2550000 + 1.95445 2700000 + 2.06177 2850000 + 2.16829 3000000 ]; + +## Certified Regression Statistics +## +## Standard Deviation +## Estimate of Estimate +target = [ \ + 0.673565789473684E-03 0.107938612033077E-03 + 0.732059160401003E-06 0.157817399981659E-09 + -0.316081871345029E-14 0.486652849992036E-16 ]; + +if 1 + disp("Pontius, P., NIST"); + do_test(2, data(:,2),data(:,1),flipud(target(:,1)),flipud(target(:,2))); +endif + + + +#Procedure: Linear Least Squares Regression +#Reference: Eberhardt, K., NIST. +#Model: Linear Class +# 1 Parameter (B1) +# +# y = B1*x + e + +#Data: y x +data =[\ + 130 60 + 131 61 + 132 62 + 133 63 + 134 64 + 135 65 + 136 66 + 137 67 + 138 68 + 139 69 + 140 70 ]; + + +# Certified Regression Statistics +# +# Standard Deviation +# Estimate of Estimate +target = [ \ + 0 0 + 2.07438016528926 0.165289256198347E-01 ]; + + +if 1 + disp("Eberhardt, K., NIST"); + do_test(1, data(:,2),data(:,1),flipud(target(:,1)),flipud(target(:,2)),'origin'); +endif + + +#Reference: Wampler, R. H. (1970). +# A Report of the Accuracy of Some Widely-Used Least +# Squares Computer Programs. +# Journal of the American Statistical Association, 65, 549-565. +# +#Model: Polynomial Class +# 6 Parameters (B0,B1,...,B5) +# +# y = B0 + B1*x + B2*(x**2) + B3*(x**3)+ B4*(x**4) + B5*(x**5) +# +# Certified Regression Statistics +# +# Standard Deviation +# Parameter Estimate of Estimate +target = [\ + 1.00000000000000 0.000000000000000 + 1.00000000000000 0.000000000000000 + 1.00000000000000 0.000000000000000 + 1.00000000000000 0.000000000000000 + 1.00000000000000 0.000000000000000 + 1.00000000000000 0.000000000000000 ]; + +#Data: y x +data = [\ + 1 0 + 6 1 + 63 2 + 364 3 + 1365 4 + 3906 5 + 9331 6 + 19608 7 + 37449 8 + 66430 9 + 111111 10 + 177156 11 + 271453 12 + 402234 13 + 579195 14 + 813616 15 + 1118481 16 + 1508598 17 + 2000719 18 + 2613660 19 + 3368421 20 ]; + +if 1 + disp("Wampler1"); + do_test(5, data(:,2),data(:,1),flipud(target(:,1)),flipud(target(:,2))); +endif + +##Reference: Wampler, R. H. (1970). +## A Report of the Accuracy of Some Widely-Used Least +## Squares Computer Programs. +## Journal of the American Statistical Association, 65, 549-565. +##Model: Polynomial Class +## 6 Parameters (B0,B1,...,B5) +## +## y = B0 + B1*x + B2*(x**2) + B3*(x**3)+ B4*(x**4) + B5*(x**5) +## +## Certified Regression Statistics +## Standard Deviation +## Parameter Estimate of Estimate +target = [ \ + 1.00000000000000 0.000000000000000 + 0.100000000000000 0.000000000000000 + 0.100000000000000E-01 0.000000000000000 + 0.100000000000000E-02 0.000000000000000 + 0.100000000000000E-03 0.000000000000000 + 0.100000000000000E-04 0.000000000000000 ]; + + +#Data: y x +data = [ \ + 1.00000 0 + 1.11111 1 + 1.24992 2 + 1.42753 3 + 1.65984 4 + 1.96875 5 + 2.38336 6 + 2.94117 7 + 3.68928 8 + 4.68559 9 + 6.00000 10 + 7.71561 11 + 9.92992 12 + 12.75603 13 + 16.32384 14 + 20.78125 15 + 26.29536 16 + 33.05367 17 + 41.26528 18 + 51.16209 19 + 63.00000 20 ]; + +if 1 + disp("Wampler2"); + do_test(5, data(:,2),data(:,1),flipud(target(:,1)),flipud(target(:,2))); +endif + + + + +##Reference: Wampler, R. H. (1970). +## A Report of the Accuracy of Some Widely-Used Least +## Squares Computer Programs. +## Journal of the American Statistical Association, 65, 549-565. +## +##Model: Polynomial Class +## 6 Parameters (B0,B1,...,B5) +## +## y = B0 + B1*x + B2*(x**2) + B3*(x**3)+ B4*(x**4) + B5*(x**5) +## +## Certified Regression Statistics +## +## Standard Deviation +## Parameter Estimate of Estimate +target = [\ + 1.00000000000000 2152.32624678170 + 1.00000000000000 2363.55173469681 + 1.00000000000000 779.343524331583 + 1.00000000000000 101.475507550350 + 1.00000000000000 5.64566512170752 + 1.00000000000000 0.112324854679312 ]; + +#Data: y x +data = [ \ + 760. 0 + -2042. 1 + 2111. 2 + -1684. 3 + 3888. 4 + 1858. 5 + 11379. 6 + 17560. 7 + 39287. 8 + 64382. 9 + 113159. 10 + 175108. 11 + 273291. 12 + 400186. 13 + 581243. 14 + 811568. 15 + 1121004. 16 + 1506550. 17 + 2002767. 18 + 2611612. 19 + 3369180. 20 ]; +if 1 + disp("Wampler3"); + do_test(5, data(:,2),data(:,1),flipud(target(:,1)),flipud(target(:,2))); +endif + +##Model: Polynomial Class +## 6 Parameters (B0,B1,...,B5) +## +## y = B0 + B1*x + B2*(x**2) + B3*(x**3)+ B4*(x**4) + B5*(x**5) +## +## Certified Regression Statistics +## +## Standard Deviation +## Parameter Estimate of Estimate +target = [\ + 1.00000000000000 215232.624678170 + 1.00000000000000 236355.173469681 + 1.00000000000000 77934.3524331583 + 1.00000000000000 10147.5507550350 + 1.00000000000000 564.566512170752 + 1.00000000000000 11.2324854679312 ]; + +#Data: y x +data = [\ + 75901 0 + -204794 1 + 204863 2 + -204436 3 + 253665 4 + -200894 5 + 214131 6 + -185192 7 + 221249 8 + -138370 9 + 315911 10 + -27644 11 + 455253 12 + 197434 13 + 783995 14 + 608816 15 + 1370781 16 + 1303798 17 + 2205519 18 + 2408860 19 + 3444321 20 ]; + +if 1 + disp("Wampler4"); + do_test(5, data(:,2),data(:,1),flipud(target(:,1)),flipud(target(:,2))); +endif + + + +##Model: Polynomial Class +## 6 Parameters (B0,B1,...,B5) +## +## y = B0 + B1*x + B2*(x**2) + B3*(x**3)+ B4*(x**4) + B5*(x**5) +## +## Certified Regression Statistics +## +## Standard Deviation +## Parameter Estimate of Estimate +target = [\ + 1.00000000000000 21523262.4678170 + 1.00000000000000 23635517.3469681 + 1.00000000000000 7793435.24331583 + 1.00000000000000 1014755.07550350 + 1.00000000000000 56456.6512170752 + 1.00000000000000 1123.24854679312 ]; + +##Data: y x +data = [ \ + 7590001 0 + -20479994 1 + 20480063 2 + -20479636 3 + 25231365 4 + -20476094 5 + 20489331 6 + -20460392 7 + 18417449 8 + -20413570 9 + 20591111 10 + -20302844 11 + 18651453 12 + -20077766 13 + 21059195 14 + -19666384 15 + 26348481 16 + -18971402 17 + 22480719 18 + -17866340 19 + 10958421 20 ]; +if 1 + disp("Wampler5"); + do_test(5, data(:,2),data(:,1),flipud(target(:,1)),flipud(target(:,2))); +endif
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/wpolyfit.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,247 @@ +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{p}, @var{s}] =} wpolyfit (@var{x}, @var{y}, @var{dy}, @var{n}) +## Return the coefficients of a polynomial @var{p}(@var{x}) of degree +## @var{n} that minimizes +## @iftex +## @tex +## $$ +## \sum_{i=1}^N (p(x_i) - y_i)^2 +## $$ +## @end tex +## @end iftex +## @ifinfo +## @code{sumsq (p(x(i)) - y(i))}, +## @end ifinfo +## to best fit the data in the least squares sense. The standard error +## on the observations @var{y} if present are given in @var{dy}. +## +## The returned value @var{p} contains the polynomial coefficients +## suitable for use in the function polyval. The structure @var{s} returns +## information necessary to compute uncertainty in the model. +## +## To compute the predicted values of y with uncertainty use +## @example +## [y,dy] = polyconf(p,x,s,'ci'); +## @end example +## You can see the effects of different confidence intervals and +## prediction intervals by calling the wpolyfit internal plot +## function with your fit: +## @example +## feval('wpolyfit:plt',x,y,dy,p,s,0.05,'pi') +## @end example +## Use @var{dy}=[] if uncertainty is unknown. +## +## You can use a chi^2 test to reject the polynomial fit: +## @example +## p = 1-chisquare_cdf(s.normr^2,s.df); +## @end example +## p is the probability of seeing a chi^2 value higher than that which +## was observed assuming the data are normally distributed around the fit. +## If p < 0.01, you can reject the fit at the 1% level. +## +## You can use an F test to determine if a higher order polynomial +## improves the fit: +## @example +## [poly1,S1] = wpolyfit(x,y,dy,n); +## [poly2,S2] = wpolyfit(x,y,dy,n+1); +## F = (S1.normr^2 - S2.normr^2)/(S2.normr^2/S2.df); +## p = 1-f_cdf(F,1,S2.df); +## @end example +## p is the probability of observing the improvement in chi^2 obtained +## by adding the extra parameter to the fit. If p < 0.01, you can reject +## the higher order polynomial at the 1% level. +## +## You can estimate the uncertainty in the polynomial coefficients +## themselves using +## @example +## dp = sqrt(sumsq(inv(s.R'))'/s.df)*s.normr; +## @end example +## but the high degree of covariance amongst them makes this a questionable +## operation. +## +## @deftypefnx {Function File} {[@var{p}, @var{s}, @var{mu}] =} wpolyfit (...) +## +## If an additional output @code{mu = [mean(x),std(x)]} is requested then +## the @var{x} values are centered and normalized prior to computing the fit. +## This will give more stable numerical results. To compute a predicted +## @var{y} from the returned model use +## @code{y = polyval(p, (x-mu(1))/mu(2)} +## +## @deftypefnx {Function File} wpolyfit (...) +## +## If no output arguments are requested, then wpolyfit plots the data, +## the fitted line and polynomials defining the standard error range. +## +## Example +## @example +## x = linspace(0,4,20); +## dy = (1+rand(size(x)))/2; +## y = polyval([2,3,1],x) + dy.*randn(size(x)); +## wpolyfit(x,y,dy,2); +## @end example +## +## @deftypefnx {Function File} wpolyfit (..., 'origin') +## +## If 'origin' is specified, then the fitted polynomial will go through +## the origin. This is generally ill-advised. Use with caution. +## +## Hocking, RR (2003). Methods and Applications of Linear Models. +## New Jersey: John Wiley and Sons, Inc. +## +## @end deftypefn +## +## @seealso{polyfit,polyconf} + +## This program is in the public domain. +## Author: Paul Kienzle <pkienzle@users.sf.net> + +function [p_out, s, mu] = wpolyfit (varargin) + + ## strip 'origin' of the end + args = length(varargin); + if args>0 && ischar(varargin{args}) + origin = varargin{args}; + args--; + else + origin=''; + endif + ## strip polynomial order off the end + if args>0 + n = varargin{args}; + args--; + else + n = []; + end + ## interpret the remainder as x,y or x,y,dy or [x,y] or [x,y,dy] + if args == 3 + x = varargin{1}; + y = varargin{2}; + dy = varargin{3}; + elseif args == 2 + x = varargin{1}; + y = varargin{2}; + dy = []; + elseif args == 1 + A = varargin{1}; + [nr,nc]=size(A); + if all(nc!=[2,3]) + error("wpolyfit expects vectors x,y,dy or matrix [x,y,dy]"); + endif + dy = []; + if nc == 3, dy = A(:,3); endif + y = A(:,2); + x = A(:,1); + else + usage ("wpolyfit (x, y [, dy], n [, 'origin'])"); + end + + if (length(origin) == 0) + through_origin = 0; + elseif strcmp(origin,'origin') + through_origin = 1; + else + error ("wpolyfit: expected 'origin' but found '%s'", origin) + endif + + if any(size (x) != size (y)) + error ("wpolyfit: x and y must be vectors of the same size"); + endif + if length(dy)>1 && length(y) != length(dy) + error ("wpolyfit: dy must be a vector the same length as y"); + endif + + if (! (isscalar (n) && n >= 0 && ! isinf (n) && n == round (n))) + error ("wpolyfit: n must be a nonnegative integer"); + endif + + if nargout == 3 + mu = [mean(x), std(x)]; + x = (x - mu(1))/mu(2); + endif + + k = length (x); + + ## observation matrix + if through_origin + ## polynomial through the origin y = ax + bx^2 + cx^3 + ... + A = (x(:) * ones(1,n)) .^ (ones(k,1) * (n:-1:1)); + else + ## polynomial least squares y = a + bx + cx^2 + dx^3 + ... + A = (x(:) * ones (1, n+1)) .^ (ones (k, 1) * (n:-1:0)); + endif + + [p,s] = wsolve(A,y(:),dy(:)); + + if through_origin + p(n+1) = 0; + endif + + if nargout == 0 + good_fit = 1-chisquare_cdf(s.normr^2,s.df); + printf("Polynomial: %s [ p(chi^2>observed)=%.2f%% ]\n", polyout(p,'x'), good_fit*100); + plt(x,y,dy,p,s,'ci'); + else + p_out = p'; + endif + +function plt(x,y,dy,p,s,varargin) + + if iscomplex(p) + # XXX FIXME XXX how to plot complex valued functions? + # Maybe using hue for phase and saturation for magnitude + # e.g., Frank Farris (Santa Cruz University) has this: + # http://www.maa.org/pubs/amm_complements/complex.html + # Could also look at the book + # Visual Complex Analysis by Tristan Needham, Oxford Univ. Press + # but for now we punt + return + end + + ## decorate the graph + grid('on'); + xlabel('abscissa X'); ylabel('data Y'); + title('Least-squares Polynomial Fit with Error Bounds'); + + ## draw fit with estimated error bounds + xf = linspace(min(x),max(x),150)'; + [yf,dyf] = polyconf(p,xf,s,varargin{:}); + plot(xf,yf+dyf,"g.;;", xf,yf-dyf,"g.;;", xf,yf,"g-;fit;"); + + ## plot the data + hold on; + if (isempty(dy)) + plot(x,y,"x;data;"); + else + if isscalar(dy), dy = ones(size(y))*dy; end + errorbar (x, y, dy, "~;data;"); + endif + hold off; + + if strcmp(deblank(input('See residuals? [y,n] ','s')),'y') + clf; + if (isempty(dy)) + plot(x,y-polyval(p,x),"x;data;"); + else + errorbar(x,y-polyval(p,x),dy, '~;data;'); + endif + hold on; + grid on; + ylabel('Residuals'); + xlabel('abscissa X'); + plot(xf,dyf,'g.;;',xf,-dyf,'g.;;'); + hold off; + endif + +%!demo % #1 +%! x = linspace(0,4,20); +%! dy = (1+rand(size(x)))/2; +%! y = polyval([2,3,1],x) + dy.*randn(size(x)); +%! wpolyfit(x,y,dy,2); + +%!demo % #2 +%! x = linspace(-i,+2i,20); +%! noise = ( randn(size(x)) + i*randn(size(x)) )/10; +%! P = [2-i,3,1+i]; +%! y = polyval(P,x) + noise; +%! wpolyfit(x,y,2) +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/wpolyfitdemo.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,28 @@ +## wpolyfitdemo(p) +## Generate some random data for the polynomial p, then fit that +## data. If p ends with 0, then the fit will be constrained to +## go through the origin. +## +## To force a variety of weights, poisson statistics are used to +## estimate the variance on the individual points, but gaussian +## statistics are used to generate new values within that variance. + +## Author: Paul Kienzle +## This program is public domain. +function wpolyfitdemo(pin) + if (nargin == 0) pin = [3 -1 2]'; endif + x = [-3:0.1:3]; + y = polyval(pin,x); + ## poisson weights + % dy = sqrt(abs(y)); + ## uniform weights in [0.5,1] + dy = 0.5 + 0.5*rand(size(y)); + + y = y + randn(size(y)).*dy; + printf("Original polynomial: %s\n", polyout(pin,'x')); + if (pin(length(pin)) == 0) + wpolyfit(x,y,dy,length(pin)-1,'origin'); + else + wpolyfit(x,y,dy,length(pin)-1); + endif +endfunction
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/inst/wsolve.m Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,127 @@ +## [x,s] = wsolve(A,y,dy) +## +## Solve a potentially over-determined system with uncertainty in +## the values. +## +## A x = y +/- dy +## +## Use QR decomposition for increased accuracy. Estimate the +## uncertainty for the solution from the scatter in the data. +## +## The returned structure s contains +## +## normr = sqrt( A x - y ), weighted by dy +## R such that R'R = A'A +## df = n-p, n = rows of A, p = columns of A +## +## See polyconf for details on how to use s to compute dy. +## The covariance matrix is inv(R'*R). If you know that the +## parameters are independent, then uncertainty is given by +## the diagonal of the covariance matrix, or +## +## dx = sqrt(N*sumsq(inv(s.R'))') +## +## where N = normr^2/df, or N = 1 if df = 0. +## +## Example 1: weighted system +## +## A=[1,2,3;2,1,3;1,1,1]; xin=[1;2;3]; +## dy=[0.2;0.01;0.1]; y=A*xin+randn(size(dy)).*dy; +## [x,s] = wsolve(A,y,dy); +## dx = sqrt(sumsq(inv(s.R'))'); +## res = [xin, x, dx] +## +## Example 2: weighted overdetermined system y = x1 + 2*x2 + 3*x3 + e +## +## A = fullfact([3,3,3]); xin=[1;2;3]; +## y = A*xin; dy = rand(size(y))/50; y+=dy.*randn(size(y)); +## [x,s] = wsolve(A,y,dy); +## dx = s.normr*sqrt(sumsq(inv(s.R'))'/s.df); +## res = [xin, x, dx] +## +## Note there is a counter-intuitive result that scaling the +## uncertainty in the data does not affect the uncertainty in +## the fit. Indeed, if you perform a monte carlo simulation +## with x,y datasets selected from a normal distribution centered +## on y with width 10*dy instead of dy you will see that the +## variance in the parameters indeed increases by a factor of 100. +## However, if the error bars really do increase by a factor of 10 +## you should expect a corresponding increase in the scatter of +## the data, which will increase the variance computed by the fit. + +## This program is public domain. + +function [x_out,s]=wsolve(A,y,dy) + if nargin < 2, usage("[x dx] = wsolve(A,y[,dy])"); end + if nargin < 3, dy = []; end + + [nr,nc] = size(A); + if nc > nr, error("underdetermined system"); end + + ## apply weighting term, if it was given + if prod(size(dy))==1 + A = A ./ dy; + y = y ./ dy; + elseif ~isempty(dy) + A = A ./ (dy * ones (1, columns(A))); + y = y ./ dy; + endif + + ## system solution: A x = y => x = inv(A) y + ## QR decomposition has good numerical properties: + ## AP = QR, with P'P = Q'Q = I, and R upper triangular + ## so + ## inv(A) y = P inv(R) inv(Q) y = P inv(R) Q' y = P (R \ (Q' y)) + ## Note that b is usually a vector and Q is matrix, so it will + ## be faster to compute (y' Q)' than (Q' y). + [Q,R,p] = qr(A,0); + x = R\(y'*Q)'; + x(p) = x; + + s.R = R; + s.R(:,p) = R; + s.df = nr-nc; + s.normr = norm(y - A*x); + + if nargout == 0, + cov = s.R'*s.R + if s.df, normalized_chisq = s.normr^2/s.df, end + x = x' + else + x_out = x; + endif + +## We can show that uncertainty dx = sumsq(inv(R'))' = sqrt(diag(inv(A'A))). +## +## Rather than calculate inv(A'A) directly, we are going to use the QR +## decomposition we have already computed: +## +## AP = QR, with P'P = Q'Q = I, and R upper triangular +## +## so +## +## A'A = PR'Q'QRP' = PR'RP' +## +## and +## +## inv(A'A) = inv(PR'RP') = inv(P')inv(R'R)inv(P) = P inv(R'R) P' +## +## For a permutation matrix P, +## +## diag(PXP') = P diag(X) +## +## so +## diag(inv(A'A)) = diag(P inv(R'R) P') = P diag(inv(R'R)) +## +## For R upper triangular, inv(R') = inv(R)' so inv(R'R) = inv(R)inv(R)'. +## Conveniently, for X upper triangular, diag(XX') = sumsq(X')', so +## +## diag(inv(A'A)) = P sumsq(inv(R)')' +## +## This is both faster and more accurate than computing inv(A'A) +## directly. +## +## One small problem: if R is not square then inv(R) does not exist. +## This happens when the system is underdetermined, but in that case +## you shouldn't be using wsolve. +
--- a/main/optim/leasqr.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,349 +0,0 @@ -% Copyright (C) 1992-1994 Richard Shrager, Arthur Jutan, Ray Muzic -% -% This program 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 of the License, or -% (at your option) any later version. -% -% This program 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 this program; if not, write to the Free Software -% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - -function [f,p,kvg,iter,corp,covp,covr,stdresid,Z,r2]= ... - leasqr(x,y,pin,F,stol,niter,wt,dp,dFdp,options) -%function [f,p,kvg,iter,corp,covp,covr,stdresid,Z,r2]= -% leasqr(x,y,pin,F,{stol,niter,wt,dp,dFdp,options}) -% -% Levenberg-Marquardt nonlinear regression of f(x,p) to y(x). -% -% Version 3.beta -% {}= optional parameters -% x=vec or mat of indep variables, 1 row/observation: x=[x0 x1....xm] -% y=vec of obs values, same no. of rows as x. -% wt=vec(dim=length(x)) of statistical weights. These should be set -% to be proportional to (sqrt of var(y))^-1; (That is, the covariance -% matrix of the data is assumed to be proportional to diagonal with diagonal -% equal to (wt.^2)^-1. The constant of proportionality will be estimated.), -% default=ones(length(y),1). -% pin=vector of initial parameters to be adjusted by leasqr. -% dp=fractional incr of p for numerical partials,default= .001*ones(size(pin)) -% dp(j)>0 means central differences. -% dp(j)<0 means one-sided differences. -% Note: dp(j)=0 holds p(j) fixed i.e. leasqr wont change initial guess: pin(j) -% F=name of function in quotes,of the form y=f(x,p) -% dFdp=name of partials M-file in quotes default is prt=dfdp(x,f,p,dp,F) -% stol=scalar tolerances on fractional improvement in ss,default stol=.0001 -% niter=scalar max no. of iterations, default = 20 -% options=matrix of n rows (same number of rows as pin) containing -% column 1: desired fractional precision in parameter estimates. -% Iterations are terminated if change in parameter vector (chg) on two -% consecutive iterations is less than their corresponding elements -% in options(:,1). [ie. all(abs(chg*current parm est) < options(:,1)) -% on two consecutive iterations.], default = zeros(). -% column 2: maximum fractional step change in parameter vector. -% Fractional change in elements of parameter vector is constrained to be -% at most options(:,2) between sucessive iterations. -% [ie. abs(chg(i))=abs(min([chg(i) options(i,2)*current param estimate])).], -% default = Inf*ones(). -% -% OUTPUT VARIABLES -% f=vec function values computed in function func. -% p=vec trial or final parameters. i.e, the solution. -% kvg=scalar: =1 if convergence, =0 otherwise. -% iter=scalar no. of interations used. -% corp= correlation matrix for parameters -% covp= covariance matrix of the parameters -% covr = diag(covariance matrix of the residuals) -% stdresid= standardized residuals -% Z= matrix that defines confidence region -% r2= coefficient of multiple determination -% -% All Zero guesses not acceptable - -% A modified version of Levenberg-Marquardt -% Non-Linear Regression program previously submitted by R.Schrager. -% This version corrects an error in that version and also provides -% an easier to use version with automatic numerical calculation of -% the Jacobian Matrix. In addition, this version calculates statistics -% such as correlation, etc.... -% -% Version 3 Notes -% Errors in the original version submitted by Shrager (now called version 1) -% and the improved version of Jutan (now called version 2) have been corrected. -% Additional features, statistical tests, and documentation have also been -% included along with an example of usage. BEWARE: Some the the input and -% output arguments were changed from the previous version. -% -% Ray Muzic <rfm2@ds2.uh.cwru.edu> -% Arthur Jutan <jutan@charon.engga.uwo.ca> - -% Richard I. Shrager (301)-496-1122 -% Modified by A.Jutan (519)-679-2111 -% Modified by Ray Muzic 14-Jul-1992 -% 1) add maxstep feature for limiting changes in parameter estimates -% at each step. -% 2) remove forced columnization of x (x=x(:)) at beginning. x could be -% a matrix with the ith row of containing values of the -% independent variables at the ith observation. -% 3) add verbose option -% 4) add optional return arguments covp, stdresid, chi2 -% 5) revise estimates of corp, stdev -% Modified by Ray Muzic 11-Oct-1992 -% 1) revise estimate of Vy. remove chi2, add Z as return values -% Modified by Ray Muzic 7-Jan-1994 -% 1) Replace ones(x) with a construct that is compatible with versions -% newer and older than v 4.1. -% 2) Added global declaration of verbose (needed for newer than v4.x) -% 3) Replace return value var, the variance of the residuals with covr, -% the covariance matrix of the residuals. -% 4) Introduce options as 10th input argument. Include -% convergence criteria and maxstep in it. -% 5) Correct calculation of xtx which affects coveraince estimate. -% 6) Eliminate stdev (estimate of standard deviation of parameter -% estimates) from the return values. The covp is a much more -% meaningful expression of precision because it specifies a confidence -% region in contrast to a confidence interval.. If needed, however, -% stdev may be calculated as stdev=sqrt(diag(covp)). -% 7) Change the order of the return values to a more logical order. -% 8) Change to more efficent algorithm of Bard for selecting epsL. -% 9) Tighten up memory usage by making use of sparse matrices (if -% MATLAB version >= 4.0) in computation of covp, corp, stdresid. -% Modified by Francesco Potorti -% for use in Octave -% -% References: -% Bard, Nonlinear Parameter Estimation, Academic Press, 1974. -% Draper and Smith, Applied Regression Analysis, John Wiley and Sons, 1981. -% -%set default args - -% argument processing -% - -%if (sscanf(version,'%f') >= 4), -vernum= sscanf(version,'%f'); -if vernum(1) >= 4, - global verbose - plotcmd='plot(x(:,1),y,''+'',x(:,1),f); figure(gcf)'; -else - plotcmd='plot(x(:,1),y,''+'',x(:,1),f); shg'; -end; -if (exist('OCTAVE_VERSION')) - global verbose - plotcmd='plot(x(:,1),y,"+;data;",x(:,1),f,";fit;");'; -end; - -if(exist('verbose')~=1), %If verbose undefined, print nothing - verbose=0; %This will not tell them the results -end; - -if (nargin <= 8), dFdp='dfdp'; end; -if (nargin <= 7), dp=.001*(pin*0+1); end; %DT -if (nargin <= 6), wt=ones(length(y),1); end; % SMB modification -if (nargin <= 5), niter=20; end; -if (nargin == 4), stol=.0001; end; -% - -y=y(:); wt=wt(:); pin=pin(:); dp=dp(:); %change all vectors to columns -% check data vectors- same length? -m=length(y); n=length(pin); p=pin;[m1,m2]=size(x); -if m1~=m ,error('input(x)/output(y) data must have same number of rows ') ,end; - -if (nargin <= 9), - options=[zeros(n,1), Inf*ones(n,1)]; - nor = n; noc = 2; -else - [nor, noc]=size(options); - if (nor ~= n), - error('options and parameter matrices must have same number of rows'), - end; - if (noc ~= 2), - options=[options(:,1), Inf*ones(nor,1)]; - end; -end; -pprec=options(:,1); -maxstep=options(:,2); -% - -% set up for iterations -% -f=feval(F,x,p); fbest=f; pbest=p; -r=wt.*(y-f); -ss=r'*r; -sbest=ss; -nrm=zeros(n,1); -chgprev=Inf*ones(n,1); -kvg=0; -epsLlast=1; -epstab=[.1, 1, 1e2, 1e4, 1e6]; - -% do iterations -% -for iter=1:niter, - pprev=pbest; - prt=feval(dFdp,x,fbest,pprev,dp,F); - r=wt.*(y-fbest); - sprev=sbest; - sgoal=(1-stol)*sprev; - for j=1:n, - if dp(j)==0, - nrm(j)=0; - else - prt(:,j)=wt.*prt(:,j); - nrm(j)=prt(:,j)'*prt(:,j); - if nrm(j)>0, - nrm(j)=1/sqrt(nrm(j)); - end; - end - prt(:,j)=nrm(j)*prt(:,j); - end; -% above loop could ? be replaced by: -% prt=prt.*wt(:,ones(1,n)); -% nrm=dp./sqrt(diag(prt'*prt)); -% prt=prt.*nrm(:,ones(1,m))'; - [prt,s,v]=svd(prt,0); - s=diag(s); - g=prt'*r; - for jjj=1:length(epstab), - epsL = max(epsLlast*epstab(jjj),1e-7); - se=sqrt((s.*s)+epsL); - gse=g./se; - chg=((v*gse).*nrm); -% check the change constraints and apply as necessary - ochg=chg; - idx = ~isinf(maxstep); - limit = abs(maxstep(idx).*pprev(idx)); - chg(idx) = min(max(chg(idx),-limit),limit); - if (verbose & any(ochg ~= chg)), - disp(['Change in parameter(s): ', ... - sprintf('%d ',find(ochg ~= chg)), 'were constrained']); - end; - aprec=abs(pprec.*pbest); %--- -% ss=scalar sum of squares=sum((wt.*(y-f))^2). - if (any(abs(chg) > 0.1*aprec)),%--- % only worth evaluating function if - p=chg+pprev; % there is some non-miniscule change - f=feval(F,x,p); - r=wt.*(y-f); - ss=r'*r; - if ss<sbest, - pbest=p; - fbest=f; - sbest=ss; - end; - if ss<=sgoal, - break; - end; - end; %--- - end; - epsLlast = epsL; - if (verbose), - eval(plotcmd); - end; - if ss<eps, - break; - end - aprec=abs(pprec.*pbest); -% [aprec, chg, chgprev] - if (all(abs(chg) < aprec) & all(abs(chgprev) < aprec)), - kvg=1; - if (verbose), - fprintf('Parameter changes converged to specified precision\n'); - end; - break; - else - chgprev=chg; - end; - if ss>sgoal, - break; - end; -end; - -% set return values -% -p=pbest; -f=fbest; -ss=sbest; -kvg=((sbest>sgoal)|(sbest<=eps)|kvg); -if kvg ~= 1 , disp(' CONVERGENCE NOT ACHIEVED! '), end; - -% CALC VARIANCE COV MATRIX AND CORRELATION MATRIX OF PARAMETERS -% re-evaluate the Jacobian at optimal values -jac=feval(dFdp,x,f,p,dp,F); -msk = dp ~= 0; -n = sum(msk); % reduce n to equal number of estimated parameters -jac = jac(:, msk); % use only fitted parameters - -%% following section is Ray Muzic's estimate for covariance and correlation -%% assuming covariance of data is a diagonal matrix proportional to -%% diag(1/wt.^2). -%% cov matrix of data est. from Bard Eq. 7-5-13, and Row 1 Table 5.1 - -if exist('sparse') % save memory - Q=sparse(1:m,1:m,1./wt.^2); - Qinv=sparse(1:m,1:m,wt.^2); -else - Q=diag((0*wt+1)./(wt.^2)); - Qinv=diag(wt.*wt); -end -resid=y-f; %un-weighted residuals -covr=resid'*Qinv*resid*Q/(m-n); %covariance of residuals -Vy=1/(1-n/m)*covr; % Eq. 7-13-22, Bard %covariance of the data - -jtgjinv=inv(jac'*Qinv*jac); %argument of inv may be singular -covp=jtgjinv*jac'*Qinv*Vy*Qinv*jac*jtgjinv; % Eq. 7-5-13, Bard %cov of parm est -d=sqrt(abs(diag(covp))); -corp=covp./(d*d'); - -if exist('sparse') - covr=spdiags(covr,0); - stdresid=resid./sqrt(spdiags(Vy,0)); -else - covr=diag(covr); % convert returned values to compact storage - stdresid=resid./sqrt(diag(Vy)); % compute then convert for compact storage -end -Z=((m-n)*jac'*Qinv*jac)/(n*resid'*Qinv*resid); - -%%% alt. est. of cov. mat. of parm.:(Delforge, Circulation, 82:1494-1504, 1990 -%%disp('Alternate estimate of cov. of param. est.') -%%acovp=resid'*Qinv*resid/(m-n)*jtgjinv - -%Calculate R^2 (Ref Draper & Smith p.46) -% -r=corrcoef([y(:),f(:)]); -r2=r(1,2).^2; - -% if someone has asked for it, let them have it -% -if (verbose), - eval(plotcmd); - disp(' Least Squares Estimates of Parameters') - disp(p') - disp(' Correlation matrix of parameters estimated') - disp(corp) - disp(' Covariance matrix of Residuals' ) - disp(covr) - disp(' Correlation Coefficient R^2') - disp(r2) - sprintf(' 95%% conf region: F(0.05)(%.0f,%.0f)>= delta_pvec''*Z*delta_pvec',n,m-n) - Z -% runs test according to Bard. p 201. - n1 = sum((f-y) < 0); - n2 = sum((f-y) > 0); - nrun=sum(abs(diff((f-y)<0)))+1; - if ((n1>10)&(n2>10)), % sufficent data for test? - zed=(nrun-(2*n1*n2/(n1+n2)+1)+0.5)/(2*n1*n2*(2*n1*n2-n1-n2)... - /((n1+n2)^2*(n1+n2-1))); - if (zed < 0), - prob = erfc(-zed/sqrt(2))/2*100; - disp([num2str(prob),'% chance of fewer than ',num2str(nrun),' runs.']); - else, - prob = erfc(zed/sqrt(2))/2*100; - disp([num2str(prob),'% chance of greater than ',num2str(nrun),' runs.']); - end; - end; -end;
--- a/main/optim/leasqrdemo.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,84 +0,0 @@ -% Copyright (C) 1992-1994 Richard Shrager -% Copyright (C) 1992-1994 Arthur Jutan -% Copyright (C) 1992-1994 Ray Muzic -% -% This program 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 of the License, or -% (at your option) any later version. -% -% This program 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 this program; if not, write to the Free Software -% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - -% leasqrdemo -% -% An example showing how to use non-linear least squares to fit -% simulated data to the function: -% -% y = a e^{-bx} - -% 2001-02-05 Paul Kienzle -% * collected example into a single script - -function leasqrdemo - % generate test data - t = [1:10:100]'; - p = [1; 0.1]; - data = leasqrfunc (t, p); - - rnd = [ 0.352509 - -0.040607 - -1.867061 - -1.561283 - 1.473191 - 0.580767 - 0.841805 - 1.632203 - -0.179254 - 0.345208 ]; - - % add noise - % wt1 = 1 /sqrt of variances of data - % 1 / wt1 = sqrt of var = standard deviation - wt1 = (1 + 0 * t) ./ sqrt (data); - data = data + 0.05 * rnd ./ wt1; - - % Note by Thomas Walter <walter@pctc.chemie.uni-erlangen.de>: - % - % Using a step size of 1 to calculate the derivative is WRONG !!!! - % See numerical mathbooks why. - % A derivative calculated from central differences need: s - % step = 0.001...1.0e-8 - % And onesided derivative needs: - % step = 1.0e-5...1.0e-8 and may be still wrong - - F = @leasqrfunc; - dFdp = @leasqrdfdp; % exact derivative - % dFdp = @dfdp; % estimated derivative - dp = [0.001; 0.001]; - pin = [.8; .05]; - stol=0.001; niter=50; - minstep = [0.01; 0.01]; - maxstep = [0.8; 0.8]; - options = [minstep, maxstep]; - - global verbose; - verbose=1; - [f1, p1, kvg1, iter1, corp1, covp1, covr1, stdresid1, Z1, r21] = ... - leasqr (t, data, pin, F, stol, niter, wt1, dp, dFdp, options); - -function y = leasqrfunc(x,p) - % sprintf('called leasqrfunc(x,[%e %e]\n', p(1),p(2)) - % y = p(1)+p(2)*x; - y=p(1)*exp(-p(2)*x); - -function y = leasqrdfdp(x,f,p,dp,func) - % y = [0*x+1, x]; - y= [exp(-p(2)*x), -p(1)*x.*exp(-p(2)*x)]; -
--- a/main/optim/leval.cc Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,63 +0,0 @@ -// Copyright (C) 2002 Etienne Grossmann. All rights reserved. -// -// This program 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. -// -// This 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. - - -#include "config.h" -#include <oct.h> -#include <octave/parse.h> - - -DEFUN_DLD (leval, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} leval (@var{name}, @var{list})\n\ -Evaluate the function named @var{name}. All the elements in @var{list}\n\ -are passed on to the named function. For example,\n\ -\n\ -@example\n\ -leval (\"acos\", list (-1))\n\ - @result{} 3.1416\n\ -@end example\n\ -\n\ -@noindent\n\ -calls the function @code{acos} with the argument @samp{-1}.\n\ -\n\ -The function @code{leval} provides provides more flexibility than\n\ -@code{feval} since arguments need not be hard-wired in the calling \n\ -code. @seealso{feval and eval}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 2) - { - std::string name = args(0).string_value (); - if (error_state) - error ("leval: first argument must be a string"); - - octave_value_list lst = args(1).list_value (); - if (error_state) - error ("leval: second argument must be a list"); - - retval = feval (name, lst, nargout); - - } - else - print_usage (); - - return retval; -} - -/* -%!assert(leval("acos", list(-1)), pi, 100*eps); - */
--- a/main/optim/line_min.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,69 +0,0 @@ -## Copyright (C) 2000 Ben Sapp. All rights reserved. -## -## This program 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. -## -## This 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. - -## [a,fx,nev] = line_min (f, dx, args, narg) - Minimize f() along dx -## -## INPUT ---------- -## f : string : Name of minimized function -## dx : matrix : Direction along which f() is minimized -## args : list : List of argument of f -## narg : integer : Position of minimized variable in args. Default=1 -## -## OUTPUT --------- -## a : scalar : Value for which f(x+a*dx) is a minimum (*) -## fx : scalar : Value of f(x+a*dx) at minimum (*) -## nev : integer : Number of function evaluations -## -## (*) The notation f(x+a*dx) assumes that args == list (x). - -## Author: Ben Sapp <bsapp@lanl.gov> -## Reference: David G Luenberger's Linear and Nonlinear Programming -## -## Changelog : ----------- -## 2002-01-28 Paul Kienzle -## * save two function evaluations by inlining the derivatives -## * pass through varargin{:} to the function -## 2002-03-13 Paul Kienzle -## * simplify update expression -## 2002-04-17 Etienne Grossmann <etienne@isr.ist.utl.pt> -## * Rename nrm.m to line_min.m (in order not to break dfp, which uses nrm) -## * Use list of args, suppress call to __pseudo_func__ -## * Add nargs argument, assume args is a list -## * Change help text -function [a,fx,nev] = line_min (f, dx, args, narg) - velocity = 1; - acceleration = 1; - - if nargin < 4, narg = 1; end - - nev = 0; - h = 0.001; # Was 0.01 here - x = nth (args,narg); - a = 0; - # was 1e-4 - while (abs (velocity) > 0.000001) - fx = leval (f,splice (args, narg, 1, list (x+a*dx))); - fxph = leval (f,splice (args, narg,1,list (x+(a+h)*dx))); - fxmh = leval (f,splice (args, narg,1,list (x+(a-h)*dx))); - - velocity = (fxph - fxmh)/(2*h); - acceleration = (fxph - 2*fx + fxmh)/(h^2); - if abs(acceleration) <= eps, acceleration = 1; end # Don't do div by zero - # Use abs(accel) to avoid problems due to - # concave function - a = a - velocity/abs(acceleration); - nev += 3; - endwhile -endfunction - -## Rem : Although not clear from the code, the returned a always seems to -## correspond to (nearly) optimal fx. \ No newline at end of file
--- a/main/optim/mdsmax.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,184 +0,0 @@ -function [x, fmax, nf] = mdsmax(fun, x, stopit, savit, varargin) -%MDSMAX Multidirectional search method for direct search optimization. -% [x, fmax, nf] = MDSMAX(FUN, x0, STOPIT, SAVIT) attempts to -% maximize the function FUN, using the starting vector x0. -% The method of multidirectional search is used. -% Output arguments: -% x = vector yielding largest function value found, -% fmax = function value at x, -% nf = number of function evaluations. -% The iteration is terminated when either -% - the relative size of the simplex is <= STOPIT(1) -% (default 1e-3), -% - STOPIT(2) function evaluations have been performed -% (default inf, i.e., no limit), or -% - a function value equals or exceeds STOPIT(3) -% (default inf, i.e., no test on function values). -% The form of the initial simplex is determined by STOPIT(4): -% STOPIT(4) = 0: regular simplex (sides of equal length, the default), -% STOPIT(4) = 1: right-angled simplex. -% Progress of the iteration is not shown if STOPIT(5) = 0 (default 1). -% If a non-empty fourth parameter string SAVIT is present, then -% `SAVE SAVIT x fmax nf' is executed after each inner iteration. -% NB: x0 can be a matrix. In the output argument, in SAVIT saves, -% and in function calls, x has the same shape as x0. -% MDSMAX(fun, x0, STOPIT, SAVIT, P1, P2,...) allows additional -% arguments to be passed to fun, via feval(fun,x,P1,P2,...). - -% This implementation uses 2n^2 elements of storage (two simplices), where x0 -% is an n-vector. It is based on the algorithm statement in [2, sec.3], -% modified so as to halve the storage (with a slight loss in readability). - -% From Matrix Toolbox -% Copyright (C) 2002 N.J.Higham -% www.maths.man.ac.uk/~higham/mctoolbox -% distributed under the terms of the GNU General Public License -% -% Modifications for octave by A.Adler 2003 -% $Id$ - -% References: -% [1] V. J. Torczon, Multi-directional search: A direct search algorithm for -% parallel machines, Ph.D. Thesis, Rice University, Houston, Texas, 1989. -% [2] V. J. Torczon, On the convergence of the multidirectional search -% algorithm, SIAM J. Optimization, 1 (1991), pp. 123-145. -% [3] N. J. Higham, Optimization by direct search in matrix computations, -% SIAM J. Matrix Anal. Appl, 14(2): 317-333, 1993. -% [4] N. J. Higham, Accuracy and Stability of Numerical Algorithms, -% Second edition, Society for Industrial and Applied Mathematics, -% Philadelphia, PA, 2002; sec. 20.5. - -x0 = x(:); % Work with column vector internally. -n = length(x0); - -mu = 2; % Expansion factor. -theta = 0.5; % Contraction factor. - -% Set up convergence parameters etc. -if nargin < 3 - stopit(1) = 1e-3; -elseif isempty(stopit) - stopit(1) = 1e-3; -endif -tol = stopit(1); % Tolerance for cgce test based on relative size of simplex. -if length(stopit) == 1, stopit(2) = inf; end % Max no. of f-evaluations. -if length(stopit) == 2, stopit(3) = inf; end % Default target for f-values. -if length(stopit) == 3, stopit(4) = 0; end % Default initial simplex. -if length(stopit) == 4, stopit(5) = 1; end % Default: show progress. -trace = stopit(5); -if length(stopit) == 5, stopit(6) = 1; end % Default: maximize -dirn= stopit(6); -if nargin < 4, savit = []; end % File name for snapshots. - -V = [zeros(n,1) eye(n)]; T = V; -f = zeros(n+1,1); ft = f; -V(:,1) = x0; f(1) = dirn*feval(fun,x,varargin{:}); -fmax_old = f(1); - -if trace, fprintf('f(x0) = %9.4e\n', f(1)), end - -k = 0; m = 0; - -% Set up initial simplex. -scale = max(norm(x0,inf),1); -if stopit(4) == 0 - % Regular simplex - all edges have same length. - % Generated from construction given in reference [18, pp. 80-81] of [1]. - alpha = scale / (n*sqrt(2)) * [ sqrt(n+1)-1+n sqrt(n+1)-1 ]; - V(:,2:n+1) = (x0 + alpha(2)*ones(n,1)) * ones(1,n); - for j=2:n+1 - V(j-1,j) = x0(j-1) + alpha(1); - x(:) = V(:,j); f(j) = dirn*feval(fun,x,varargin{:}); - end -else - % Right-angled simplex based on co-ordinate axes. - alpha = scale*ones(n+1,1); - for j=2:n+1 - V(:,j) = x0 + alpha(j)*V(:,j); - x(:) = V(:,j); f(j) = dirn*feval(fun,x,varargin{:}); - end -end -nf = n+1; -size = 0; % Integer that keeps track of expansions/contractions. -flag_break = 0; % Flag which becomes true when ready to quit outer loop. - -while 1 %%%%%% Outer loop. -k = k+1; - -% Find a new best vertex x and function value fmax = f(x). -[fmax,j] = max(f); -V(:,[1 j]) = V(:,[j 1]); v1 = V(:,1); -if ~isempty(savit), x(:) = v1; eval(['save ' savit ' x fmax nf']), end -f([1 j]) = f([j 1]); -if trace - fprintf('Iter. %2.0f, inner = %2.0f, size = %2.0f, ', k, m, size) - fprintf('nf = %3.0f, f = %9.4e (%2.1f%%)\n', nf, fmax, ... - 100*(fmax-fmax_old)/(abs(fmax_old)+eps)) -end -fmax_old = fmax; - -% Stopping Test 1 - f reached target value? -if fmax >= stopit(3) - msg = ['Exceeded target...quitting\n']; - break % Quit. -end - -m = 0; -while 1 %%% Inner repeat loop. - m = m+1; - - % Stopping Test 2 - too many f-evals? - if nf >= stopit(2) - msg = ['Max no. of function evaluations exceeded...quitting\n']; - flag_break = 1; break % Quit. - end - - % Stopping Test 3 - converged? This is test (4.3) in [1]. - size_simplex = norm(V(:,2:n+1)- v1(:,ones(1,n)),1) / max(1, norm(v1,1)); - if size_simplex <= tol - msg = sprintf('Simplex size %9.4e <= %9.4e...quitting\n', ... - size_simplex, tol); - flag_break = 1; break % Quit. - end - - for j=2:n+1 % ---Rotation (reflection) step. - T(:,j) = 2*v1 - V(:,j); - x(:) = T(:,j); ft(j) = dirn*feval(fun,x,varargin{:}); - end - nf = nf + n; - - replaced = ( max(ft(2:n+1)) > fmax ); - - if replaced - for j=2:n+1 % ---Expansion step. - V(:,j) = (1-mu)*v1 + mu*T(:,j); - x(:) = V(:,j); f(j) = dirn*feval(fun,x,varargin{:}); - end - nf = nf + n; - % Accept expansion or rotation? - if max(ft(2:n+1)) > max(f(2:n+1)) - V(:,2:n+1) = T(:,2:n+1); f(2:n+1) = ft(2:n+1); % Accept rotation. - else - size = size + 1; % Accept expansion (f and V already set). - end - else - for j=2:n+1 % ---Contraction step. - V(:,j) = (1+theta)*v1 - theta*T(:,j); - x(:) = V(:,j); f(j) = dirn*feval(fun,x,varargin{:}); - end - nf = nf + n; - replaced = ( max(f(2:n+1)) > fmax ); - % Accept contraction (f and V already set). - size = size - 1; - end - - if replaced, break, end - if trace & rem(m,10) == 0, fprintf(' ...inner = %2.0f...\n',m), end - end %%% Of inner repeat loop. - -if flag_break, break, end -end %%%%%% Of outer loop. - -% Finished. -if trace, fprintf(msg), end -x(:) = v1;
--- a/main/optim/minimize.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,300 +0,0 @@ -## Copyright (C) 2002 Etienne Grossmann. All rights reserved. -## -## This program 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. -## -## This 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. - -## [x,v,nev,...] = minimize (f,args,...) - Minimize f -## -## ARGUMENTS -## f : string : Name of function. Must return a real value -## args : list or : List of arguments to f (by default, minimize the first) -## matrix : f's only argument -## -## RETURNED VALUES -## x : matrix : Local minimum of f. Let's suppose x is M-by-N. -## v : real : Value of f in x0 -## nev : integer : Number of function evaluations -## or 1 x 2 : Number of function and derivative evaluations (if -## derivatives are used) -## -## -## Extra arguments are either a succession of option-value pairs or a single -## list or struct of option-value pairs (for unary options, the value in the -## struct is ignored). -## -## OPTIONS : DERIVATIVES Derivatives may be used if one of these options -## --------------------- uesd. Otherwise, the Nelder-Mean (see -## nelder_mead_min) method is used. -## -## 'd2f', d2f : Name of a function that returns the value of f, of its -## 1st and 2nd derivatives : [fx,dfx,d2fx] = feval (d2f, x) -## where fx is a real number, dfx is 1x(M*N) and d2fx is -## (M*N)x(M*N). A Newton-like method (d2_min) will be used. -## -## 'hess' : Use [fx,dfx,d2fx] = leval (f, args) to compute 1st and -## 2nd derivatives, and use a Newton-like method (d2_min). -## -## 'd2i', d2i : Name of a function that returns the value of f, of its -## 1st and pseudo-inverse of second derivatives : -## [fx,dfx,id2fx] = feval (d2i, x) where fx is a real -## number, dfx is 1x(M*N) and d2ix is (M*N)x(M*N). -## A Newton-like method will be used (see d2_min). -## -## 'ihess' : Use [fx,dfx,id2fx] = leval (f, args) to compute 1st -## derivative and the pseudo-inverse of 2nd derivatives, -## and use a Newton-like method (d2_min). -## -## NOTE : df, d2f or d2i take the same arguments as f. -## -## 'order', n : Use derivatives of order n. If the n'th order derivative -## is not specified by 'df', 'd2f' or 'd2i', it will be -## computed numerically. Currently, only order 1 works. -## -## 'ndiff' : Use a variable metric method (bfgs) using numerical -## differentiation. -## -## OPTIONS : STOPPING CRITERIA Default is to use 'tol' -## --------------------------- -## 'ftol', ftol : Stop search when value doesn't improve, as tested by -## -## ftol > Deltaf/max(|f(x)|,1) -## -## where Deltaf is the decrease in f observed in the last -## iteration. Default=10*eps -## -## 'utol', utol : Stop search when updates are small, as tested by -## -## tol > max { dx(i)/max(|x(i)|,1) | i in 1..N } -## -## where dx is the change in the x that occured in the last -## iteration. -## -## 'dtol',dtol : Stop search when derivatives are small, as tested by -## -## dtol > max { df(i)*max(|x(i)|,1)/max(v,1) | i in 1..N } -## -## where x is the current minimum, v is func(x) and df is -## the derivative of f in x. This option is ignored if -## derivatives are not used in optimization. -## -## MISC. OPTIONS -## ------------- -## 'maxev', m : Maximum number of function evaluations <inf> -## -## 'narg' , narg : Position of the minimized argument in args <1> -## 'isz' , step : Initial step size (only for 0 and 1st order method) <1> -## Should correspond to expected distance to minimum -## 'verbose' : Display messages during execution -## -## 'backend' : Instead of performing the minimization itself, return -## [backend, control], the name and control argument of the -## backend used by minimize(). Minimimzation can then be -## obtained without the overhead of minimize by calling, if -## a 0 or 1st order method is used : -## -## [x,v,nev] = feval (backend, args, control) -## -## or, if a 2nd order method is used : -## -## [x,v,nev] = feval (backend, control.d2f, args, control) -## -function [x,v,nev,varargout] = minimize (f,args,varargin) - -## Oldies -## -## 'df' , df : Name of a function that returns the derivatives of f -## in x : dfx = feval (df, x) where dfx is 1x(M*N). A -## variable metric method (see bfgs) will be used. -## -## 'jac' : Use [fx, dfx] = leval(f, args) to compute derivatives -## and use a variable metric method (bfgs). -## - - -# #################################################################### -# Read the options ################################################### -# #################################################################### -# Options with a value -op1 = "ftol utol dtol df d2f d2i order narg maxev isz"; -# Boolean options -op0 = "verbose backend jac hess ihess ndiff" ; - -default = struct ("backend",0,"verbose",0,\ - "df","", "df", "","d2f","","d2i","", \ - "hess", 0, "ihess", 0, "jac", 0,"ndiff", 0, \ - "ftol" ,nan, "utol",nan, "dtol", nan,\ - "order",nan, "narg",nan, "maxev",nan,\ - "isz", nan); - -if nargin == 3 # Accomodation to struct and list optional - va_arg_cnt = 1; # args - tmp = nth (varargin, va_arg_cnt++); - - if isstruct (tmp) - opls = list (); - for [v,k] = tmp # Treat separately unary and binary opts - if findstr ([" ",k," "],op0) - opls = append (opls, k); - else - opls = append (opls, k, v); - end - end - elseif is_list (tmp) - opls = tmp; - else - opls = list (tmp); - end -else - opls = varargin; -end -ops = read_options (opls,\ - "op0",op0, "op1",op1, "default",default); - -backend=ops.backend; verbose=ops.verbose; -df=ops.df; d2f=ops.d2f; d2i=ops.d2i; -hess=ops.hess; ihess=ops.ihess; jac=ops.jac; -ftol=ops.ftol; utol=ops.utol; dtol=ops.dtol; -order=ops.order; narg=ops.narg; maxev=ops.maxev; -isz=ops.isz; ndiff=ops.ndiff; - -if length (df), error ("Option 'df' doesn't exist any more. Sorry.\n");end -if jac, error ("Option 'jac' doesn't exist any more. Sorry.\n");end - - # Basic coherence checks ############# - -ws = ""; # Warning string -es = ""; # Error string - - # Warn if more than 1 differential is given -if !!length (df) + !!length (d2f) + !!length (d2i) + jac + hess + ihess + \ - ndiff > 1 - # Order of preference of - if length (d2i), ws = [ws,"d2i='",d2i,"', "]; end - if length (d2f), ws = [ws,"d2f='",d2f,"', "]; end - if length (df), ws = [ws,"df='",df,"', "]; end - if hess , ws = [ws,"hess, "]; end - if ihess , ws = [ws,"ihess, "]; end - if jac , ws = [ws,"jac, "]; end - if ndiff , ws = [ws,"ndiff, "]; end - ws = ws(1:length(ws)-2); - ws = ["Options ",ws," were passed. Only one will be used\n"] -end - - # Check that enough args are passed to call - # f(), unless backend is specified, in which - # case I don't need to call f() -if ! isnan (narg) && ! backend - if is_list (args) - if narg > length (args) - es = [es,sprintf("narg=%i > length(args)=%i\n",narg, length(args))]; - end - elseif narg > 1 - es = [es,sprintf("narg=%i, but a single argument was passed\n",narg)]; - end -end - -if length (ws), warn (ws); end -if length (es), error (es); end # EOF Basic coherence checks ######### - - -op = 0; # Set if any option is passed and should be - # passed to backend - -if ! isnan (ftol) , ctls.ftol = ftol; op = 1; end -if ! isnan (utol) , ctls.utol = utol; op = 1; end -if ! isnan (dtol) , ctls.dtol = dtol; op = 1; end -if ! isnan (maxev) , ctls.maxev = maxev; op = 1; end -if ! isnan (narg) , ctls.narg = narg; op = 1; end -if ! isnan (isz) , ctls.isz = isz; op = 1; end -if verbose , ctls.verbose = 1; op = 1; end - - # defaults That are used in this function : -if isnan (narg), narg = 1; end - - # ########################################## - # Choose one optimization method ########### - # Choose according to available derivatives -if ihess, d2f = f; ctls.id2f = 1; op = 1; -elseif hess, d2f = f; -end - - -if length (d2i), method = "d2_min"; ctls.id2f = 1; op = 1; d2f = d2i; -elseif length (d2f), method = "d2_min"; -### elseif length (df) , method = "bfgsmin"; ctls.df = df; op = 1; -### elseif jac , method = "bfgsmin"; ctls.jac = 1 ; op = 1; - ## else method = "nelder_mead_min"; - ## end - # Choose method because ndiff is passed #### -elseif ndiff , method = "bfgsmin"; - - # Choose method by specifying order ######## -elseif ! isnan (order) - - if order == 0, method = "nelder_mead_min"; - elseif order == 1 - method = "bfgsmin"; - - elseif order == 2 - if ! (length (d2f) || length (d2i)) - error ("minimize(): 'order' is 2, but 2nd differential is missing\n"); - end - else - error ("minimize(): 'order' option only implemented for order<=2\n"); - end -else # Default is nelder_mead_min - method = "nelder_mead_min"; -end # EOF choose method ######################## - -if verbose - printf ("minimize(): Using '%s' as back-end\n",method); -end - - # More checks ############################## -ws = ""; -if !isnan (isz) && strcmp (method,"d2_min") - ws = [ws,"option 'isz' is passed to method that doesn't use it"]; -end -if length (ws), warn (ws); end - # EOF More checks ########################## - -if strcmp (method, "d2_min"), all_args = list (f, d2f, args); -elseif strcmp (method, "bfgsmin"),all_args = list (f, args); -else all_args = list (f, args); -end - # Eventually add ctls to argument list -if op, all_args = append (all_args, list (ctls)); end - -if ! backend # Call the backend ################### - if strcmp (method, "d2_min"), - [x,v,nev,h] = leval (method, all_args); - # Eventually return inverse of Hessian - if nargout > 3, vr_val_cnt = 1; varargout{vr_val_cnt++} = h; end - elseif strcmp (method, "bfgsmin") - nev = nan; - if is_list (args),tmp={};for i=1:length(args),tmp{i}=nth(args,i);end;args=tmp;end - if !iscell(args), args = {args}; end - if isnan (ftol), ftol = 1e-12; end # Use bfgsmin's defaults - if isnan (utol), utol = 1e-6; end - if isnan (dtol), dtol = 1e-5; end - if isnan (maxev), maxev = inf; end - [x, v, okcv] = bfgsmin (f, args, {maxev,verbose,1,narg},{ftol,utol,dtol}); - else - [x,v,nev] = leval (method, all_args); - end - -else # Don't call backend, just return its name - # and arguments. - - x = method; - if op, v = ctls; else v = []; end -end - -
--- a/main/optim/nelder_mead_min.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,347 +0,0 @@ -## Copyright (C) 2002 Etienne Grossmann. All rights reserved. -## -## This program 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. -## -## This 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. -## -## Changelog: -## 2002 / 05 / 09 : Default is no restart next to solution - -## [x0,v,nev] = nelder_mead_min (f,args,ctl) - Nelder-Mead minimization -## -## Minimize 'f' using the Nelder-Mead algorithm. This function is inspired -## from the that found in the book "Numerical Recipes". -## -## ARGUMENTS -## --------- -## f : string : Name of function. Must return a real value -## args : list : Arguments passed to f. -## or matrix : f's only argument -## ctl : vector : (Optional) Control variables, described below -## or struct -## -## RETURNED VALUES -## --------------- -## x0 : matrix : Local minimum of f -## v : real : Value of f in x0 -## nev : number : Number of function evaluations -## -## CONTROL VARIABLE : (optional) may be named arguments (i.e. "name",value -## ------------------ pairs), a struct, or a vector of length <= 6, where -## NaN's are ignored. Default values are written <value>. -## OPT. VECTOR -## NAME POS -## ftol,f N/A : Stopping criterion : stop search when values at simplex -## vertices are all alike, as tested by -## -## f > (max_i (f_i) - min_i (f_i)) /max(max(|f_i|),1) -## -## where f_i are the values of f at the vertices. <10*eps> -## -## rtol,r N/A : Stop search when biggest radius of simplex, using -## infinity-norm, is small, as tested by : -## -## ctl(2) > Radius <10*eps> -## -## vtol,v N/A : Stop search when volume of simplex is small, tested by -## -## ctl(2) > Vol -## -## crit,c ctl(1) : Set one stopping criterion, 'ftol' (c=1), 'rtol' (c=2) -## or 'vtol' (c=3) to the value of the 'tol' option. <1> -## -## tol, t ctl(2) : Threshold in termination test chosen by 'crit' <10*eps> -## -## narg ctl(3) : Position of the minimized argument in args <1> -## maxev ctl(4) : Maximum number of function evaluations. This number <inf> -## may be slightly exceeded. -## isz ctl(5) : Size of initial simplex, which is : <1> -## -## { x + e_i | i in 0..N } -## -## Where x == nth (args, narg) is the initial value -## e_0 == zeros (size (x)), -## e_i(j) == 0 if j != i and e_i(i) == ctl(5) -## e_i has same size as x -## -## Set ctl(5) to the distance you expect between the starting -## point and the minimum. -## -## rst ctl(6) : When a minimum is found the algorithm restarts next to -## it until the minimum does not improve anymore. ctl(6) is -## the maximum number of restarts. Set ctl(6) to zero if -## you know the function is well-behaved or if you don't -## mind not getting a true minimum. <0> -## -## verbose, v Be more or less verbose (quiet=0) <0> -function [x,v,nev] = nelder_mead_min (f, args, varargin) - -## Author : Etienne Grossmann <etienne@cs.uky.edu> - - -verbose = 0; - - # Default control variables -ftol = rtol = 10*eps; # Stop either by likeness of values or -vtol = nan; # radius, but don't care about volume. -crit = 0; # Stopping criterion ctl(1) -tol = 10*eps; # Stopping test's threshold ctl(2) -narg = 1; # Position of minimized arg ctl(3) -maxev = inf; # Max num of func evaluations ctl(4) -isz = 1; # Initial size ctl(5) -rst = 0; # Max # of restarts - - -if nargin >= 3, # Read control arguments - va_arg_cnt = 1; - if nargin > 3, ctl = struct (varargin{:}); else ctl = nth (varargin, va_arg_cnt++); end - if isnumeric (ctl) - if length (ctl)>=1 && !isnan (ctl(1)), crit = ctl(1); end - if length (ctl)>=2 && !isnan (ctl(2)), tol = ctl(2); end - if length (ctl)>=3 && !isnan (ctl(3)), narg = ctl(3); end - if length (ctl)>=4 && !isnan (ctl(4)), maxev = ctl(4); end - if length (ctl)>=5 && !isnan (ctl(5)), isz = ctl(5); end - if length (ctl)>=6 && !isnan (ctl(6)), rst = ctl(6); end - else - if struct_contains (ctl, "crit") && ! isnan (ctl.crit ), crit = ctl.crit ; end - if struct_contains (ctl, "tol") && ! isnan (ctl.tol ), tol = ctl.tol ; end - if struct_contains (ctl, "ftol") && ! isnan (ctl.ftol ), ftol = ctl.ftol ; end - if struct_contains (ctl, "rtol") && ! isnan (ctl.rtol ), rtol = ctl.rtol ; end - if struct_contains (ctl, "vtol") && ! isnan (ctl.vtol ), vtol = ctl.vtol ; end - if struct_contains (ctl, "narg") && ! isnan (ctl.narg ), narg = ctl.narg ; end - if struct_contains (ctl,"maxev") && ! isnan (ctl.maxev), maxev = ctl.maxev; end - if struct_contains (ctl, "isz") && ! isnan (ctl.isz ), isz = ctl.isz ; end - if struct_contains (ctl, "rst") && ! isnan (ctl.rst ), rst = ctl.rst ; end - if struct_contains(ctl,"verbose")&& !isnan(ctl.verbose),verbose=ctl.verbose;end - end -end - - -if crit == 1, ftol = tol; -elseif crit == 2, rtol = tol; -elseif crit == 3, vtol = tol; -elseif crit, error ("crit is %i. Should be 1,2 or 3.\n"); -end - -if is_list (args), # List of arguments - x = nth (args, narg); -else # Single argument - x = args; - args = list (args); -end -## args - -if narg > length (args) # Check - error ("nelder_mead_min : narg==%i, length (args)==%i\n", - narg, length (args)); -end - -[R,C] = size (x); -N = R*C; # Size of argument -x = x(:); - # Initial simplex -u = isz * eye (N+1,N) + ones(N+1,1)*x'; - - -for i = 1:N+1, - y(i) = leval (f, splice (args, narg, 1, list (reshape (u(i,:),R,C)))); -end ; -nev = N+1; - -[ymin,imin] = min(y); -ymin0 = ymin; -## y -nextprint = 0 ; -v = nan; -while nev <= maxev, - - ## ymin, ymax, ymx2 : lowest, highest and 2nd highest function values - ## imin, imax, imx2 : indices of vertices with these values - [ymin,imin] = min(y); [ymax,imax] = max(y) ; - y(imax) = ymin ; - [ymx2,imx2] = max(y) ; - y(imax) = ymax ; - - ## ymin may be > ymin0 after restarting - ## if ymin > ymin0 , - ## "nelder-mead : Whoa 'downsimplex' Should be renamed 'upsimplex'" - ## keyboard - ## end - - # Compute stopping criterion - done = 0; - if ! isnan (ftol), done |= (max(y)-min(y)) / max(1,max(abs(y))) < ftol;end - if ! isnan (rtol), done |= 2*max (max (u) - min (u)) < rtol; end - if ! isnan (vtol) - done |= abs (det (u(1:N,:)-ones(N,1)*u(N+1,:)))/factorial(N) < vtol; - end - ## [ 2*max (max (u) - min (u)), abs (det (u(1:N,:)-ones(N,1)*u(N+1,:)))/factorial(N);\ - ## rtol, vtol] - - # Eventually print some info - if verbose && nev > nextprint && ! done - - printf("nev=%-5d imin=%-3d ymin=%-8.3g done=%i\n",\ - nev,imin,ymin,done) ; - - nextprint = nextprint + 100 ; - end - - if done # Termination test - if (rst > 0) && (isnan (v) || v > ymin) - rst--; - if verbose - if isnan (v), - printf ("Restarting next to minimum %10.3e\n",ymin); - else - printf ("Restarting next to minimum %10.3e\n",ymin-v); - end - end - # Keep best minimum - x = reshape (u(imin,:), R, C) ; - v = ymin ; - - jumplen = 10 * max (max (u) - min (u)); - - u += jumplen * randn (size (u)); - for i = 1:N+1, y(i) = \ - leval (f, splice (args, narg, 1, list (reshape (u(i,:),R,C)))); - end - nev += N+1; - [ymin,imin] = min(y); [ymax,imax] = max(y); - y(imax) = ymin; - [ymx2,imx2] = max(y); - y(imax) = ymax ; - else - if isnan (v), - x = reshape (u(imin,:), R, C) ; - v = ymin ; - end - if verbose, - printf("nev=%-5d imin=%-3d ymin=%-8.3g done=%i. Done\n",\ - nev,imin,ymin,done) ; - end - return - end - - end - ## [ y' u ] - - tra = 0 ; # 'trace' debug var contains flags - if verbose > 1, str = sprintf (" %i : %10.3e --",done,ymin); end - - # Look for a new point - xsum = sum(u) ; # Consider reflection of worst vertice - # around centroid. - ## f1 = (1-(-1))/N = 2/N; - ## f2 = f1 - (-1) = 2/N + 1 = (N+2)/N - xnew = (2*xsum - (N+2)*u(imax,:)) / N; - ## xnew = (2*xsum - N*u(imax,:)) / N; - ynew = leval (f, splice (args, narg, 1, list ( reshape (xnew, R,C)))); - nev++; - - if ynew <= ymin , # Reflection is good - - tra += 1 ; - if verbose > 1 - str = [str,sprintf(" %3i : %10.3e good refl >>",nev,ynew-ymin)]; - end - y(imax) = ynew; u(imax,:) = xnew ; - ## ymin = ynew; - ## imin = imax; - xsum = sum(u) ; - - ## f1 = (1-2)/N = -1/N - ## f2 = f1 - 2 = -1/N - 2 = -(2*N+1)/N - xnew = ( -xsum + (2*N+1)*u(imax,:) ) / N; - ynew = leval (f, splice (args, narg, 1, list ( reshape (xnew, R,C)))); - nev++; - - if ynew <= ymin , # expansion improves - tra += 2 ; - ## 'expanded reflection' - y(imax) = ynew ; u(imax,:) = xnew ; - xsum = sum(u) ; - if verbose > 1 - str = [str,sprintf(" %3i : %10.3e expd refl",nev,ynew-ymin)]; - end - else - tra += 4 ; - ## 'plain reflection' - ## Updating of y and u has already been done - if verbose > 1 - str = [str,sprintf(" %3i : %10.3e plain ref",nev,ynew-ymin)]; - end - end - # Reflexion is really bad - elseif ynew >= ymax , - - tra += 8 ; - if verbose > 1 - str = [str,sprintf(" %3i : %10.3e intermedt >>",nev,ynew-ymin)]; - end - ## look for intermediate point - # Bring worst point closer to centroid - ## f1 = (1-0.5)/N = 0.5/N - ## f2 = f1 - 0.5 = 0.5*(1 - N)/N - xnew = 0.5*(xsum + (N-1)*u(imax,:)) / N; - ynew = leval (f, splice (args, narg, 1, list (reshape (xnew, R,C)))); - nev++; - - if ynew >= ymax , # New point is even worse. Contract whole - # simplex - - nev += N + 1 ; - ## u0 = u; - u = (u + ones(N+1,1)*u(imin,:)) / 2; - ## keyboard - - ## Code that doesn't care about value of empty_list_elements_ok - if imin == 1 , ii = 2:N+1; - elseif imin == N+1, ii = 1:N; - else ii = [1:imin-1,imin+1:N+1]; end - for i = ii - y(i) = \ - leval (f, splice (args, narg, 1, list (reshape (u(i,:),R,C)))); - end - ## 'contraction' - tra += 16 ; - if verbose > 1 - str = [str,sprintf(" %3i contractn",nev)]; - end - else # Replace highest point - y(imax) = ynew ; u(imax,:) = xnew ; - xsum = sum(u) ; - ## 'intermediate' - tra += 32 ; - if verbose > 1 - str = [str,sprintf(" %3i : %10.3e intermedt",nev,ynew-ymin)]; - end - end - - else # Reflexion is neither good nor bad - y(imax) = ynew ; u(imax,:) = xnew ; - xsum = sum(u) ; - ## 'plain reflection (2)' - tra += 64 ; - if verbose > 1 - str = [str,sprintf(" %3i : %10.3e keep refl",nev,ynew-ymin)]; - end - end - if verbose > 1, printf ("%s\n",str); end -end - -if verbose >= 0 - printf ("nelder_mead : Too many iterations. Returning\n"); -end - -if isnan (v) || v > ymin, - x = reshape (u(imin,:), R, C) ; - v = ymin ; -end
--- a/main/optim/nmsmax.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,198 +0,0 @@ -function [x, fmax, nf] = nmsmax(fun, x, stopit, savit, varargin) -%NMSMAX Nelder-Mead simplex method for direct search optimization. -% [x, fmax, nf] = NMSMAX(FUN, x0, STOPIT, SAVIT) attempts to -% maximize the function FUN, using the starting vector x0. -% The Nelder-Mead direct search method is used. -% Output arguments: -% x = vector yielding largest function value found, -% fmax = function value at x, -% nf = number of function evaluations. -% The iteration is terminated when either -% - the relative size of the simplex is <= STOPIT(1) -% (default 1e-3), -% - STOPIT(2) function evaluations have been performed -% (default inf, i.e., no limit), or -% - a function value equals or exceeds STOPIT(3) -% (default inf, i.e., no test on function values). -% The form of the initial simplex is determined by STOPIT(4): -% STOPIT(4) = 0: regular simplex (sides of equal length, the default) -% STOPIT(4) = 1: right-angled simplex. -% Progress of the iteration is not shown if STOPIT(5) = 0 (default 1). -% STOPIT(6) indicates the direction (ie. minimization or -% maximization.) Default is 1, maximization. -% set STOPIT(6)=-1 for minimization -% If a non-empty fourth parameter string SAVIT is present, then -% `SAVE SAVIT x fmax nf' is executed after each inner iteration. -% NB: x0 can be a matrix. In the output argument, in SAVIT saves, -% and in function calls, x has the same shape as x0. -% NMSMAX(fun, x0, STOPIT, SAVIT, P1, P2,...) allows additional -% arguments to be passed to fun, via feval(fun,x,P1,P2,...). - -% From Matrix Toolbox -% Copyright (C) 2002 N.J.Higham -% www.maths.man.ac.uk/~higham/mctoolbox -% distributed under the terms of the GNU General Public License -% -% Modifications for octave by A.Adler 2003 -% $Id$ - -% References: -% N. J. Higham, Optimization by direct search in matrix computations, -% SIAM J. Matrix Anal. Appl, 14(2): 317-333, 1993. -% C. T. Kelley, Iterative Methods for Optimization, Society for Industrial -% and Applied Mathematics, Philadelphia, PA, 1999. - -x0 = x(:); % Work with column vector internally. -n = length(x0); - -% Set up convergence parameters etc. -if nargin < 3 | isempty(stopit), stopit(1) = 1e-3; end -tol = stopit(1); % Tolerance for cgce test based on relative size of simplex. -if length(stopit) == 1, stopit(2) = inf; end % Max no. of f-evaluations. -if length(stopit) == 2, stopit(3) = inf; end % Default target for f-values. -if length(stopit) == 3, stopit(4) = 0; end % Default initial simplex. -if length(stopit) == 4, stopit(5) = 1; end % Default: show progress. -trace = stopit(5); -if length(stopit) == 5, stopit(6) = 1; end % Default: maximize -dirn= stopit(6); -if nargin < 4, savit = []; end % File name for snapshots. - -V = [zeros(n,1) eye(n)]; -f = zeros(n+1,1); -V(:,1) = x0; -f(1) = dirn*feval(fun,x,varargin{:}); -fmax_old = f(1); - -if trace, fprintf('f(x0) = %9.4e\n', f(1)), end - -k = 0; m = 0; - -% Set up initial simplex. -scale = max(norm(x0,inf),1); -if stopit(4) == 0 - % Regular simplex - all edges have same length. - % Generated from construction given in reference [18, pp. 80-81] of [1]. - alpha = scale / (n*sqrt(2)) * [ sqrt(n+1)-1+n sqrt(n+1)-1 ]; - V(:,2:n+1) = (x0 + alpha(2)*ones(n,1)) * ones(1,n); - for j=2:n+1 - V(j-1,j) = x0(j-1) + alpha(1); - x(:) = V(:,j); - f(j) = dirn*feval(fun,x,varargin{:}); - end -else - % Right-angled simplex based on co-ordinate axes. - alpha = scale*ones(n+1,1); - for j=2:n+1 - V(:,j) = x0 + alpha(j)*V(:,j); - x(:) = V(:,j); - f(j) = dirn*feval(fun,x,varargin{:}); - end -end -nf = n+1; -how = 'initial '; - -[temp,j] = sort(f); -j = j(n+1:-1:1); -f = f(j); V = V(:,j); - -alpha = 1; beta = 1/2; gamma = 2; - -while 1 %%%%%% Outer (and only) loop. -k = k+1; - - fmax = f(1); - if fmax > fmax_old - if ~isempty(savit) - x(:) = V(:,1); eval(['save ' savit ' x fmax nf']) - end - end - if trace - fprintf('Iter. %2.0f,', k) - fprintf([' how = ' how ' ']); - fprintf('nf = %3.0f, f = %9.4e (%2.1f%%)\n', nf, fmax, ... - 100*(fmax-fmax_old)/(abs(fmax_old)+eps)) - end - fmax_old = fmax; - - %%% Three stopping tests from MDSMAX.M - - % Stopping Test 1 - f reached target value? - if fmax >= stopit(3) - msg = ['Exceeded target...quitting\n']; - break % Quit. - end - - % Stopping Test 2 - too many f-evals? - if nf >= stopit(2) - msg = ['Max no. of function evaluations exceeded...quitting\n']; - break % Quit. - end - - % Stopping Test 3 - converged? This is test (4.3) in [1]. - v1 = V(:,1); - size_simplex = norm(V(:,2:n+1)-v1(:,ones(1,n)),1) / max(1, norm(v1,1)); - if size_simplex <= tol - msg = sprintf('Simplex size %9.4e <= %9.4e...quitting\n', ... - size_simplex, tol); - break % Quit. - end - - % One step of the Nelder-Mead simplex algorithm - % NJH: Altered function calls and changed CNT to NF. - % Changed each `fr < f(1)' type test to `>' for maximization - % and re-ordered function values after sort. - - vbar = (sum(V(:,1:n)')/n)'; % Mean value - vr = (1 + alpha)*vbar - alpha*V(:,n+1); - x(:) = vr; - fr = dirn*feval(fun,x,varargin{:}); - nf = nf + 1; - vk = vr; fk = fr; how = 'reflect, '; - if fr > f(n) - if fr > f(1) - ve = gamma*vr + (1-gamma)*vbar; - x(:) = ve; - fe = dirn*feval(fun,x,varargin{:}); - nf = nf + 1; - if fe > f(1) - vk = ve; fk = fe; - how = 'expand, '; - end - end - else - vt = V(:,n+1); ft = f(n+1); - if fr > ft - vt = vr; ft = fr; - end - vc = beta*vt + (1-beta)*vbar; - x(:) = vc; - fc = dirn*feval(fun,x,varargin{:}); - nf = nf + 1; - if fc > f(n) - vk = vc; fk = fc; - how = 'contract,'; - else - for j = 2:n - V(:,j) = (V(:,1) + V(:,j))/2; - x(:) = V(:,j); - f(j) = dirn*feval(fun,x,varargin{:}); - end - nf = nf + n-1; - vk = (V(:,1) + V(:,n+1))/2; - x(:) = vk; - fk = dirn*feval(fun,x,varargin{:}); - nf = nf + 1; - how = 'shrink, '; - end - end - V(:,n+1) = vk; - f(n+1) = fk; - [temp,j] = sort(f); - j = j(n+1:-1:1); - f = f(j); V = V(:,j); - -end %%%%%% End of outer (and only) loop. - -% Finished. -if trace, fprintf(msg), end -x(:) = V(:,1);
--- a/main/optim/nrm.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,41 +0,0 @@ -## Copyright (C) 2000 Ben Sapp. All rights reserved. -## -## This program 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. -## -## This 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. - -## -*- texinfo -*- -## @deftypefn {Function File} {@var{xmin} =} nrm(@var{f},@var{x0}) -## Using @var{x0} as a starting point find a minimum of the scalar -## function @var{f}. The Newton-Raphson method is used. -## @end deftypefn - -## Author: Ben Sapp <bsapp@lanl.gov> -## Reference: David G Luenberger's Linear and Nonlinear Programming - -## 2002-01-28 Paul Kienzle -## * save two function evaluations by inlining the derivatives -## * pass through varargin{:} to the function -## 2002-03-13 Paul Kienzle -## * simplify update expression - -function x = nrm(f,x,varargin) - velocity = 1; - acceleration = 1; - - h = 0.01; - while(abs(velocity) > 0.0001) - fx = feval(f,x,varargin{:}); - fxph = feval(f,x+h,varargin{:}); - fxmh = feval(f,x-h,varargin{:}); - velocity = (fxph - fxmh)/(2*h); - acceleration = (fxph - 2*fx + fxmh)/(h^2); - x = x - velocity/abs(acceleration); - endwhile -endfunction
--- a/main/optim/numgradient.cc Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,155 +0,0 @@ -// Copyright (C) 2004, 2006 Michael Creel <michael.creel@uab.es> -// -// This program 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 of the License, or -// (at your option) any later version. -// -// This program 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 this program; if not, write to the Free Software -// Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - -// numgradient: numeric central difference gradient - -#include <oct.h> -#include <octave/parse.h> -#include <octave/lo-mappers.h> -#include <octave/Cell.h> -#include <float.h> - -// argument checks -static bool -any_bad_argument(const octave_value_list& args) -{ - if (!args(0).is_string()) - { - error("numgradient: first argument must be string holding objective function name"); - return true; - } - - if (!args(1).is_cell()) - { - error("numgradient: second argument must cell array of function arguments"); - return true; - } - - // minarg, if provided - if (args.length() == 3) - { - int tmp = args(2).int_value(); - if (error_state) - { - error("numgradient: 3rd argument, if supplied, must an integer\n\ -that specifies the argument wrt which differentiation is done"); - return true; - } - if ((tmp > args(1).length())||(tmp < 1)) - { - error("numgradient: 3rd argument must be a positive integer that indicates \n\ -which of the elements of the second argument is the\n\ -one to differentiate with respect to"); - return true; - } - } - return false; -} - - -DEFUN_DLD(numgradient, args, , "numgradient(f, {args}, minarg)\n\ -\n\ -Numeric central difference gradient of f with respect\n\ -to argument \"minarg\".\n\ -* first argument: function name (string)\n\ -* second argument: all arguments of the function (cell array)\n\ -* third argument: (optional) the argument to differentiate w.r.t.\n\ - (scalar, default=1)\n\ -\n\ -\"f\" may be vector-valued. If \"f\" returns\n\ -an n-vector, and the argument is a k-vector, the gradient\n\ -will be an nxk matrix\n\ -\n\ -Example:\n\ -function a = f(x);\n\ - a = [x'*x; 2*x];\n\ -endfunction\n\ -numgradient(\"f\", {ones(2,1)})\n\ -ans =\n\ -\n\ - 2.00000 2.00000\n\ - 2.00000 0.00000\n\ - 0.00000 2.00000\n\ -") -{ - int nargin = args.length(); - if (!((nargin == 2)|| (nargin == 3))) - { - error("numgradient: you must supply 2 or 3 arguments"); - return octave_value_list(); - } - - // check the arguments - if (any_bad_argument(args)) return octave_value_list(); - - std::string f (args(0).string_value()); - Cell f_args (args(1).cell_value()); - octave_value_list c_args(2,1); // for cellevall {f, f_args} - octave_value_list f_return; - c_args(0) = f; - c_args(1) = f_args; - Matrix obj_value, obj_left, obj_right; - double SQRT_EPS, p, delta, diff; - int i, j, minarg, test; - - // Default values for controls - minarg = 1; // by default, first arg is one over which we minimize - - // possibly minimization not over 1st arg - if (args.length() == 3) minarg = args(2).int_value(); - Matrix parameter = f_args(minarg - 1).matrix_value(); - - // initial function value - f_return = feval("celleval", c_args); - obj_value = f_return(0).matrix_value(); - - const int n = obj_value.rows(); // find out dimension - const int k = parameter.rows(); - Matrix derivative(n, k); - Matrix columnj; - - for (j=0; j<k; j++) // get 1st derivative by central difference - { - p = parameter(j); - - // determine delta for finite differencing - SQRT_EPS = sqrt(DBL_EPSILON); - diff = exp(log(DBL_EPSILON)/3); - test = (fabs(p) + SQRT_EPS) * SQRT_EPS > diff; - if (test) delta = (fabs(p) + SQRT_EPS) * SQRT_EPS; - else delta = diff; - - // right side - parameter(j) = p + delta; - f_args(minarg - 1) = parameter; - c_args(1) = f_args; - f_return = feval("celleval", c_args); - obj_right = f_return(0).matrix_value(); - - // left size - parameter(j) = p - delta; - f_args(minarg - 1) = parameter; - c_args(1) = f_args; - f_return = feval("celleval", c_args); - obj_left = f_return(0).matrix_value(); - - parameter(j) = p; // restore original parameter - columnj = (obj_right - obj_left) / (2*delta); - for (i=0; i<n; i++) derivative(i, j) = columnj(i); - } - - return octave_value(derivative); -}
--- a/main/optim/numhessian.cc Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,208 +0,0 @@ -// Copyright (C) 2004, 2006 Michael Creel <michael.creel@uab.es> -// -// This program 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 of the License, or -// (at your option) any later version. -// -// This program 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 this program; if not, write to the Free Software -// Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - -// numhessian: numeric second derivative - -#include <oct.h> -#include <octave/parse.h> -#include <octave/lo-mappers.h> -#include <octave/Cell.h> -#include <float.h> - -// argument checks -static bool -any_bad_argument(const octave_value_list& args) -{ - if (!args(0).is_string()) - { - error("numhessian: first argument must be string holding objective function name"); - return true; - } - - if (!args(1).is_cell()) - { - error("numhessian: second argument must cell array of function arguments"); - return true; - } - - // minarg, if provided - if (args.length() == 3) - { - int tmp = args(2).int_value(); - if (error_state) - { - error("numhessian: 3rd argument, if supplied, must an integer\n\ -that specifies the argument wrt which differentiation is done"); - return true; - } - if ((tmp > args(1).length())||(tmp < 1)) - { - error("numhessian: 3rd argument must be a positive integer that indicates \n\ -which of the elements of the second argument is the\n\ -one to differentiate with respect to"); - return true; - } - } - return false; -} - - - -DEFUN_DLD(numhessian, args, , - "numhessian(f, {args}, minarg)\n\ -\n\ -Numeric second derivative of f with respect\n\ -to argument \"minarg\".\n\ -* first argument: function name (string)\n\ -* second argument: all arguments of the function (cell array)\n\ -* third argument: (optional) the argument to differentiate w.r.t.\n\ - (scalar, default=1)\n\ -\n\ -If the argument\n\ -is a k-vector, the Hessian will be a kxk matrix\n\ -\n\ -function a = f(x, y)\n\ - a = x'*x + log(y);\n\ -endfunction\n\ -\n\ -numhessian(\"f\", {ones(2,1), 1})\n\ -ans =\n\ -\n\ - 2.0000e+00 -7.4507e-09\n\ - -7.4507e-09 2.0000e+00\n\ -\n\ -Now, w.r.t. second argument:\n\ -numhessian(\"f\", {ones(2,1), 1}, 2)\n\ -ans = -1.0000\n\ -") -{ - int nargin = args.length(); - if (!((nargin == 2)|| (nargin == 3))) - { - error("numhessian: you must supply 2 or 3 arguments"); - return octave_value_list(); - } - - // check the arguments - if (any_bad_argument(args)) return octave_value_list(); - - std::string f (args(0).string_value()); - Cell f_args (args(1).cell_value()); - octave_value_list c_args(2,1); // for cellevall {f, f_args} - octave_value_list f_return; - c_args(0) = f; - c_args(1) = f_args; - int i, j, minarg; - bool test; - double di, hi, pi, dj, hj, pj, hia, hja, fpp, fmm, fmp, fpm, obj_value, SQRT_EPS, diff; - - // Default values for controls - minarg = 1; // by default, first arg is one over which we minimize - - // possibly minimization not over 1st arg - if (args.length() == 3) minarg = args(2).int_value(); - - Matrix parameter = f_args(minarg - 1).matrix_value(); - const int k = parameter.rows(); - Matrix derivative(k, k); - - f_return = feval("celleval", c_args); - obj_value = f_return(0).double_value(); - - diff = exp(log(DBL_EPSILON)/4); - SQRT_EPS = sqrt(DBL_EPSILON); - - - for (i = 0; i<k;i++) // approximate 2nd deriv. by central difference - { - pi = parameter(i); - test = (fabs(pi) + SQRT_EPS) * SQRT_EPS > diff; - if (test) hi = (fabs(pi) + SQRT_EPS) * SQRT_EPS; - else hi = diff; - - - for (j = 0; j < i; j++) // off-diagonal elements - { - pj = parameter(j); - test = (fabs(pj) + SQRT_EPS) * SQRT_EPS > diff; - if (test) hj = (fabs(pj) + SQRT_EPS) * SQRT_EPS; - else hj = diff; - - // +1 +1 - parameter(i) = di = pi + hi; - parameter(j) = dj = pj + hj; - hia = di - pi; - hja = dj - pj; - f_args(minarg - 1) = parameter; - c_args(1) = f_args; - f_return = feval("celleval", c_args); - fpp = f_return(0).double_value(); - - // -1 -1 - parameter(i) = di = pi - hi; - parameter(j) = dj = pj - hj; - hia = hia + pi - di; - hja = hja + pj - dj; - f_args(minarg - 1) = parameter; - c_args(1) = f_args; - f_return = feval("celleval", c_args); - fmm = f_return(0).double_value(); - - // +1 -1 - parameter(i) = pi + hi; - parameter(j) = pj - hj; - f_args(minarg - 1) = parameter; - c_args(1) = f_args; - f_return = feval("celleval", c_args); - fpm = f_return(0).double_value(); - - // -1 +1 - parameter(i) = pi - hi; - parameter(j) = pj + hj; - f_args(minarg - 1) = parameter; - c_args(1) = f_args; - f_return = feval("celleval", c_args); - fmp = f_return(0).double_value(); - - derivative(j,i) = ((fpp - fpm) + (fmm - fmp)) / (hia * hja); - derivative(i,j) = derivative(j,i); - parameter(j) = pj; - } - - // diagonal elements - - // +1 +1 - parameter(i) = di = pi + 2 * hi; - f_args(minarg - 1) = parameter; - c_args(1) = f_args; - f_return = feval("celleval", c_args); - fpp = f_return(0).double_value(); - hia = (di - pi) / 2; - - // -1 -1 - parameter(i) = di = pi - 2 * hi; - f_args(minarg - 1) = parameter; - c_args(1) = f_args; - f_return = feval("celleval", c_args); - fmm = f_return(0).double_value(); - hia = hia + (pi - di) / 2; - - derivative(i,i) = ((fpp - obj_value) + (fmm - obj_value)) / (hia * hia); - parameter(i) = pi; - } - - return octave_value(derivative); -}
--- a/main/optim/optimset.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,64 +0,0 @@ -## Copyright (C) 2002 Etienne Grossmann. All rights reserved. -## -## This program 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. -## -## This 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. - -## opt = optimset (...) - manipulate m*tlab-style options structure -## -## This function returns a m*tlab-style options structure that can be used -## with the fminunc() function. -## -## INPUT : Input consist in one or more structs followed by option-value -## pairs. The option that can be passed are those of m*tlab's 'optimset'. -## Whether fminunc() accepts them is another question (see fminunc()). -## -## Two extra options are supported which indicate how to use directly octave -## optimization tools (such as minimize() and other backends): -## -## "MinEquiv", [on|off] : Tell 'fminunc()' not to minimize 'fun', but -## instead return the option passed to minimize(). -## -## "Backend", [on|off] : Tell 'fminunc()' not to minimize 'fun', but -## instead return the [backend, opt], the name of the -## backend optimization function that is used and the -## optional arguments that will be passed to it. See -## the 'backend' option of minimize(). -## -function opt = optimset (varargin) - -## Diagnostics , ["on"|{"off"}] : -## DiffMaxChange, [scalar>0] : N/A (I don't know what it does) -## DiffMinChange, [scalar>0] : N/A (I don't know what it does) -## Display , ["off","iter","notify","final"] -## : N/A - -args = varargin; - -opt = struct (); - - # Integrate all leading structs - -while length (args) && isstruct (o = nth (args, 1)) - - args = args(2:length(args)); # Remove 1st element of args - # Add key/value pairs - for [v,k] = o, opt = setfield (opt,k,v); end -end - -## All the option -op1 = [" DerivativeCheck Diagnostics DiffMaxChange DiffMinChange",\ - " Display GoalsExactAchieve GradConstr GradObj Hessian HessMult",\ - " HessPattern HessUpdate Jacobian JacobMult JacobPattern",\ - " LargeScale LevenbergMarquardt LineSearchType MaxFunEvals MaxIter",\ - " MaxPCGIter MeritFunction MinAbsMax PrecondBandWidth TolCon",\ - " TolFun TolPCG TolX TypicalX ",\ - " MinEquiv Backend "]; - -opt = read_options (args, "op1",op1, "default",opt,"prefix",1,"nocase",1);
--- a/main/optim/poly_2_ex.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,51 +0,0 @@ -## Copyright (C) 2002 Etienne Grossmann. All rights reserved. -## -## This program 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. -## -## This 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. - -## ex = poly_2_ex (l, f) - Extremum of a 1-var deg-2 polynomial -## -## l : 3 : Values of variable at which polynomial is known. -## f : 3 : f(i) = Value of the degree-2 polynomial at l(i). -## -## ex : 1 : Value for which f reaches its extremum -## -## Assuming that f(i) = a*l(i)^2 + b*l(i) + c = P(l(i)) for some a, b, c, -## ex is the extremum of the polynome P. -## -function ex = poly_2_ex (l, f) - - -### This somewhat helps if solution is very close to one of the points. -[f,i] = sort (f); -l = l(i); - - -m = (l(2) - l(1))/(l(3) - l(1)); -d = (2*(f(1)*(m-1)+f(2)-f(3)*m)); -if abs (d) < eps, - printf ("poly_2_ex : divisor is small (solution at infinity)\n"); - printf ("%8.3e %8.3e %8.3e, %8.3e %8.3e\n",\ - f(1), diff (f), diff (sort (l))); - - ex = (2*(l(1)>l(2))-1)*inf; - ## keyboard -else - ex = ((l(3) - l(1))*((f(1)*(m^2-1) + f(2) - f(3)*m^2))) / d ; - -## Not an improvement -# n = ((l(2)+l(3))*(l(2)-l(3)) + 2*(l(3)-l(2))*l(1)) / (l(3)-l(1))^2 ; -# ex = ((l(3) - l(1))*((f(1)*n + f(2) - f(3)*m^2))) / \ -# (2*(f(1)*(m-1)+f(2)-f(3)*m)); -# if ex != ex0, -# ex - ex0 -# end - ex = l(1) + ex; -end \ No newline at end of file
--- a/main/optim/polyconf.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,138 +0,0 @@ -## [y,dy] = polyconf(p,x,s) -## -## Produce prediction intervals for the fitted y. The vector p -## and structure s are returned from polyfit or wpolyfit. The -## x values are where you want to compute the prediction interval. -## -## polyconf(...,['ci'|'pi']) -## -## Produce a confidence interval (range of likely values for the -## mean at x) or a prediction interval (range of likely values -## seen when measuring at x). The prediction interval tells -## you the width of the distribution at x. This should be the same -## regardless of the number of measurements you have for the value -## at x. The confidence interval tells you how well you know the -## mean at x. It should get smaller as you increase the number of -## measurements. Error bars in the physical sciences usually show -## a 1-alpha confidence value of erfc(1/sqrt(2)), representing -## one standandard deviation of uncertainty in the mean. -## -## polyconf(...,1-alpha) -## -## Control the width of the interval. If asking for the prediction -## interval 'pi', the default is .05 for the 95% prediction interval. -## If asking for the confidence interval 'ci', the default is -## erfc(1/sqrt(2)) for a one standard deviation confidence interval. -## -## Example: -## [p,s] = polyfit(x,y,1); -## xf = linspace(x(1),x(end),150); -## [yf,dyf] = polyconf(p,xf,s,'ci'); -## plot(xf,yf,'g-;fit;',xf,yf+dyf,'g.;;',xf,yf-dyf,'g.;;',x,y,'xr;data;'); -## plot(x,y-polyval(p,x),';residuals;',xf,dyf,'g-;;',xf,-dyf,'g-;;'); - -## Author: Paul Kienzle -## This program is granted to the public domain. -function [y,dy] = polyconf(p,x,varargin) - alpha = s = []; - typestr = 'pi'; - for i=1:length(varargin) - v = varargin{i}; - if isstruct(v), s = v; - elseif ischar(v), typestr = v; - elseif isscalar(v), alpha = v; - else s = []; - end - end - if (nargout>1 && (isempty(s)||nargin<3)) || nargin < 2 - usage("[y,dy] = polyconf(p,x,s,alpha,['ci'|'pi'])"); - end - - if isempty(s) - y = polyval(p,x); - - else - ## For a polynomial fit, x is the set of powers ( x^n ; ... ; 1 ). - n=length(p)-1; - k=length(x(:)); - if columns(s.R) == n, ## fit through origin - A = (x(:) * ones (1, n)) .^ (ones (k, 1) * (n:-1:1)); - p = p(1:n); - else - A = (x(:) * ones (1, n+1)) .^ (ones (k, 1) * (n:-1:0)); - endif - y = dy = x; - [y(:),dy(:)] = confidence(A,p,s,alpha,typestr); - - end -end - -%!test -%! # data from Hocking, RR, "Methods and Applications of Linear Models" -%! temperature=[40;40;40;45;45;45;50;50;50;55;55;55;60;60;60;65;65;65]; -%! strength=[66.3;64.84;64.36;69.70;66.26;72.06;73.23;71.4;68.85;75.78;72.57;76.64;78.87;77.37;75.94;78.82;77.13;77.09]; -%! [p,s] = polyfit(temperature,strength,1); -%! [y,dy] = polyconf(p,40,s,0.05,'ci'); -%! assert([y,dy],[66.15396825396826,1.71702862681486],200*eps); -%! [y,dy] = polyconf(p,40,s,0.05,'pi'); -%! assert(dy,4.45345484470743,200*eps); - -## [y,dy] = confidence(A,p,s) -## -## Produce prediction intervals for the fitted y. The vector p -## and structure s are returned from wsolve. The matrix A is -## the set of observation values at which to evaluate the -## confidence interval. -## -## confidence(...,['ci'|'pi']) -## -## Produce a confidence interval (range of likely values for the -## mean at x) or a prediction interval (range of likely values -## seen when measuring at x). The prediction interval tells -## you the width of the distribution at x. This should be the same -## regardless of the number of measurements you have for the value -## at x. The confidence interval tells you how well you know the -## mean at x. It should get smaller as you increase the number of -## measurements. Error bars in the physical sciences usually show -## a 1-alpha confidence value of erfc(1/sqrt(2)), representing -## one standandard deviation of uncertainty in the mean. -## -## confidence(...,1-alpha) -## -## Control the width of the interval. If asking for the prediction -## interval 'pi', the default is .05 for the 95% prediction interval. -## If asking for the confidence interval 'ci', the default is -## erfc(1/sqrt(2)) for a one standard deviation confidence interval. -## -## Confidence intervals for linear system are given by: -## x' p +/- sqrt( Finv(1-a,1,df) var(x' p) ) -## where for confidence intervals, -## var(x' p) = sigma^2 (x' inv(A'A) x) -## and for prediction intervals, -## var(x' p) = sigma^2 (1 + x' inv(A'A) x) -## -## Rather than A'A we have R from the QR decomposition of A, but -## R'R equals A'A. Note that R is not upper triangular since we -## have already multiplied it by the permutation matrix, but it -## is invertible. Rather than forming the product R'R which is -## ill-conditioned, we can rewrite x' inv(A'A) x as the equivalent -## x' inv(R) inv(R') x = t t', for t = x' inv(R) -## Since x is a vector, t t' is the inner product sumsq(t). -## Note that LAPACK allows us to do this simultaneously for many -## different x using sqrt(sumsq(X/R,2)), with each x on a different row. -## -## Note: sqrt(F(1-a;1,df)) = T(1-a/2;df) -## -## For non-linear systems, use x = dy/dp and ignore the y output. -function [y,dy] = confidence(A,p,S,alpha,typestr) - if nargin < 4, alpha = []; end - if nargin < 5, typestr = 'ci'; end - y = A*p(:); - switch typestr, - case 'ci', pred = 0; default_alpha=erfc(1/sqrt(2)); - case 'pi', pred = 1; default_alpha=0.05; - otherwise, error("use 'ci' or 'pi' for interval type"); - end - if isempty(alpha), alpha = default_alpha; end - s = t_inv(1-alpha/2,S.df)*S.normr/sqrt(S.df); - dy = s*sqrt(pred+sumsq(A/S.R,2));
--- a/main/optim/rosenbrock.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,31 +0,0 @@ -# Copyright (C) 2004 Michael Creel <michael.creel@uab.es> -# -# This program 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 of the License, or -# (at your option) any later version. -# -# This program 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 this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - -# Rosenbrock function - used to create example obj. fns. -# -# Function value and gradient vector of the rosenbrock function -# The minimizer is at the vector (1,1,..,1), -# and the minimized value is 0. -# -function [obj_value, gradient] = rosenbrock(x); - dimension = length(x); - obj_value = sum(100*(x(2:dimension)-x(1:dimension-1).^2).^2 + (1-x(1:dimension-1)).^2); - if nargout > 1 - gradient = zeros(dimension, 1); - gradient(1:dimension-1) = - 400*x(1:dimension-1).*(x(2:dimension)-x(1:dimension-1).^2) - 2*(1-x(1:dimension-1)); - gradient(2:dimension) = gradient(2:dimension) + 200*(x(2:dimension)-x(1:dimension-1).^2); - endif -endfunction
--- a/main/optim/samin.cc Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,673 +0,0 @@ -// Copyright (C) 2004 Michael Creel <michael.creel@uab.es> -// -// This program 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 of the License, or -// (at your option) any later version. -// -// This program 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 this program; if not, write to the Free Software -// Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -// simann.cc (c) 2004 Michael Creel <michael.creel@uab.es> -// References: -// -// The code follows this article: -// Goffe, William L. (1996) "SIMANN: A Global Optimization Algorithm -// using Simulated Annealing " Studies in Nonlinear Dynamics & Econometrics -// Oct96, Vol. 1 Issue 3. -// -// The code uses the same names for control variables, -// for the most part. A notable difference is that the initial -// temperature is found automatically to ensure that the active -// bounds when the temperature begins to reduce cover the entire -// parameter space (defined as a n-dimensional -// rectangle that is the Cartesian product of the -// (lb_i, ub_i), i = 1,2,..n -// -// Also of note: -// Corana et. al., (1987) "Minimizing Multimodal Functions of Continuous -// Variables with the "Simulated Annealing" Algorithm", -// ACM Transactions on Mathematical Software, V. 13, N. 3. -// -// Goffe, et. al. (1994) "Global Optimization of Statistical Functions -// with Simulated Annealing", Journal of Econometrics, -// V. 60, N. 1/2. - - -#include <oct.h> -#include <octave/parse.h> -#include <octave/Cell.h> -#include <octave/lo-mappers.h> -#include <octave/oct-rand.h> -#include <float.h> -#include "error.h" - -// define argument checks -static bool -any_bad_argument(const octave_value_list& args) -{ - - // objective function name is a string? - if (!args(0).is_string()) - { - error("samin: first argument must be string holding objective function name"); - return true; - } - - // are function arguments contained in a cell? - if (!args(1).is_cell()) - { - error("samin: second argument must cell array of function arguments"); - return true; - } - - // is control a cell? - Cell control (args(2).cell_value()); - if (error_state) - { - error("samin: third argument must cell array of algorithm controls"); - return true; - } - - // does control have proper number of elements? - if (!(control.length() == 11)) - { - error("samin: third argument must be a cell array with 11 elements"); - return true; - } - - // now check type of each element of control - if (!(control(0).is_real_matrix()) || (control(0).is_real_scalar())) - { - error("samin: 1st element of controls must be LB: a vector of lower bounds"); - return true; - } - - if ((control(0).is_real_matrix()) && (control(0).columns() != 1)) - { - error("samin: 1st element of controls must be LB: a vector of lower bounds"); - return true; - } - - if (!(control(1).is_real_matrix()) || (control(1).is_real_scalar())) - { - error("samin: 1st element of controls must be UB: a vector of lower bounds"); - return true; - } - - if ((control(1).is_real_matrix()) && (control(1).columns() != 1)) - { - error("samin: 2nd element of controls must be UB: a vector of lower bounds"); - return true; - } - - int tmp = control(2).int_value(); - if (error_state || tmp < 1) - { - error("samin: 3rd element of controls must be NT: positive integer\n\ -loops per temperature reduction"); - return true; - } - - tmp = control(3).int_value(); - if (error_state || tmp < 1) - { - error("samin: 4th element of controls must be NS: positive integer\n\ -loops per stepsize adjustment"); - return true; - } - - double tmp2 = control(4).double_value(); - if (error_state || tmp < 0) - { - error("samin: 5th element of controls must be RT:\n\ -temperature reduction factor, RT > 0"); - return true; - } - - tmp2 = control(5).double_value(); - if (error_state || tmp < 0) - { - error("samin: 6th element of controls must be integer MAXEVALS > 0 "); - return true; - } - - tmp = control(6).int_value(); - if (error_state || tmp < 0) - { - error("samin: 7th element of controls must be NEPS: positive integer\n\ -number of final obj. values that must be within EPS of eachother "); - return true; - } - - tmp2 = control(7).double_value();if (error_state || tmp2 < 0) - { - error("samin: 8th element of controls must must be FUNCTOL (> 0)\n\ -used to compare the last NEPS obj values for convergence test"); - return true; - } - - tmp2 = control(8).double_value(); - if (error_state || tmp2 < 0) - { - error("samin: 9th element of controls must must be PARAMTOL (> 0)\n\ -used to compare the last NEPS obj values for convergence test"); - return true; - } - - tmp = control(9).int_value(); - if (error_state || tmp < 0 || tmp > 2) - { - error("samin: 9th element of controls must be VERBOSITY (0, 1, or 2)"); - return true; - } - - tmp = control(10).int_value(); - if (error_state || tmp < 0) - { - error("samin: 10th element of controls must be MINARG (integer)\n\ - position of argument to minimize wrt"); - return true; - } - - // make sure that minarg points to an existing element - if ((tmp > args(1).length())||(tmp < 1)) - { - error("bfgsmin: 4th argument must be a positive integer that indicates \n\ -which of the elements of the second argument is the one minimization is over"); - return true; - } - - return false; -} - - -//-------------- The annealing algorithm -------------- -DEFUN_DLD(samin, args, , - "samin: simulated annealing minimization of a function. See samin_example.m\n\ -\n\ -[x, obj, convergence] = samin(\"f\", {args}, {control})\n\ -\n\ -Arguments:\n\ -* \"f\": function name (string)\n\ -* {args}: a cell array that holds all arguments of the function,\n\ -* {control}: a cell array with 11 elements\n\ - * LB - vector of lower bounds\n\ - * UB - vector of upper bounds\n\ - * nt - integer: # of iterations between temperature reductions\n\ - * ns - integer: # of iterations between bounds adjustments\n\ - * rt - 0 < rt <1: temperature reduction factor\n\ - * maxevals - integer: limit on function evaluations\n\ - * neps - integer: # number of values final result is compared to\n\ - * functol - > 0: the required tolerance level for function value comparisons\n\ - * paramtol - > 0: the required tolerance level for parameters\n\ - * verbosity - scalar: 0, 1, or 2.\n\ - * 0 = no screen output\n\ - * 1 = summary every temperature change\n\ - * 2 = only final results to screen\n\ - * minarg - integer: which of function args is minimization over?\n\ -\n\ -Returns:\n\ -* x: the minimizer\n\ -* obj: the value of f() at x\n\ -* convergence: 1 if normal conv, other values if not\n\ -\n\ -Example: A really stupid way to calculate pi\n\ -function a = f(x)\n\ - a = cos(x) + 0.01*(x-pi)^2;\n\ -endfunction\n\ -\n\ -Set up the controls:\n\ -ub = 20;\n\ -lb = -ub;\n\ -nt = 20;\n\ -ns = 5;\n\ -rt = 0.5;\n\ -maxevals = 1e10;\n\ -neps = 5;\n\ -functol = 1e-10;\n\ -paramtol = 1e-5;\n\ -verbosity = 2;\n\ -minarg = 1;\n\ -\n\ -Put them in a cell array:\n\ -control = {lb, ub, nt, ns, rt, maxevals,\n\ - neps, functol, paramtol, verbosity, minarg};\n\ -\n\ -Call the minimizer (function argument also in cell array):\n\ -samin(\"f\", {-8}, control)\n\ -\n\ -The result:\n\ -================================================\n\ -SAMIN final results\n\ -Sucessful convergence to tolerance 0.000010\n\ -\n\ -Obj. fn. value -1.000000\n\ - parameter search width\n\ - 3.141597 0.002170\n\ -================================================\n\ -ans = 3.1416\n\ -") -{ - int nargin = args.length(); - if (!(nargin == 3)) - { - error("samin: you must supply 3 arguments"); - return octave_value_list(); - } - - // check the arguments - if (any_bad_argument(args)) return octave_value_list(); - - std::string obj_fn (args(0).string_value()); - Cell f_args (args(1).cell_value()); - Cell control (args(2).cell_value()); - - octave_value_list c_args(2,1); // for cellevall {f, f_args} - octave_value_list f_return; // holder for feval returns - - int m, i, j, h, n, nacc, func_evals; - int nup, nrej, nnew, ndown, lnobds; - int converge, test; - - // user provided controls - const Matrix lb (control(0).matrix_value()); - const Matrix ub (control(1).matrix_value()); - const int nt (control(2).int_value()); - const int ns (control(3).int_value()); - const double rt (control(4).double_value()); - const double maxevals (control(5).double_value()); - const int neps (control(6).int_value()); - const double functol (control(7).double_value()); - const double paramtol (control(8).double_value()); - const int verbosity (control(9).int_value()); - const int minarg (control(10).int_value()); - - - double f, fp, p, pp, fopt, rand_draw, ratio, t; - - // type checking for minimization parameter done here, since we don't know minarg - // until now - if (!(f_args(minarg - 1).is_real_matrix() || (f_args(minarg - 1).is_real_scalar()))) - { - error("samin: minimization must be with respect to a column vector"); - return octave_value_list(); - } - if ((f_args(minarg - 1).is_real_matrix()) && (f_args(minarg - 1).columns() != 1)) - { - error("samin: minimization must be with respect to a column vector"); - return octave_value_list(); - } - - Matrix x = f_args(minarg - 1).matrix_value(); - Matrix bounds = ub - lb; - n = x.rows(); - Matrix xopt = x; - Matrix xp(n, 1); - Matrix nacp(n,1); - - // Set initial values - nacc = 0; - func_evals = 0; - - Matrix fstar(neps,1); - fstar.fill(1e20); - - - // check for out-of-bounds starting value - for(i = 0; i < n; i++) - { - if(( x(i) > ub(i)) || (x(i) < lb(i))) - { - error("samin: initial parameter %d out of bounds", i); - return octave_value_list(); - } - } - - // Initial obj_value - c_args(0) = obj_fn; - c_args(1) = f_args; - f_return = feval("celleval", c_args); - f = f_return(0).double_value(); - - fopt = f; - fstar(0) = f; - - // First stage: find initial temperature so that - // bounds grow to cover parameter space - t = 1000; - converge = 0; - while((converge==0) & t < sqrt(DBL_MAX)) - { - nup = 0; - nrej = 0; - nnew = 0; - ndown = 0; - lnobds = 0; - - // repeat nt times then adjust temperature - for(m = 0;m < nt;m++) - { - // repeat ns times, then adjust bounds - for(j = 0;j < ns;j++) - { - // generate new point by taking last - // and adding a random value to each of elements, - // in turn - for(h = 0;h < n;h++) - { - xp = x; - f_return = feval("rand"); - rand_draw = f_return(0).double_value(); - xp(h) = x(h) + (2.0 * rand_draw - 1.0) * bounds(h); - if((xp(h) < lb(h)) || (xp(h) > ub(h))) - { - xp(h) = lb(h) + (ub(h) - lb(h)) * rand_draw; - lnobds = lnobds + 1; - } - - // Evaluate function at new point - f_args(minarg - 1) = xp; - c_args(1) = f_args; - f_return = feval("celleval", c_args); - fp = f_return(0).double_value(); - func_evals = func_evals + 1; - - // If too many function evaluations occur, terminate the algorithm. - if(func_evals >= maxevals) - { - warning("samin: NO CONVERGENCE: MAXEVALS exceeded before initial temparature found"); - if(verbosity >= 1) - { - printf("\n================================================\n"); - printf("SAMIN results\n"); - printf("NO CONVERGENCE: MAXEVALS exceeded\n"); - printf("Stage 1, increasing temperature\n"); - printf("\nObj. fn. value %f\n", fopt); - printf(" parameter search width\n"); - for(i = 0; i < n; i++) printf("%20f%20f\n", xopt(i), bounds(i)); - printf("================================================\n"); - } - f_return(0) = xopt; - f_return(1) = fopt; - f_return(2) = 0; - return octave_value_list(f_return); - } - - // Accept the new point if the function value decreases - if(fp <= f) - { - x = xp; - f = fp; - nacc = nacc + 1; - nacp(h) = nacp(h) + 1; - nup = nup + 1; - - // If greater than any other point, record as new optimum. - if(fp < fopt) - { - xopt = xp; - fopt = fp; - nnew = nnew + 1; - } - } - - // If the point is higher, use the Metropolis criteria to decide on - // acceptance or rejection. - else - { - p = exp(-(fp - f) / t); - f_return = feval("rand"); - rand_draw = f_return(0).double_value(); - if(rand_draw < p) - { - x = xp; - f = fp; - nacc = nacc + 1; - nacp(h) = nacp(h) + 1; - ndown = ndown + 1; - } - else nrej = nrej + 1; - } - } - } - - // Adjust bounds so that approximately half of all evaluations are accepted. - test = 0; - for(i = 0;i < n;i++) - { - ratio = nacp(i) / ns; - if(ratio > 0.6) bounds(i) = bounds(i) * (1.0 + 2.0 * (ratio - 0.6) / 0.4); - else if(ratio < .4) bounds(i) = bounds(i) / (1.0 + 2.0 * ((0.4 - ratio) / 0.4)); - // keep within initial bounds - if(bounds(i) >= (ub(i) - lb(i))) - { - test = test + 1; // when this gets to n, we're done with fist stage - bounds(i) = ub(i) - lb(i); - } - } - nacp.fill(0.0); - converge = (test == n); - } - - if(verbosity == 1) - { - printf("\nFirst stage: Increasing temperature to cover parameter space\n"); - printf("\nTemperature %e", t); - printf("\nmin function value so far %f", fopt); - printf("\ntotal evaluations so far %d", func_evals); - printf("\ntotal moves since temp change %d", nup + ndown + nrej); - printf("\ndownhill %d", nup); - printf("\naccepted uphill %d", ndown); - printf("\nrejected uphill %d", nrej); - printf("\nout of bounds trials %d", lnobds); - printf("\nnew minima this temperature %d", nnew); - printf("\n\n parameter search width\n"); - for(i = 0; i < n; i++) printf("%20f%20f\n", xopt(i), bounds(i)); - printf("\n"); - } - - // Increase temperature quickly - t = t*t; - for(i = neps-1; i > 0; i--) fstar(i) = fstar(i-1); - f = fopt; - x = xopt; - } - - // Second stage: temperature reduction loop - converge = 0; - while(converge==0) - { - nup = 0; - nrej = 0; - nnew = 0; - ndown = 0; - lnobds = 0; - - // repeat nt times then adjust temperature - for(m = 0;m < nt;m++) - { - // repeat ns times, then adjust bounds - for(j = 0;j < ns;j++) - { - // generate new point by taking last - // and adding a random value to each of elements, - // in turn - for(h = 0;h < n;h++) - { - xp = x; - f_return = feval("rand"); - rand_draw = f_return(0).double_value(); - xp(h) = x(h) + (2.0 * rand_draw - 1.0) * bounds(h); - if((xp(h) < lb(h)) || (xp(h) > ub(h))) - { - xp(h) = lb(h) + (ub(h) - lb(h)) * rand_draw; - lnobds = lnobds + 1; - } - - // Evaluate function at new point - f_args(minarg - 1) = xp; - c_args(1) = f_args; - f_return = feval("celleval", c_args); - fp = f_return(0).double_value(); - func_evals = func_evals + 1; - - // If too many function evaluations occur, terminate the algorithm - if(func_evals >= maxevals) - { - warning("samin: NO CONVERGENCE: maxevals exceeded"); - if(verbosity >= 1) - { - printf("\n================================================\n"); - printf("SAMIN results\n"); - printf("NO CONVERGENCE: MAXEVALS exceeded\n"); - printf("Stage 2, decreasing temperature\n"); - printf("\nObj. fn. value %f\n", fopt); - printf(" parameter search width\n"); - for(i = 0; i < n; i++) printf("%20f%20f\n", xopt(i), bounds(i)); - printf("================================================\n"); - } - f_return(0) = xopt; - f_return(1) = fopt; - f_return(2) = 0; - return octave_value_list(f_return); - } - - // Accept the new point if the function value decreases - if(fp <= f) - { - x = xp; - f = fp; - nacc = nacc + 1; - nacp(h) = nacp(h) + 1; - nup = nup + 1; - // If greater than any other point, record as new optimum - if(fp < fopt) - { - xopt = xp; - fopt = fp; - nnew = nnew + 1; - } - } - - // If the point is higher, use the Metropolis criteria to decide on - // acceptance or rejection. - else - { - p = exp(-(fp - f) / t); - f_return = feval("rand"); - rand_draw = f_return(0).double_value(); - if(rand_draw < p) - { - x = xp; - f = fp; - nacc = nacc + 1; - nacp(h) = nacp(h) + 1; - ndown = ndown + 1; - } - else nrej = nrej + 1; - } - } - } - - // Adjust bounds so that approximately half of all evaluations are accepted - for(i = 0;i < n;i++) - { - ratio = nacp(i) / ns; - if(ratio > 0.6) bounds(i) = bounds(i) * (1.0 + 2.0 * (ratio - 0.6) / 0.4); - else if(ratio < .4) bounds(i) = bounds(i) / (1.0 + 2.0 * ((0.4 - ratio) / 0.4)); - // keep within initial bounds - if(bounds(i) > (ub(i) - lb(i))) bounds(i) = ub(i) - lb(i); - } - nacp.fill(0.0); - } - if(verbosity == 1) - { - printf("\nIntermediate results before next temperature reduction\n"); - printf("\nTemperature %e", t); - printf("\nmin function value so far %f", fopt); - printf("\ntotal evaluations so far %d", func_evals); - printf("\ntotal moves since last temp reduction %d", nup + ndown + nrej); - printf("\ndownhill %d", nup); - printf("\naccepted uphill %d", ndown); - printf("\nrejected uphill %d", nrej); - printf("\nout of bounds trials %d", lnobds); - printf("\nnew minima this temperature %d", nnew); - printf("\n\n parameter search width\n"); - for(i = 0; i < n; i++) printf("%20f%20f\n", xopt(i), bounds(i)); - printf("\n"); - } - - // Check for convergence - // current function value must be within "tol" - // of last "neps" (an integer) function values, - // AND the last "neps" function values - // must be withing tol of overall best - fstar(0) = f; - test = 0; - for(i = 0; i < neps; i++) test = test + fabs(f - fstar(i)) > functol; - test = (test > 0); // if different from zero, function conv. has failed - if( ((fopt - fstar(0)) <= functol) && (!test)) - { - // check for bound narrow enough for parameter convergence - converge = 1; - for(i = 0;i < n;i++) - { - if(bounds(i) > paramtol) - { - converge = 0; // no conv. if bounds too wide - break; - } - } - } - - // check if too close to bounds, and change convergence message if so - if (converge) if (lnobds > 0) converge = 2; - - // Are we done yet? - if(converge>0) - { - if(verbosity >= 1) - { - printf("\n================================================\n"); - printf("SAMIN final results\n"); - if (converge == 1) printf("NORMAL CONVERGENCE\n\n"); - if (converge == 2) - { - printf("WARNING: last point satisfies conv. criteria, \n\ -but is too close to bounds of parameter space\n"); - printf("%f \% of last round evaluations out-of-bounds\n", 100*lnobds/(nup+ndown+nrej)); - printf("Expand bounds and re-run\n\n"); - } - printf("Func. tol. %e Param. tol. %e\n", functol, paramtol); - printf("Obj. fn. value %f\n\n", fopt); - printf(" parameter search width\n"); - for(i = 0; i < n; i++) printf("%20f%20f\n", xopt(i), bounds(i)); - printf("================================================\n"); - } - f_return(0) = xopt; - f_return(1) = fopt; - if (lnobds > 0) converge = 2; - f_return(2) = converge; - return octave_value_list(f_return); - } - - // Reduce temperature, record current function value in the - // list of last "neps" values, and loop again - t = rt * t; - for(i = neps-1; i > 0; i--) fstar(i) = fstar(i-1); - f = fopt; - x = xopt; - } - f_return(0) = xopt; - f_return(1) = fopt; - f_return(2) = converge; - return octave_value_list(f_return); -} - -
--- a/main/optim/samin_example.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,71 +0,0 @@ -# Copyright (C) 2004 Michael Creel <michael.creel@uab.es> -# -# This program 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 of the License, or -# (at your option) any later version. -# -# This program 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 this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - -# samin_example: example script that contains examples of how to call -# samin for minimization using simulated annealing. -# Edit the script to see how samin may be used. -# -# usage: samin_example - -1; # this is a script file - -# Example objective function -# remember that cos(0)=1, so -# "a" has a local minimum at 0 (each dimension) -# "b" makes the function value 0 at min -# "c" adds some curvature to make the min -# at (0,0,...,0) global. -# the closer is "curvature" to zero the more alike are -# the local mins, so the harder the global min is to find - -function f = obj(theta, curvature); - dim = rows(theta); - a = sum(exp(-cos(theta))); - b = - dim*exp(-1); - c = sum(curvature*theta .^ 2); - f = a + b + c; -endfunction - -k = 5; # dimensionality -theta = rand(k,1)*10 - 5; # random start value - -# if you set "curvature" very small, -# you will need to increase nt, ns, and rt -# to minimize sucessfully -curvature = 0.01; - - -# SA controls -ub = 10*ones(rows(theta),1); -lb = -ub; -nt = 20; -ns = 5; -rt = 0.5; # careful - this is too low for many problems -maxevals = 1e10; -neps = 5; -functol = 1e-10; -paramtol = 1e-3; -verbosity = 1; -minarg = 1; -control = { lb, ub, nt, ns, rt, maxevals, neps, functol, paramtol, verbosity, 1}; - - -# do sa -t=cputime(); -[theta, obj_value, convergence] = samin("obj", {theta, curvature}, control); -t = cputime() - t; -printf("Elapsed time = %f\n\n\n",t); -
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/src/Makefile Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,7 @@ +all: leval.oct __bfgsmin.oct celleval.oct numgradient.oct numhessian.oct samin.oct + +%.oct: %.cc + mkoctfile -s $< + +clean: + rm *.o core octave-core *.oct *~
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/src/__bfgsmin.cc Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,496 @@ +// Copyright (C) 2004,2005,2006 Michael Creel <michael.creel@uab.es> +// +// This program 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 of the License, or +// (at your option) any later version. +// +// This program 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 this program; if not, write to the Free Software +// Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +// the functions defined in this file are: +// __bfgsmin_obj: bulletproofed objective function that allows checking for availability of analytic gradient +// __numgradient: numeric gradient, used only if analytic not supplied +// __bisectionstep: fallback stepsize algorithm +// __newtonstep: default stepsize algorithm +// __bfgsmin: the DLD function that does the minimization, to be called from bfgsmin.m + + + +#include <oct.h> +#include <octave/parse.h> +#include <octave/Cell.h> +#include <float.h> +#include "error.h" + + +int __bfgsmin_obj(double &obj, std::string f, Cell f_args, ColumnVector theta, int minarg) +{ + octave_value_list f_return; + octave_value_list c_args(2,1); // for cellevall {f, f_args} + int success = 1; + + c_args(0) = f; + f_args(minarg - 1) = theta; + c_args(1) = f_args; + f_return = feval("celleval", c_args); + obj = f_return(0).double_value(); + // bullet-proof the objective function + if (error_state) + { + warning("__bfgsmin_obj: objective function could not be evaluated - setting to DBL_MAX"); + obj = DBL_MAX; + success = 0; + } + return success; +} + + +// __numgradient: numeric central difference gradient for bfgs. +// This is the same as numgradient, except the derivative is known to be a vector, it's defined as a column, +// and the finite difference delta is incorporated directly rather than called from a function +int __numgradient(ColumnVector &derivative, std::string f, Cell f_args, int minarg) +{ + double SQRT_EPS, diff, delta, obj_left, obj_right, p; + int j, test, success; + + ColumnVector parameter = f_args(minarg - 1).column_vector_value(); + + int k = parameter.rows(); + ColumnVector g(k); + + for (j=0; j<k; j++) // get 1st derivative by central difference + { + p = parameter(j); + // determine delta for finite differencing + SQRT_EPS = sqrt(DBL_EPSILON); + diff = exp(log(DBL_EPSILON)/3); + test = (fabs(p) + SQRT_EPS) * SQRT_EPS > diff; + if (test) delta = (fabs(p) + SQRT_EPS) * SQRT_EPS; + else delta = diff; + // right side + parameter(j) = p + delta; + success = __bfgsmin_obj(obj_right, f, f_args, parameter, minarg); + if (!success) error("__numgradient: objective function failed, can't compute numeric gradient"); + // left size + parameter(j) = p - delta; + success = __bfgsmin_obj(obj_left, f, f_args, parameter, minarg); + if (!success) error("__numgradient: objective function failed, can't compute numeric gradient"); parameter(j) = p; // restore original parameter for next round + g(j) = (obj_right - obj_left) / (2*delta); + } + derivative = g; + return success; +} + + +int __bfgsmin_gradient(ColumnVector &derivative, std::string f, Cell f_args, ColumnVector theta, int minarg, int try_analytic_gradient, int &have_analytic_gradient) { + octave_value_list f_return; + octave_value_list c_args(2,1); // for cellevall {f, f_args} + int k = theta.rows(); + int success; + ColumnVector g(k); + Matrix check_gradient(k,1); + + if (have_analytic_gradient) { + c_args(0) = f; + f_args(minarg - 1) = theta; + c_args(1) = f_args; + f_return = feval("celleval", c_args); + g = f_return(1).column_vector_value(); + } + + else if (try_analytic_gradient) { + c_args(0) = f; + f_args(minarg - 1) = theta; + c_args(1) = f_args; + f_return = feval("celleval", c_args); + if (f_return.length() > 1) { + if (f_return(1).is_real_matrix()) { + if ((f_return(1).rows() == k) & (f_return(1).columns() == 1)) { + g = f_return(1).column_vector_value(); + have_analytic_gradient = 1; + } + else have_analytic_gradient = 0; + } + else have_analytic_gradient = 0; + } + else have_analytic_gradient = 0; + if (!have_analytic_gradient) __numgradient(g, f, f_args, minarg); + } + else __numgradient(g, f, f_args, minarg); + + // check that gradient is ok + check_gradient.column(0) = g; + if (check_gradient.any_element_is_inf_or_nan()) { + error("__bfgsmin_gradient: gradient contains NaNs or Inf"); + success = 0; + } + else success = 1; + + derivative = g; + return success; +} + + +// this is the lbfgs direction, used if control has 5 elements +ColumnVector lbfgs_recursion(int memory, Matrix sigmas, Matrix gammas, ColumnVector d) +{ + if (memory == 0) + { + const int n = sigmas.columns(); + ColumnVector sig = sigmas.column(n-1); + ColumnVector gam = gammas.column(n-1); + // do conditioning if there is any memory + double cond = gam.transpose()*gam; + if (cond > 0) + { + cond = (sig.transpose()*gam) / cond; + d = cond*d; + } + return d; + } + else + { + const int k = d.rows(); + const int n = sigmas.columns(); + int i, j; + ColumnVector sig = sigmas.column(memory-1); + ColumnVector gam = gammas.column(memory-1); + double rho; + rho = 1.0 / (gam.transpose() * sig); + double alpha; + alpha = rho * (sig.transpose() * d); + d = d - alpha*gam; + d = lbfgs_recursion(memory - 1, sigmas, gammas, d); + d = d + (alpha - rho * gam.transpose() * d) * sig; + } + return d; +} + +// __bisectionstep: fallback stepsize method if __newtonstep fails +int __bisectionstep(double &step, double &obj, std::string f, Cell f_args, ColumnVector dx, int minarg, int verbose) +{ + double obj_0, a; + int found_improvement; + + ColumnVector x (f_args(minarg - 1).column_vector_value()); + + // initial values + obj_0 = obj; + a = 1.0; + found_improvement = 0; + + // this first loop goes until an improvement is found + while (a > 2*DBL_EPSILON) // limit iterations + { + __bfgsmin_obj(obj, f, f_args, x + a*dx, minarg); + // reduce stepsize if worse, or if function can't be evaluated + if ((obj >= obj_0) || lo_ieee_isnan(obj)) a = 0.5 * a; + else + { + obj_0 = obj; + found_improvement = 1; + break; + } + } + // If unable to find any improvement break out with stepsize zero + if (!found_improvement) + { + if (verbose) warning("bisectionstep: unable to find improvement, setting step to zero"); + step = 0.0; + obj = obj_0; + return found_improvement; + } + // now keep going until we no longer improve, or reach max trials + while (a > 2*DBL_EPSILON) + { + a = 0.5*a; + __bfgsmin_obj(obj, f, f_args, x + a*dx, minarg); + // if improved, record new best and try another step + if (obj < obj_0) obj_0 = obj; + else + { + a = a / 0.5; // put it back to best found + break; + } + } + step = a; + obj = obj_0; + return found_improvement; +} + +// __newtonstep: default stepsize algorithm +int __newtonstep(double &a, double &obj, std::string f, Cell f_args, ColumnVector dx, int minarg, int verbose) +{ + double obj_0, obj_left, obj_right, delta, inv_delta_sq, gradient, hessian; + int found_improvement = 0; + + ColumnVector x (f_args(minarg - 1).column_vector_value()); + + // initial value without step + __bfgsmin_obj(obj_0, f, f_args, x, minarg); + + delta = 0.001; // experimentation show that this is a good choice + inv_delta_sq = 1.0 / (delta*delta); + ColumnVector x_right = x + delta*dx; + ColumnVector x_left = x - delta*dx; + + // right + __bfgsmin_obj(obj_right, f, f_args, x_right, minarg); + // left + __bfgsmin_obj(obj_left, f, f_args, x_left, minarg); + + gradient = (obj_right - obj_left) / (2*delta); // take central difference + hessian = inv_delta_sq*(obj_right - 2*obj_0 + obj_left); + hessian = fabs(hessian); // ensures we're going in a decreasing direction + if (hessian < 2*DBL_EPSILON) hessian = 1.0; // avoid div by zero + a = - gradient / hessian; // hessian inverse gradient: the Newton step + if (a < 0) // since direction is descending, a must be positive + { // if it is not, go to bisection step + if (verbose) warning("__stepsize: no improvement with Newton step, falling back to bisection"); + found_improvement = __bisectionstep(a, obj, f, f_args, dx, minarg, verbose); + return 0; + } + + a = (a < 10.0)*a + 10.0*(a>=10.0); // Let's avoid extreme steps that might cause crashes + + // ensure that this is improvement + __bfgsmin_obj(obj, f, f_args, x + a*dx, minarg); + + // if not, fall back to bisection + if ((obj >= obj_0) || lo_ieee_isnan(obj)) + { + if (verbose) warning("__stepsize: no improvement with Newton step, falling back to bisection"); + found_improvement = __bisectionstep(a, obj, f, f_args, dx, minarg, verbose); + } + else found_improvement = 1; + + return found_improvement; +} + + + + +DEFUN_DLD(__bfgsmin, args, ,"__bfgsmin: backend for bfgs minimization\n\ +Users should not use this directly. Use bfgsmin.m instead") { + std::string f (args(0).string_value()); + Cell f_args (args(1).cell_value()); + octave_value_list f_return; // holder for return items + + int max_iters, verbosity, criterion, minarg, convergence, iter, memory, \ + gradient_ok, i, j, k, conv_fun, conv_param, conv_grad, have_gradient, \ + try_gradient, warnings; + double func_tol, param_tol, gradient_tol, stepsize, obj_value, obj_in, last_obj_value, denominator, test; + Matrix H, H1, H2; + ColumnVector thetain, d, g, g_new, p, q, sig, gam; + + // controls + Cell control (args(2).cell_value()); + max_iters = control(0).int_value(); + if (max_iters == -1) max_iters = INT_MAX; + verbosity = control(1).int_value(); + criterion = control(2).int_value(); + minarg = control(3).int_value(); + memory = control(4).int_value(); + func_tol = control(5).double_value(); + param_tol = control(6).double_value(); + gradient_tol = control(7).double_value(); + + // want to see warnings? + warnings = 0; + if (verbosity == 3) warnings = 1; + + // get the minimization argument + ColumnVector theta = f_args(minarg - 1).column_vector_value(); + k = theta.rows(); + + // containers for items in limited memory version + Matrix sigmas(k,memory); + Matrix gammas(k,memory); + + // initialize things + have_gradient = 0; // have analytic gradient + try_gradient = 1; // try to get analytic gradient + convergence = -1; // if this doesn't change, it means that maxiters were exceeded + thetain = theta; + H = identity_matrix(k,k); + + // Initial obj_value + __bfgsmin_obj(obj_in, f, f_args, theta, minarg); + + // Initial gradient (try analytic, and use it if it's close enough to numeric) + __bfgsmin_gradient(g, f, f_args, theta, minarg, 1, have_gradient); // try analytic + if (have_gradient) { // check equality if analytic available + have_gradient = 0; // force numeric + __bfgsmin_gradient(g_new, f, f_args, theta, minarg, 0, have_gradient); + p = g - g_new; + have_gradient = sqrt(p.transpose() * p) < gradient_tol; + } + + last_obj_value = obj_in; // initialize, is updated after each iteration + // MAIN LOOP STARTS HERE + for (iter = 0; iter < max_iters; iter++) { + // make sure the messages aren't stale + conv_fun = -1; + conv_param = -1; + conv_grad = -1; + + if(memory > 0) { // lbfgs + if (iter < memory) d = lbfgs_recursion(iter, sigmas, gammas, g); + else d = lbfgs_recursion(memory, sigmas, gammas, g); + d = -d; + } + else d = -H*g; // ordinary bfgs + + // stepsize: try (l)bfgs direction, then steepest descent if it fails + f_args(minarg - 1) = theta; + __newtonstep(stepsize, obj_value, f, f_args, d, minarg, warnings); + if (stepsize == 0.0) { // fall back to steepest descent + if (warnings) warning("bfgsmin: BFGS direction fails, switch to steepest descent"); + d = -g; // try steepest descent + __newtonstep(stepsize, obj_value, f, f_args, d, minarg, warnings); + if (stepsize == 0.0) { // if true, exit, we can't find a direction of descent + warning("bfgsmin: failure, exiting. Try different start values?"); + f_return(0) = theta; + f_return(1) = obj_value; + f_return(2) = -1; + f_return(3) = iter; + return octave_value_list(f_return); + } + } + p = stepsize*d; + + // check normal convergence: all 3 must be satisfied + // function convergence + if (fabs(last_obj_value) > 1.0) { + conv_fun = (fabs(obj_value - last_obj_value)/fabs(last_obj_value)) < func_tol; + } + else { + conv_fun = fabs(obj_value - last_obj_value) < func_tol; + } + // parameter change convergence + test = sqrt(theta.transpose() * theta); + if (test > 1) conv_param = sqrt(p.transpose() * p) / test < param_tol ; + else conv_param = sqrt(p.transpose() * p) < param_tol; // Want intermediate results? + // gradient convergence + conv_grad = sqrt(g.transpose() * g) < gradient_tol; + + // Want intermediate results? + if (verbosity > 1) { + printf("\n======================================================\n"); + printf("BFGSMIN intermediate results\n"); + printf("\n"); + if (memory > 0) printf("Using LBFGS, memory is last %d iterations\n",memory); + if (have_gradient) printf("Using analytic gradient\n"); + else printf("Using numeric gradient\n"); + printf("\n"); + printf("------------------------------------------------------\n"); + printf("Function conv %d Param conv %d Gradient conv %d\n", conv_fun, conv_param, conv_grad); + printf("------------------------------------------------------\n"); + printf("Objective function value %g\n", last_obj_value); + printf("Stepsize %g\n", stepsize); + printf("%d iterations\n", iter); + printf("------------------------------------------------------\n"); + printf("\n param gradient change\n"); + for (j = 0; j<k; j++) printf("%8.4f %8.4f %8.4f\n",theta(j),g(j),p(j)); + } + // Are we done? + if (criterion == 1) { + if (conv_fun && conv_param && conv_grad) { + convergence = 1; + break; + } + } + else if (conv_fun) { + convergence = 1; + break; + } + last_obj_value = obj_value; + theta = theta + p; + + // new gradient + gradient_ok = __bfgsmin_gradient(g_new, f, f_args, theta, minarg, try_gradient, have_gradient); + + if (memory == 0) { //bfgs? + // Hessian update if gradient ok + if (gradient_ok) { + q = g_new-g; + g = g_new; + denominator = q.transpose()*p; + if ((fabs(denominator) < DBL_EPSILON)) { // reset Hessian if necessary + if (verbosity == 1) printf("bfgsmin: Hessian reset\n"); + H = identity_matrix(k,k); + } + else { + H1 = (1.0+(q.transpose() * H * q) / denominator) / denominator \ + * (p * p.transpose()); + H2 = (p * q.transpose() * H + H*q*p.transpose()); + H2 = H2 / denominator; + H = H + H1 - H2; + } + } + else H = identity_matrix(k,k); // reset hessian if gradient fails + // then try to start again with steepest descent + } + else { // otherwise lbfgs + // save components for Hessian if gradient ok + if (gradient_ok) { + sig = p; // change in parameter + gam = g_new - g; // change in gradient + g = g_new; + // shift remembered vectors to the right (forget last) + for(j = memory - 1; j > 0; j--) { + for(i = 0; i < k; i++) { + sigmas(i,j) = sigmas(i,j-1); + gammas(i,j) = gammas(i,j-1); + } + } + // insert new vectors in left-most column + for(i = 0; i < k; i++) { + sigmas(i, 0) = sig(i); + gammas(i, 0) = gam(i); + } + } + else { // failed gradient - loose memory and use previous theta + sigmas.fill(0.0); + gammas.fill(0.0); + theta = theta - p; + } + } + } + + // Want last iteration results? + if (verbosity > 0) { + printf("\n======================================================\n"); + printf("BFGSMIN final results\n"); + printf("\n"); + if (memory > 0) printf("Used LBFGS, memory is last %d iterations\n",memory); + if (have_gradient) printf("Used analytic gradient\n"); + else printf("Used numeric gradient\n"); + printf("\n"); + printf("------------------------------------------------------\n"); + if (convergence == -1) printf("NO CONVERGENCE: max iters exceeded\n"); + if ((convergence == 1) & (criterion == 1)) printf("STRONG CONVERGENCE\n"); + if ((convergence == 1) & !(criterion == 1)) printf("WEAK CONVERGENCE\n"); + if (convergence == 2) printf("NO CONVERGENCE: algorithm failed\n"); + printf("Function conv %d Param conv %d Gradient conv %d\n", conv_fun, conv_param, conv_grad); + printf("------------------------------------------------------\n"); + printf("Objective function value %g\n", last_obj_value); + printf("Stepsize %g\n", stepsize); + printf("%d iterations\n", iter); + printf("------------------------------------------------------\n"); + printf("\n param gradient change\n"); + for (j = 0; j<k; j++) printf("%8.4f %8.4f %8.4f\n",theta(j),g(j),p(j)); + } + f_return(0) = theta; + f_return(1) = obj_value; + f_return(2) = convergence; + f_return(3) = iter; + return octave_value_list(f_return); +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/src/celleval.cc Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,69 @@ +// Copyright (C) 2004 Michael Creel <michael.creel@uab.es> +// +// This program 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 of the License, or +// (at your option) any later version. +// +// This program 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 this program; if not, write to the Free Software +// Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +// a descendant of "leval", by Etienne Grossman + +#include "config.h" +#include <oct.h> +#include <octave/parse.h> +#include <octave/Cell.h> +#include <octave/lo-mappers.h> + +DEFUN_DLD (celleval, args, nargout, "celleval (name, cell_array)\n\ +Evaluate the function named \"name\". All the elements in cell_array\n\ +are passed on to the named function.\n\ +Example:\n\ +function a = f(b,c)\n\ + a = b + c;\n\ +endfunction\n\ +celleval(\"f\", {1,2,\"this\"})\n\ +ans = 3\n\ +") +{ + octave_value_list retval; + int nargin = args.length (); + if (!(nargin == 2)) + { + error("celleval: you must supply exactly 2 arguments"); + return octave_value_list(); + } + if (!args(0).is_string()) + { + error ("celleval: first argument must be a string"); + return octave_value_list(); + } + if (!args(1).is_cell()) + { + error ("celleval: second argument must be a cell"); + return octave_value_list(); + } + + std::string name = args(0).string_value (); + Cell f_args_cell = args(1).cell_value (); + int k = f_args_cell.length(); + int i; + // a list to copy the cell contents into, so feval can be used + octave_value_list f_args(k,1); + + // copy contents over + for (i = 0; i<k; i++) f_args(i) = f_args_cell(i); + + // evaluate the function + retval = feval (name, f_args, nargout); + + return retval; +} +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/src/leval.cc Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,63 @@ +// Copyright (C) 2002 Etienne Grossmann. All rights reserved. +// +// This program 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. +// +// This 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. + + +#include "config.h" +#include <oct.h> +#include <octave/parse.h> + + +DEFUN_DLD (leval, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} leval (@var{name}, @var{list})\n\ +Evaluate the function named @var{name}. All the elements in @var{list}\n\ +are passed on to the named function. For example,\n\ +\n\ +@example\n\ +leval (\"acos\", list (-1))\n\ + @result{} 3.1416\n\ +@end example\n\ +\n\ +@noindent\n\ +calls the function @code{acos} with the argument @samp{-1}.\n\ +\n\ +The function @code{leval} provides provides more flexibility than\n\ +@code{feval} since arguments need not be hard-wired in the calling \n\ +code. @seealso{feval and eval}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 2) + { + std::string name = args(0).string_value (); + if (error_state) + error ("leval: first argument must be a string"); + + octave_value_list lst = args(1).list_value (); + if (error_state) + error ("leval: second argument must be a list"); + + retval = feval (name, lst, nargout); + + } + else + print_usage (); + + return retval; +} + +/* +%!assert(leval("acos", list(-1)), pi, 100*eps); + */
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/src/numgradient.cc Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,155 @@ +// Copyright (C) 2004, 2006 Michael Creel <michael.creel@uab.es> +// +// This program 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 of the License, or +// (at your option) any later version. +// +// This program 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 this program; if not, write to the Free Software +// Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +// numgradient: numeric central difference gradient + +#include <oct.h> +#include <octave/parse.h> +#include <octave/lo-mappers.h> +#include <octave/Cell.h> +#include <float.h> + +// argument checks +static bool +any_bad_argument(const octave_value_list& args) +{ + if (!args(0).is_string()) + { + error("numgradient: first argument must be string holding objective function name"); + return true; + } + + if (!args(1).is_cell()) + { + error("numgradient: second argument must cell array of function arguments"); + return true; + } + + // minarg, if provided + if (args.length() == 3) + { + int tmp = args(2).int_value(); + if (error_state) + { + error("numgradient: 3rd argument, if supplied, must an integer\n\ +that specifies the argument wrt which differentiation is done"); + return true; + } + if ((tmp > args(1).length())||(tmp < 1)) + { + error("numgradient: 3rd argument must be a positive integer that indicates \n\ +which of the elements of the second argument is the\n\ +one to differentiate with respect to"); + return true; + } + } + return false; +} + + +DEFUN_DLD(numgradient, args, , "numgradient(f, {args}, minarg)\n\ +\n\ +Numeric central difference gradient of f with respect\n\ +to argument \"minarg\".\n\ +* first argument: function name (string)\n\ +* second argument: all arguments of the function (cell array)\n\ +* third argument: (optional) the argument to differentiate w.r.t.\n\ + (scalar, default=1)\n\ +\n\ +\"f\" may be vector-valued. If \"f\" returns\n\ +an n-vector, and the argument is a k-vector, the gradient\n\ +will be an nxk matrix\n\ +\n\ +Example:\n\ +function a = f(x);\n\ + a = [x'*x; 2*x];\n\ +endfunction\n\ +numgradient(\"f\", {ones(2,1)})\n\ +ans =\n\ +\n\ + 2.00000 2.00000\n\ + 2.00000 0.00000\n\ + 0.00000 2.00000\n\ +") +{ + int nargin = args.length(); + if (!((nargin == 2)|| (nargin == 3))) + { + error("numgradient: you must supply 2 or 3 arguments"); + return octave_value_list(); + } + + // check the arguments + if (any_bad_argument(args)) return octave_value_list(); + + std::string f (args(0).string_value()); + Cell f_args (args(1).cell_value()); + octave_value_list c_args(2,1); // for cellevall {f, f_args} + octave_value_list f_return; + c_args(0) = f; + c_args(1) = f_args; + Matrix obj_value, obj_left, obj_right; + double SQRT_EPS, p, delta, diff; + int i, j, minarg, test; + + // Default values for controls + minarg = 1; // by default, first arg is one over which we minimize + + // possibly minimization not over 1st arg + if (args.length() == 3) minarg = args(2).int_value(); + Matrix parameter = f_args(minarg - 1).matrix_value(); + + // initial function value + f_return = feval("celleval", c_args); + obj_value = f_return(0).matrix_value(); + + const int n = obj_value.rows(); // find out dimension + const int k = parameter.rows(); + Matrix derivative(n, k); + Matrix columnj; + + for (j=0; j<k; j++) // get 1st derivative by central difference + { + p = parameter(j); + + // determine delta for finite differencing + SQRT_EPS = sqrt(DBL_EPSILON); + diff = exp(log(DBL_EPSILON)/3); + test = (fabs(p) + SQRT_EPS) * SQRT_EPS > diff; + if (test) delta = (fabs(p) + SQRT_EPS) * SQRT_EPS; + else delta = diff; + + // right side + parameter(j) = p + delta; + f_args(minarg - 1) = parameter; + c_args(1) = f_args; + f_return = feval("celleval", c_args); + obj_right = f_return(0).matrix_value(); + + // left size + parameter(j) = p - delta; + f_args(minarg - 1) = parameter; + c_args(1) = f_args; + f_return = feval("celleval", c_args); + obj_left = f_return(0).matrix_value(); + + parameter(j) = p; // restore original parameter + columnj = (obj_right - obj_left) / (2*delta); + for (i=0; i<n; i++) derivative(i, j) = columnj(i); + } + + return octave_value(derivative); +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/src/numhessian.cc Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,208 @@ +// Copyright (C) 2004, 2006 Michael Creel <michael.creel@uab.es> +// +// This program 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 of the License, or +// (at your option) any later version. +// +// This program 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 this program; if not, write to the Free Software +// Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +// numhessian: numeric second derivative + +#include <oct.h> +#include <octave/parse.h> +#include <octave/lo-mappers.h> +#include <octave/Cell.h> +#include <float.h> + +// argument checks +static bool +any_bad_argument(const octave_value_list& args) +{ + if (!args(0).is_string()) + { + error("numhessian: first argument must be string holding objective function name"); + return true; + } + + if (!args(1).is_cell()) + { + error("numhessian: second argument must cell array of function arguments"); + return true; + } + + // minarg, if provided + if (args.length() == 3) + { + int tmp = args(2).int_value(); + if (error_state) + { + error("numhessian: 3rd argument, if supplied, must an integer\n\ +that specifies the argument wrt which differentiation is done"); + return true; + } + if ((tmp > args(1).length())||(tmp < 1)) + { + error("numhessian: 3rd argument must be a positive integer that indicates \n\ +which of the elements of the second argument is the\n\ +one to differentiate with respect to"); + return true; + } + } + return false; +} + + + +DEFUN_DLD(numhessian, args, , + "numhessian(f, {args}, minarg)\n\ +\n\ +Numeric second derivative of f with respect\n\ +to argument \"minarg\".\n\ +* first argument: function name (string)\n\ +* second argument: all arguments of the function (cell array)\n\ +* third argument: (optional) the argument to differentiate w.r.t.\n\ + (scalar, default=1)\n\ +\n\ +If the argument\n\ +is a k-vector, the Hessian will be a kxk matrix\n\ +\n\ +function a = f(x, y)\n\ + a = x'*x + log(y);\n\ +endfunction\n\ +\n\ +numhessian(\"f\", {ones(2,1), 1})\n\ +ans =\n\ +\n\ + 2.0000e+00 -7.4507e-09\n\ + -7.4507e-09 2.0000e+00\n\ +\n\ +Now, w.r.t. second argument:\n\ +numhessian(\"f\", {ones(2,1), 1}, 2)\n\ +ans = -1.0000\n\ +") +{ + int nargin = args.length(); + if (!((nargin == 2)|| (nargin == 3))) + { + error("numhessian: you must supply 2 or 3 arguments"); + return octave_value_list(); + } + + // check the arguments + if (any_bad_argument(args)) return octave_value_list(); + + std::string f (args(0).string_value()); + Cell f_args (args(1).cell_value()); + octave_value_list c_args(2,1); // for cellevall {f, f_args} + octave_value_list f_return; + c_args(0) = f; + c_args(1) = f_args; + int i, j, minarg; + bool test; + double di, hi, pi, dj, hj, pj, hia, hja, fpp, fmm, fmp, fpm, obj_value, SQRT_EPS, diff; + + // Default values for controls + minarg = 1; // by default, first arg is one over which we minimize + + // possibly minimization not over 1st arg + if (args.length() == 3) minarg = args(2).int_value(); + + Matrix parameter = f_args(minarg - 1).matrix_value(); + const int k = parameter.rows(); + Matrix derivative(k, k); + + f_return = feval("celleval", c_args); + obj_value = f_return(0).double_value(); + + diff = exp(log(DBL_EPSILON)/4); + SQRT_EPS = sqrt(DBL_EPSILON); + + + for (i = 0; i<k;i++) // approximate 2nd deriv. by central difference + { + pi = parameter(i); + test = (fabs(pi) + SQRT_EPS) * SQRT_EPS > diff; + if (test) hi = (fabs(pi) + SQRT_EPS) * SQRT_EPS; + else hi = diff; + + + for (j = 0; j < i; j++) // off-diagonal elements + { + pj = parameter(j); + test = (fabs(pj) + SQRT_EPS) * SQRT_EPS > diff; + if (test) hj = (fabs(pj) + SQRT_EPS) * SQRT_EPS; + else hj = diff; + + // +1 +1 + parameter(i) = di = pi + hi; + parameter(j) = dj = pj + hj; + hia = di - pi; + hja = dj - pj; + f_args(minarg - 1) = parameter; + c_args(1) = f_args; + f_return = feval("celleval", c_args); + fpp = f_return(0).double_value(); + + // -1 -1 + parameter(i) = di = pi - hi; + parameter(j) = dj = pj - hj; + hia = hia + pi - di; + hja = hja + pj - dj; + f_args(minarg - 1) = parameter; + c_args(1) = f_args; + f_return = feval("celleval", c_args); + fmm = f_return(0).double_value(); + + // +1 -1 + parameter(i) = pi + hi; + parameter(j) = pj - hj; + f_args(minarg - 1) = parameter; + c_args(1) = f_args; + f_return = feval("celleval", c_args); + fpm = f_return(0).double_value(); + + // -1 +1 + parameter(i) = pi - hi; + parameter(j) = pj + hj; + f_args(minarg - 1) = parameter; + c_args(1) = f_args; + f_return = feval("celleval", c_args); + fmp = f_return(0).double_value(); + + derivative(j,i) = ((fpp - fpm) + (fmm - fmp)) / (hia * hja); + derivative(i,j) = derivative(j,i); + parameter(j) = pj; + } + + // diagonal elements + + // +1 +1 + parameter(i) = di = pi + 2 * hi; + f_args(minarg - 1) = parameter; + c_args(1) = f_args; + f_return = feval("celleval", c_args); + fpp = f_return(0).double_value(); + hia = (di - pi) / 2; + + // -1 -1 + parameter(i) = di = pi - 2 * hi; + f_args(minarg - 1) = parameter; + c_args(1) = f_args; + f_return = feval("celleval", c_args); + fmm = f_return(0).double_value(); + hia = hia + (pi - di) / 2; + + derivative(i,i) = ((fpp - obj_value) + (fmm - obj_value)) / (hia * hia); + parameter(i) = pi; + } + + return octave_value(derivative); +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/main/optim/src/samin.cc Sun Aug 20 13:37:57 2006 +0000 @@ -0,0 +1,673 @@ +// Copyright (C) 2004 Michael Creel <michael.creel@uab.es> +// +// This program 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 of the License, or +// (at your option) any later version. +// +// This program 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 this program; if not, write to the Free Software +// Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +// simann.cc (c) 2004 Michael Creel <michael.creel@uab.es> +// References: +// +// The code follows this article: +// Goffe, William L. (1996) "SIMANN: A Global Optimization Algorithm +// using Simulated Annealing " Studies in Nonlinear Dynamics & Econometrics +// Oct96, Vol. 1 Issue 3. +// +// The code uses the same names for control variables, +// for the most part. A notable difference is that the initial +// temperature is found automatically to ensure that the active +// bounds when the temperature begins to reduce cover the entire +// parameter space (defined as a n-dimensional +// rectangle that is the Cartesian product of the +// (lb_i, ub_i), i = 1,2,..n +// +// Also of note: +// Corana et. al., (1987) "Minimizing Multimodal Functions of Continuous +// Variables with the "Simulated Annealing" Algorithm", +// ACM Transactions on Mathematical Software, V. 13, N. 3. +// +// Goffe, et. al. (1994) "Global Optimization of Statistical Functions +// with Simulated Annealing", Journal of Econometrics, +// V. 60, N. 1/2. + + +#include <oct.h> +#include <octave/parse.h> +#include <octave/Cell.h> +#include <octave/lo-mappers.h> +#include <octave/oct-rand.h> +#include <float.h> +#include "error.h" + +// define argument checks +static bool +any_bad_argument(const octave_value_list& args) +{ + + // objective function name is a string? + if (!args(0).is_string()) + { + error("samin: first argument must be string holding objective function name"); + return true; + } + + // are function arguments contained in a cell? + if (!args(1).is_cell()) + { + error("samin: second argument must cell array of function arguments"); + return true; + } + + // is control a cell? + Cell control (args(2).cell_value()); + if (error_state) + { + error("samin: third argument must cell array of algorithm controls"); + return true; + } + + // does control have proper number of elements? + if (!(control.length() == 11)) + { + error("samin: third argument must be a cell array with 11 elements"); + return true; + } + + // now check type of each element of control + if (!(control(0).is_real_matrix()) || (control(0).is_real_scalar())) + { + error("samin: 1st element of controls must be LB: a vector of lower bounds"); + return true; + } + + if ((control(0).is_real_matrix()) && (control(0).columns() != 1)) + { + error("samin: 1st element of controls must be LB: a vector of lower bounds"); + return true; + } + + if (!(control(1).is_real_matrix()) || (control(1).is_real_scalar())) + { + error("samin: 1st element of controls must be UB: a vector of lower bounds"); + return true; + } + + if ((control(1).is_real_matrix()) && (control(1).columns() != 1)) + { + error("samin: 2nd element of controls must be UB: a vector of lower bounds"); + return true; + } + + int tmp = control(2).int_value(); + if (error_state || tmp < 1) + { + error("samin: 3rd element of controls must be NT: positive integer\n\ +loops per temperature reduction"); + return true; + } + + tmp = control(3).int_value(); + if (error_state || tmp < 1) + { + error("samin: 4th element of controls must be NS: positive integer\n\ +loops per stepsize adjustment"); + return true; + } + + double tmp2 = control(4).double_value(); + if (error_state || tmp < 0) + { + error("samin: 5th element of controls must be RT:\n\ +temperature reduction factor, RT > 0"); + return true; + } + + tmp2 = control(5).double_value(); + if (error_state || tmp < 0) + { + error("samin: 6th element of controls must be integer MAXEVALS > 0 "); + return true; + } + + tmp = control(6).int_value(); + if (error_state || tmp < 0) + { + error("samin: 7th element of controls must be NEPS: positive integer\n\ +number of final obj. values that must be within EPS of eachother "); + return true; + } + + tmp2 = control(7).double_value();if (error_state || tmp2 < 0) + { + error("samin: 8th element of controls must must be FUNCTOL (> 0)\n\ +used to compare the last NEPS obj values for convergence test"); + return true; + } + + tmp2 = control(8).double_value(); + if (error_state || tmp2 < 0) + { + error("samin: 9th element of controls must must be PARAMTOL (> 0)\n\ +used to compare the last NEPS obj values for convergence test"); + return true; + } + + tmp = control(9).int_value(); + if (error_state || tmp < 0 || tmp > 2) + { + error("samin: 9th element of controls must be VERBOSITY (0, 1, or 2)"); + return true; + } + + tmp = control(10).int_value(); + if (error_state || tmp < 0) + { + error("samin: 10th element of controls must be MINARG (integer)\n\ + position of argument to minimize wrt"); + return true; + } + + // make sure that minarg points to an existing element + if ((tmp > args(1).length())||(tmp < 1)) + { + error("bfgsmin: 4th argument must be a positive integer that indicates \n\ +which of the elements of the second argument is the one minimization is over"); + return true; + } + + return false; +} + + +//-------------- The annealing algorithm -------------- +DEFUN_DLD(samin, args, , + "samin: simulated annealing minimization of a function. See samin_example.m\n\ +\n\ +[x, obj, convergence] = samin(\"f\", {args}, {control})\n\ +\n\ +Arguments:\n\ +* \"f\": function name (string)\n\ +* {args}: a cell array that holds all arguments of the function,\n\ +* {control}: a cell array with 11 elements\n\ + * LB - vector of lower bounds\n\ + * UB - vector of upper bounds\n\ + * nt - integer: # of iterations between temperature reductions\n\ + * ns - integer: # of iterations between bounds adjustments\n\ + * rt - 0 < rt <1: temperature reduction factor\n\ + * maxevals - integer: limit on function evaluations\n\ + * neps - integer: # number of values final result is compared to\n\ + * functol - > 0: the required tolerance level for function value comparisons\n\ + * paramtol - > 0: the required tolerance level for parameters\n\ + * verbosity - scalar: 0, 1, or 2.\n\ + * 0 = no screen output\n\ + * 1 = summary every temperature change\n\ + * 2 = only final results to screen\n\ + * minarg - integer: which of function args is minimization over?\n\ +\n\ +Returns:\n\ +* x: the minimizer\n\ +* obj: the value of f() at x\n\ +* convergence: 1 if normal conv, other values if not\n\ +\n\ +Example: A really stupid way to calculate pi\n\ +function a = f(x)\n\ + a = cos(x) + 0.01*(x-pi)^2;\n\ +endfunction\n\ +\n\ +Set up the controls:\n\ +ub = 20;\n\ +lb = -ub;\n\ +nt = 20;\n\ +ns = 5;\n\ +rt = 0.5;\n\ +maxevals = 1e10;\n\ +neps = 5;\n\ +functol = 1e-10;\n\ +paramtol = 1e-5;\n\ +verbosity = 2;\n\ +minarg = 1;\n\ +\n\ +Put them in a cell array:\n\ +control = {lb, ub, nt, ns, rt, maxevals,\n\ + neps, functol, paramtol, verbosity, minarg};\n\ +\n\ +Call the minimizer (function argument also in cell array):\n\ +samin(\"f\", {-8}, control)\n\ +\n\ +The result:\n\ +================================================\n\ +SAMIN final results\n\ +Sucessful convergence to tolerance 0.000010\n\ +\n\ +Obj. fn. value -1.000000\n\ + parameter search width\n\ + 3.141597 0.002170\n\ +================================================\n\ +ans = 3.1416\n\ +") +{ + int nargin = args.length(); + if (!(nargin == 3)) + { + error("samin: you must supply 3 arguments"); + return octave_value_list(); + } + + // check the arguments + if (any_bad_argument(args)) return octave_value_list(); + + std::string obj_fn (args(0).string_value()); + Cell f_args (args(1).cell_value()); + Cell control (args(2).cell_value()); + + octave_value_list c_args(2,1); // for cellevall {f, f_args} + octave_value_list f_return; // holder for feval returns + + int m, i, j, h, n, nacc, func_evals; + int nup, nrej, nnew, ndown, lnobds; + int converge, test; + + // user provided controls + const Matrix lb (control(0).matrix_value()); + const Matrix ub (control(1).matrix_value()); + const int nt (control(2).int_value()); + const int ns (control(3).int_value()); + const double rt (control(4).double_value()); + const double maxevals (control(5).double_value()); + const int neps (control(6).int_value()); + const double functol (control(7).double_value()); + const double paramtol (control(8).double_value()); + const int verbosity (control(9).int_value()); + const int minarg (control(10).int_value()); + + + double f, fp, p, pp, fopt, rand_draw, ratio, t; + + // type checking for minimization parameter done here, since we don't know minarg + // until now + if (!(f_args(minarg - 1).is_real_matrix() || (f_args(minarg - 1).is_real_scalar()))) + { + error("samin: minimization must be with respect to a column vector"); + return octave_value_list(); + } + if ((f_args(minarg - 1).is_real_matrix()) && (f_args(minarg - 1).columns() != 1)) + { + error("samin: minimization must be with respect to a column vector"); + return octave_value_list(); + } + + Matrix x = f_args(minarg - 1).matrix_value(); + Matrix bounds = ub - lb; + n = x.rows(); + Matrix xopt = x; + Matrix xp(n, 1); + Matrix nacp(n,1); + + // Set initial values + nacc = 0; + func_evals = 0; + + Matrix fstar(neps,1); + fstar.fill(1e20); + + + // check for out-of-bounds starting value + for(i = 0; i < n; i++) + { + if(( x(i) > ub(i)) || (x(i) < lb(i))) + { + error("samin: initial parameter %d out of bounds", i); + return octave_value_list(); + } + } + + // Initial obj_value + c_args(0) = obj_fn; + c_args(1) = f_args; + f_return = feval("celleval", c_args); + f = f_return(0).double_value(); + + fopt = f; + fstar(0) = f; + + // First stage: find initial temperature so that + // bounds grow to cover parameter space + t = 1000; + converge = 0; + while((converge==0) & t < sqrt(DBL_MAX)) + { + nup = 0; + nrej = 0; + nnew = 0; + ndown = 0; + lnobds = 0; + + // repeat nt times then adjust temperature + for(m = 0;m < nt;m++) + { + // repeat ns times, then adjust bounds + for(j = 0;j < ns;j++) + { + // generate new point by taking last + // and adding a random value to each of elements, + // in turn + for(h = 0;h < n;h++) + { + xp = x; + f_return = feval("rand"); + rand_draw = f_return(0).double_value(); + xp(h) = x(h) + (2.0 * rand_draw - 1.0) * bounds(h); + if((xp(h) < lb(h)) || (xp(h) > ub(h))) + { + xp(h) = lb(h) + (ub(h) - lb(h)) * rand_draw; + lnobds = lnobds + 1; + } + + // Evaluate function at new point + f_args(minarg - 1) = xp; + c_args(1) = f_args; + f_return = feval("celleval", c_args); + fp = f_return(0).double_value(); + func_evals = func_evals + 1; + + // If too many function evaluations occur, terminate the algorithm. + if(func_evals >= maxevals) + { + warning("samin: NO CONVERGENCE: MAXEVALS exceeded before initial temparature found"); + if(verbosity >= 1) + { + printf("\n================================================\n"); + printf("SAMIN results\n"); + printf("NO CONVERGENCE: MAXEVALS exceeded\n"); + printf("Stage 1, increasing temperature\n"); + printf("\nObj. fn. value %f\n", fopt); + printf(" parameter search width\n"); + for(i = 0; i < n; i++) printf("%20f%20f\n", xopt(i), bounds(i)); + printf("================================================\n"); + } + f_return(0) = xopt; + f_return(1) = fopt; + f_return(2) = 0; + return octave_value_list(f_return); + } + + // Accept the new point if the function value decreases + if(fp <= f) + { + x = xp; + f = fp; + nacc = nacc + 1; + nacp(h) = nacp(h) + 1; + nup = nup + 1; + + // If greater than any other point, record as new optimum. + if(fp < fopt) + { + xopt = xp; + fopt = fp; + nnew = nnew + 1; + } + } + + // If the point is higher, use the Metropolis criteria to decide on + // acceptance or rejection. + else + { + p = exp(-(fp - f) / t); + f_return = feval("rand"); + rand_draw = f_return(0).double_value(); + if(rand_draw < p) + { + x = xp; + f = fp; + nacc = nacc + 1; + nacp(h) = nacp(h) + 1; + ndown = ndown + 1; + } + else nrej = nrej + 1; + } + } + } + + // Adjust bounds so that approximately half of all evaluations are accepted. + test = 0; + for(i = 0;i < n;i++) + { + ratio = nacp(i) / ns; + if(ratio > 0.6) bounds(i) = bounds(i) * (1.0 + 2.0 * (ratio - 0.6) / 0.4); + else if(ratio < .4) bounds(i) = bounds(i) / (1.0 + 2.0 * ((0.4 - ratio) / 0.4)); + // keep within initial bounds + if(bounds(i) >= (ub(i) - lb(i))) + { + test = test + 1; // when this gets to n, we're done with fist stage + bounds(i) = ub(i) - lb(i); + } + } + nacp.fill(0.0); + converge = (test == n); + } + + if(verbosity == 1) + { + printf("\nFirst stage: Increasing temperature to cover parameter space\n"); + printf("\nTemperature %e", t); + printf("\nmin function value so far %f", fopt); + printf("\ntotal evaluations so far %d", func_evals); + printf("\ntotal moves since temp change %d", nup + ndown + nrej); + printf("\ndownhill %d", nup); + printf("\naccepted uphill %d", ndown); + printf("\nrejected uphill %d", nrej); + printf("\nout of bounds trials %d", lnobds); + printf("\nnew minima this temperature %d", nnew); + printf("\n\n parameter search width\n"); + for(i = 0; i < n; i++) printf("%20f%20f\n", xopt(i), bounds(i)); + printf("\n"); + } + + // Increase temperature quickly + t = t*t; + for(i = neps-1; i > 0; i--) fstar(i) = fstar(i-1); + f = fopt; + x = xopt; + } + + // Second stage: temperature reduction loop + converge = 0; + while(converge==0) + { + nup = 0; + nrej = 0; + nnew = 0; + ndown = 0; + lnobds = 0; + + // repeat nt times then adjust temperature + for(m = 0;m < nt;m++) + { + // repeat ns times, then adjust bounds + for(j = 0;j < ns;j++) + { + // generate new point by taking last + // and adding a random value to each of elements, + // in turn + for(h = 0;h < n;h++) + { + xp = x; + f_return = feval("rand"); + rand_draw = f_return(0).double_value(); + xp(h) = x(h) + (2.0 * rand_draw - 1.0) * bounds(h); + if((xp(h) < lb(h)) || (xp(h) > ub(h))) + { + xp(h) = lb(h) + (ub(h) - lb(h)) * rand_draw; + lnobds = lnobds + 1; + } + + // Evaluate function at new point + f_args(minarg - 1) = xp; + c_args(1) = f_args; + f_return = feval("celleval", c_args); + fp = f_return(0).double_value(); + func_evals = func_evals + 1; + + // If too many function evaluations occur, terminate the algorithm + if(func_evals >= maxevals) + { + warning("samin: NO CONVERGENCE: maxevals exceeded"); + if(verbosity >= 1) + { + printf("\n================================================\n"); + printf("SAMIN results\n"); + printf("NO CONVERGENCE: MAXEVALS exceeded\n"); + printf("Stage 2, decreasing temperature\n"); + printf("\nObj. fn. value %f\n", fopt); + printf(" parameter search width\n"); + for(i = 0; i < n; i++) printf("%20f%20f\n", xopt(i), bounds(i)); + printf("================================================\n"); + } + f_return(0) = xopt; + f_return(1) = fopt; + f_return(2) = 0; + return octave_value_list(f_return); + } + + // Accept the new point if the function value decreases + if(fp <= f) + { + x = xp; + f = fp; + nacc = nacc + 1; + nacp(h) = nacp(h) + 1; + nup = nup + 1; + // If greater than any other point, record as new optimum + if(fp < fopt) + { + xopt = xp; + fopt = fp; + nnew = nnew + 1; + } + } + + // If the point is higher, use the Metropolis criteria to decide on + // acceptance or rejection. + else + { + p = exp(-(fp - f) / t); + f_return = feval("rand"); + rand_draw = f_return(0).double_value(); + if(rand_draw < p) + { + x = xp; + f = fp; + nacc = nacc + 1; + nacp(h) = nacp(h) + 1; + ndown = ndown + 1; + } + else nrej = nrej + 1; + } + } + } + + // Adjust bounds so that approximately half of all evaluations are accepted + for(i = 0;i < n;i++) + { + ratio = nacp(i) / ns; + if(ratio > 0.6) bounds(i) = bounds(i) * (1.0 + 2.0 * (ratio - 0.6) / 0.4); + else if(ratio < .4) bounds(i) = bounds(i) / (1.0 + 2.0 * ((0.4 - ratio) / 0.4)); + // keep within initial bounds + if(bounds(i) > (ub(i) - lb(i))) bounds(i) = ub(i) - lb(i); + } + nacp.fill(0.0); + } + if(verbosity == 1) + { + printf("\nIntermediate results before next temperature reduction\n"); + printf("\nTemperature %e", t); + printf("\nmin function value so far %f", fopt); + printf("\ntotal evaluations so far %d", func_evals); + printf("\ntotal moves since last temp reduction %d", nup + ndown + nrej); + printf("\ndownhill %d", nup); + printf("\naccepted uphill %d", ndown); + printf("\nrejected uphill %d", nrej); + printf("\nout of bounds trials %d", lnobds); + printf("\nnew minima this temperature %d", nnew); + printf("\n\n parameter search width\n"); + for(i = 0; i < n; i++) printf("%20f%20f\n", xopt(i), bounds(i)); + printf("\n"); + } + + // Check for convergence + // current function value must be within "tol" + // of last "neps" (an integer) function values, + // AND the last "neps" function values + // must be withing tol of overall best + fstar(0) = f; + test = 0; + for(i = 0; i < neps; i++) test = test + fabs(f - fstar(i)) > functol; + test = (test > 0); // if different from zero, function conv. has failed + if( ((fopt - fstar(0)) <= functol) && (!test)) + { + // check for bound narrow enough for parameter convergence + converge = 1; + for(i = 0;i < n;i++) + { + if(bounds(i) > paramtol) + { + converge = 0; // no conv. if bounds too wide + break; + } + } + } + + // check if too close to bounds, and change convergence message if so + if (converge) if (lnobds > 0) converge = 2; + + // Are we done yet? + if(converge>0) + { + if(verbosity >= 1) + { + printf("\n================================================\n"); + printf("SAMIN final results\n"); + if (converge == 1) printf("NORMAL CONVERGENCE\n\n"); + if (converge == 2) + { + printf("WARNING: last point satisfies conv. criteria, \n\ +but is too close to bounds of parameter space\n"); + printf("%f \% of last round evaluations out-of-bounds\n", 100*lnobds/(nup+ndown+nrej)); + printf("Expand bounds and re-run\n\n"); + } + printf("Func. tol. %e Param. tol. %e\n", functol, paramtol); + printf("Obj. fn. value %f\n\n", fopt); + printf(" parameter search width\n"); + for(i = 0; i < n; i++) printf("%20f%20f\n", xopt(i), bounds(i)); + printf("================================================\n"); + } + f_return(0) = xopt; + f_return(1) = fopt; + if (lnobds > 0) converge = 2; + f_return(2) = converge; + return octave_value_list(f_return); + } + + // Reduce temperature, record current function value in the + // list of last "neps" values, and loop again + t = rt * t; + for(i = neps-1; i > 0; i--) fstar(i) = fstar(i-1); + f = fopt; + x = xopt; + } + f_return(0) = xopt; + f_return(1) = fopt; + f_return(2) = converge; + return octave_value_list(f_return); +} + +
--- a/main/optim/test_d2_min_1.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,183 +0,0 @@ -## Copyright (C) 2002 Etienne Grossmann. All rights reserved. -## -## This program 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. -## -## This 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. - -## Test whether d2_min() functions correctly -## -## Gives a simple quadratic programming problem (function ff below). -## -## Sets a ok variable to 1 in case of success, 0 in case of failure -## -## If a variables "verbose" is set, then some comments are output. - -## Author: Etienne Grossmann <etienne@cs.uky.edu> - -1 ; - -if ! exist ("verbose"), verbose = 0; end - -if verbose - printf ("\n Testing d2_min () on a quadratic programming problem\n\n"); -end - -P = 10+floor(30*rand(1)) ; # Nparams -R = P+floor(30*rand(1)) ; # Nobses -noise = 0 ; -global obsmat ; -obsmat = randn(R,P) ; -global truep ; -truep = randn(P,1) ; -xinit = randn(P,1) ; - -global obses ; -obses = obsmat*truep ; -if noise, obses = adnois(obses,noise); end - - - -function v = ff(x) - global obsmat; - global obses; - v = msq (obses - obsmat*x ) ; -endfunction - -function [v,dv,d2v] = d2ff(x) # Return pseudo-inverse - global obsmat; - global obses; - er = -obses + obsmat*x ; - dv = er'*obsmat ; - v = msq(er ) ; - d2v = pinv (obsmat'*obsmat ) ; -endfunction - -function [v,dv,d2v] = d2ff_2(x) # Return 2nd derivs, not pseudo-inv - global obsmat; - global obses; - er = -obses + obsmat*x ; - dv = er'*obsmat ; - v = msq(er ) ; - d2v = obsmat'*obsmat ; -endfunction - -## dt = mytic() -## -## Returns the cputime since last call to 'mytic'. - -function dt = mytic() - static last_mytic = 0 ; - [t,u,s] = cputime() ; - dt = t - last_mytic ; - last_mytic = t ; -endfunction - -## s = msq(x) - Mean squared value, ignoring nans -## -## s == mean(x(:).^2) , but ignores NaN's - - -function s = msq(x) -try - s = mean(x(find(!isnan(x))).^2); -catch - s = nan; -end -endfunction - -cnt = 1; -ok = 1; - -ctl = nan*zeros(1,5); ctl(5) = 1; - -if verbose - printf ("Going to call d2_min\n"); -end -mytic() ; -[xlev,vlev,nev] = d2_min ("ff","d2ff",xinit,ctl); -tlev = mytic() ; - -if verbose, - printf("d2_min should find in one iteration + one more to check\n"); - printf(["d2_min : niter=%-4d nev=%-4d nobs=%-4d,nparams=%-4d\n",... - " time=%-8.3g errx=%-8.3g minv=%-8.3g\n"],... - nev([2,1]),R,P,tlev,max(abs(xlev-truep )),vlev); -end - - - -if nev(2) != 2, - if verbose - printf ("Too many iterations for this function\n"); - end - ok = 0; -else - if verbose - printf ("Ok: single iteration (%i)\n",cnt); - end -end - -if max (abs(xlev-truep )) > sqrt (eps), - if verbose - printf ("Error is too big : %-8.3g\n", max (abs (xlev-truep))); - end - ok = 0; -else - if verbose - printf ("Ok: single error amplitude (%i)\n",cnt); - end -end - -cnt++; - -if verbose - printf ("Going to call d2_min() \n"); -end -mytic() ; -[xlev,vlev,nev] = d2_min("ff","d2ff_2",xinit) ; -tlev = mytic() ; - -if verbose, - printf("d2_min should find in one iteration + one more to check\n"); - printf(["d2_min : niter=%-4d nev=%-4d nobs=%-4d,nparams=%-4d\n",... - " time=%-8.3g errx=%-8.3g minv=%-8.3g\n"],... - nev([2,1]),R,P,tlev,max(abs(xlev-truep )),vlev); -end - - -if nev(2) != 2, - if verbose - printf ("Too many iterations for this function\n"); - end - ok = 0; -else - if verbose - printf ("Ok: single iteration (%i)\n",cnt); - end -end - -if max (abs(xlev-truep )) > sqrt (eps), - if verbose - printf ("Error is too big : %-8.3g\n", max (abs (xlev-truep))); - end - ok = 0; -else - if verbose - printf ("Ok: single error amplitude (%i)\n",cnt); - end -end - -if verbose - if ok - printf ("All tests ok\n"); - else - printf ("Some tests failed\n"); - end -end -
--- a/main/optim/test_d2_min_2.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,114 +0,0 @@ -## Copyright (C) 2002 Etienne Grossmann. All rights reserved. -## -## This program 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. -## -## This 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. - -## Test whether d2_min() functions correctly, with two args -## -## Gives a simple quadratic programming problem (function ff below). -## -## Sets a ok variable to 1 in case of success, 0 in case of failure -## -## If a variables "verbose" is set, then some comments are output. - -## Author: Etienne Grossmann <etienne@cs.uky.edu> - -1 ; - -ok = 0; - -if ! exist ("verbose"), verbose = 0; end - -if verbose - printf ("\n Testing d2_min () on a quadratic programming problem\n\n"); -end - -P = 10+floor(30*rand(1)) ; # Nparams -R = P+floor(30*rand(1)) ; # Nobses -noise = 0 ; -obsmat = randn(R,P) ; -truep = randn(P,1) ; -xinit = randn(P,1) ; - -obses = obsmat*truep ; -if noise, obses = adnois(obses,noise); end - -y.obses = obses; -y.obsmat = obsmat; - -function v = ff (x, y) - v = msq( y.obses - y.obsmat*x ) ; -endfunction - - -function [v,dv,d2v] = d2ff (x, y) - er = -y.obses + y.obsmat*x ; - dv = er'*y.obsmat ; - v = msq( er ) ; - d2v = pinv( y.obsmat'*y.obsmat ) ; -endfunction - -## dt = mytic() -## -## Returns the cputime since last call to 'mytic'. - -function dt = mytic() - static last_mytic = 0 ; - [t,u,s] = cputime() ; - dt = t - last_mytic ; - last_mytic = t ; -endfunction - -## s = msq(x) - Mean squared value, ignoring nans -## -## s == mean(x(:).^2) , but ignores NaN's - - -function s = msq(x) -try - s = mean(x(find(!isnan(x))).^2); -catch - s = nan; -end -endfunction - - -ctl = nan*zeros(1,5); ctl(5) = 1; - -if verbose, printf ( "Going to call d2_min()\n"); end -mytic() ; -[xlev,vlev,nev] = d2_min ("ff", "d2ff", list (xinit,y), ctl) ; -tlev = mytic (); - -if verbose, - printf("d2_min should find in one iteration + one more to check\n"); - printf(["d2_min : niter=%-4d nev=%-4d nobs=%-4d nparams=%-4d\n",\ - " time=%-8.3g errx=%-8.3g minv=%-8.3g\n"],... - nev([2,1]), R, P, tlev, max (abs (xlev-truep)), vlev); -end - -ok = 1; -if nev(2) != 2, - if verbose - printf ( "Too many iterations for this function\n"); - end - ok = 0; -end - -if max (abs(xlev-truep )) > sqrt (eps), - if verbose - printf ( "Error is too big : %-8.3g\n", max (abs (xlev-truep))); - end - ok = 0; -end - -if verbose && ok - printf ( "All tests ok\n"); -end
--- a/main/optim/test_d2_min_3.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,102 +0,0 @@ -## Copyright (C) 2002 Etienne Grossmann. All rights reserved. -## -## This program 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. -## -## This 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. - -## Test whether d2_min() functions correctly -## -## Gives a 2-dim function with strange shape ("ff", defined below). -## -## Sets a ok variable to 1 in case of success, 0 in case of failure -## -## If a variables "verbose" is set, then some comments are output. - -## Author: Etienne Grossmann <etienne@cs.uky.edu> - - -1 ; - -ok = 0; - -if ! exist ("verbose"), verbose = 0; end - -if verbose - printf ("\n Testing d2_min () on a strange 2-dimensional function\n\n"); -end - -P = 2; # Nparams -noise = 0 ; -truep = [0;0] ; -xinit = randn(P,1) ; - -if noise, obses = adnois(obses,noise); end - -y = nan; - - -function v = ff (x, y) - v = x(1)^2 * (1+sin(x(2)*3*pi)^2) + x(2)^2; -endfunction - - -function [w,dv,d2v] = d2ff (x, y) - u = x(1); v = x(2); - w = u^2 * (1+sin(v*3*pi)^2) + v^2; - - dv = [2*u * (1+sin(v*3*pi)^2), u^2 * sin(v*2*3*pi) + 2*v ]; - - d2v = [2*(1+sin(v*3*pi)^2), 2*u * sin(v*2*3*pi) ; - 2*u * sin(v*2*3*pi), u^2 * 2*3*pi* cos(v*2*3*pi) + 2 ]; - d2v = inv (d2v); -endfunction - -## dt = mytic() -## -## Returns the cputime since last call to 'mytic'. - -function dt = mytic() - static last_mytic = 0 ; - [t,u,s] = cputime() ; - dt = t - last_mytic ; - last_mytic = t ; -endfunction - - -ctl = nan*zeros(1,5); ctl(5) = 1; - -if verbose - printf ( "Going to call d2_min\n"); -end -mytic() ; -[xlev,vlev,nev] = d2_min ("ff", "d2ff", list (xinit,y),ctl) ; -tlev = mytic (); - -if verbose, - printf("d2_min should find minv = 0 (plus a little error)\n"); - printf(["d2_min : niter=%-4d nev=%-4d nparams=%-4d\n",... - " time=%-8.3g errx=%-8.3g minv=%-8.3g\n"],... - nev([2,1]), P, tlev, max (abs (xlev-truep)), vlev); -end - -ok = 1; - -if max (abs(xlev-truep )) > sqrt (eps), - if verbose - printf ( "Error is too big : %-8.3g\n", max (abs (xlev-truep))); - end - ok = 0; -end - -if verbose && ok - printf ( "All tests ok\n"); -end - - -
--- a/main/optim/test_fminunc_1.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,142 +0,0 @@ -## Copyright (C) 2002 Etienne Grossmann. All rights reserved. -## -## This program 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. -## -## This 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. - -## test_fminunc_1 - Test that fminunc and optimset work -## -## A quadratic function is fminuncd. Various options are tested. Options -## are passed incomplete (to see if properly completed) and -## case-insensitive. - -ok = 1; # Remains set if all ok. Set to 0 otherwise -cnt = 0; # Test counter -page_screen_output = 0; -page_output_immediately = 1; -do_fortran_indexing = 1; -warn_fortran_indexing = 0; - -if ! exist ("verbose"), verbose = 0; end - -N = 2; - -x0 = randn(N,1) ; -y0 = randn(N,1) ; - -## Return value -function v = ff(x,y,t) - A = [1 -1;1 1]; M = A'*diag([100,1])*A; - v = ((x - y)(1:2))'*M*((x-y)(1:2)) + 1; -endfunction - - -## Return value, diff and 2nd diff -function [v,dv,d2v] = d2ff(x,y,t) - if nargin < 3, t = 1; end - if t == 1, N = length (x); else N = length (y); end - A = [1 -1;1 1]; M = A'*diag([100,1])*A; - v = ((x - y)(1:2))'*M*((x-y)(1:2)) + 1; - dv = 2*((x-y)(1:2))'*M; - d2v = zeros (N); d2v(1:2,1:2) = 2*M; - if N>2, dv = [dv, zeros(1,N-2)]; end - if t == 2, dv = -dv; end -endfunction - - -## PRint Now -function prn (varargin), printf (varargin{:}); fflush (stdout); end - - -if verbose - prn ("\n Testing that fminunc() works as it should\n\n"); - prn (" Nparams = N = %i\n",N); - fflush (stdout); -end - -## Plain run, just to make sure ###################################### -## Minimum wrt 'x' is y0 -opt = optimset (); -[xlev,vlev] = fminunc ("ff",x0,opt,y0,1); - -cnt++; -if max (abs (xlev-y0)) > 100*sqrt (eps) - if verbose - prn ("Error is too big : %8.3g\n", max (abs (xlev-y0))); - end - ok = 0; -elseif verbose, prn ("ok %i\n",cnt); -end - -## See what 'backend' gives in that last case ######################## -opt = optimset ("backend","on"); -[method,ctl] = fminunc ("ff",x0, opt, y0,1); - -cnt++; -if ! ischar (method) || ! strcmp (method,"nelder_mead_min") - if verbose - if ischar (method) - prn ("Wrong method '%s' != 'nelder_mead_min' was chosen\n", method); - else - prn ("fminunc pretends to use a method that isn't a string\n"); - end - return - end - ok = 0; -elseif verbose, prn ("ok %i\n",cnt); -end - -[xle2,vle2,nle2] = feval (method, "ff",list (x0,y0,1), ctl); -cnt++; - # nelder_mead_min is not very repeatable - # because of restarts from random positions -if max (abs (xlev-xle2)) > 100*sqrt (eps) - if verbose - prn ("Error is too big : %8.3g\n", max (abs (xlev-xle2))); - end - ok = 0; -elseif verbose, prn ("ok %i\n",cnt); -end - - -## Run, w/ differential returned by function ('jac' option) ########## -## Minimum wrt 'x' is y0 - -opt = optimset ("GradO","on"); -[xlev,vlev,nlev] = fminunc ("d2ff",x0,opt,y0,1); - -cnt++; -if max (abs (xlev-y0)) > 100*sqrt (eps) - if verbose - prn ("Error is too big : %8.3g\n", max (abs (xlev-y0))); - end - ok = 0; -elseif verbose, prn ("ok %i\n",cnt); -end - - -## Use the 'hess' option, when f can return 2nd differential ######### -## Minimum wrt 'x' is y0 -opt = optimset ("hessian","on"); -[xlev,vlev,nlev] = fminunc ("d2ff",x0,opt,y0,1); - -cnt++; -if max (abs (xlev-y0)) > 100*sqrt (eps) - if verbose - prn ("Error is too big : %8.3g\n", max (abs (xlev-y0))); - end - ok = 0; -elseif verbose, prn ("ok %i\n",cnt); -end - - -if verbose && ok - prn ( "All tests ok\n"); -end -
--- a/main/optim/test_min_1.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,104 +0,0 @@ -## Copyright (C) 2002 Etienne Grossmann. All rights reserved. -## -## This program 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. -## -## This 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. - - -## -## Test an optimization function with the same synopsis as bfgs.m -## -## modified 2004-05-20 by Michael Creel to adapt to bfgsmin - -if ! exist ("optim_func"), optim_func = "bfgsmin"; end - -ok = 1; - -if ! exist ("verbose"), verbose = 0; end - -if verbose - printf ("\n Testing '%s' on a quadratic programming problem\n\n",\ - optim_func); - printf ([" Set 'optim_func' to the name of the optimization\n",\ - " function you want to test (must have same synopsis\n",\ - " as 'bfgs')\n\n"]); -end - - - -N = 1+floor(30*rand(1)) ; -global truemin ; -truemin = randn(N,1) ; - -global offset ; -offset = 10*randn(1) ; - -global metric ; -metric = randn(2*N,N) ; -metric = metric'*metric ; - -if N>1, - [u,d,v] = svd(metric); - d = (0.1+[0:(1/(N-1)):1]).^2 ; - metric = u*diag(d)*u' ; -end - -function v = testfunc(x) - global offset ; - global truemin ; - global metric ; - v = sum((x-truemin)'*metric*(x-truemin))+offset ; -end - -function df = dtestf(x) - global truemin ; - global metric ; - df = 2*(x-truemin)'*metric ; -end - -xinit = 10*randn(N,1) ; - -if verbose, - printf ([" Dimension is %i\n",\ - " Condition is %f\n"],\ - N, cond (metric)); - fflush (stdout); -end - -## [x,v,niter] = feval (optim_func, "testfunc","dtestf", xinit); -ctl.df = "dtestf"; -if strcmp(optim_func,"bfgsmin") - ctl = {-1,2,1,1}; - xinit2 = {xinit}; -else xinit2 = xinit; -endif -[x,v,niter] = feval (optim_func, "testfunc", xinit2, ctl); - -if verbose - printf ("nev=%d N=%d errx=%8.3g errv=%8.3g\n",\ - niter(1),N,max(abs( x-truemin )),v-offset); -end - -if any (abs (x-truemin) > 1e-4) - ok = 0; - if verbose, printf ("not ok 1 (best argument is wrong)\n"); end -elseif verbose, printf ("ok 1\n"); -end - -if v-offset > 1e-8 - ok = 0; - if verbose, printf ("not ok 2 (best function value is wrong)\n"); end -elseif verbose, printf ("ok 2\n"); -end - -if verbose - if ok, printf ("All tests ok\n"); - else printf ("Whoa!! Some test(s) failed\n"); - end -end
--- a/main/optim/test_min_2.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,121 +0,0 @@ -## Copyright (C) 2002 Etienne Grossmann. All rights reserved. -## -## This program 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. -## -## This 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. - -## test_min_2 - Test that bfgs works -## -## Defines some simple functions and verifies that calling -## -## bfgs on them returns the correct minimum. -## -## Sets 'ok' to 1 if success, 0 otherwise - -## The name of the optimizing function -## modified 2004-05-20 by Michael Creel to adapt to bfgsmin -if ! exist ("optim_func"), optim_func = "bfgsmin"; end - -ok = 1; - -if ! exist ("verbose"), verbose = 0; end - -P = 15; -R = 20; # must have R >= P - - -global obsmat ; -## Make test_min_2 reproducible by using fixed obsmat -## obsmat = randn(R,P) ; -obsmat = zeros (R,P); -obsmat(sub2ind([R,P],1:R,1+rem(0:R-1,P))) = 1:R; - -global truep ; - -## Make test_min_2 reproducible by using fixed starting point -## truep = randn(P,1) ; -## xinit = randn(P,1) ; -truep = rem (1:P, P/4)'; -xinit = truep + 2*(1:P)'/(P); - -global obses ; -obses = obsmat*truep ; - - -function v = ff(x) - global obsmat; - global obses; - v = mean ((obses - obsmat*x).^2) + 1 ; -endfunction - - -function dv = dff(x) - global obsmat; - global obses; - er = -obses + obsmat*x ; - dv = 2*er'*obsmat / rows(obses) ; - ## dv = 2*er'*obsmat ; -endfunction - -## dt = mytic() -## -## Returns the cputime since last call to 'mytic'. - -function dt = mytic() - static last_mytic = 0 ; - [t,u,s] = cputime() ; - dt = t - last_mytic ; - last_mytic = t ; -endfunction - - -if verbose - printf ("\n Testing %s on a quadratic problem\n\n", optim_func); - - printf ([" Set 'optim_func' to the name of the optimization\n",\ - " function you want to test (must have same synopsis\n",\ - " as 'bfgs')\n\n"]); - - printf (" Nparams = P = %i, Nobses = R = %i\n",P,R); - fflush (stdout); -end - -ctl.df = "dff"; -ctl.ftol = eps; -ctl.dtol = 1e-7; -mytic() ; -if strcmp(optim_func,"bfgsmin") - ctl = {-1,2,1,1}; - xinit2 = {xinit}; -else xinit2 = xinit; -endif -## [xlev,vlev,nlev] = feval(optim_func, "ff", "dff", xinit) ; -[xlev,vlev,nlev] = feval(optim_func, "ff", xinit2, ctl) ; -tlev = mytic() ; - - -if max (abs(xlev-truep)) > 1e-4, - if verbose - printf ("Error is too big : %8.3g\n", max (abs (xlev-truep))); - end - ok = 0; -elseif verbose, printf ("ok 1\n"); -end - -if verbose, - printf (" Costs : init=%8.3g, final=%8.3g, best=%8.3g\n",\ - ff(xinit), vlev, ff(truep)); -end -if verbose - printf ( " time : %8.3g\n",tlev); -end -if verbose && ok - printf ( "All tests ok (there's just one test)\n"); -end -
--- a/main/optim/test_min_3.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,111 +0,0 @@ -## Copyright (C) 2002 Etienne Grossmann. All rights reserved. -## -## This program 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. -## -## This 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. - - -## ok - Test that bfgs works with extra -## arguments -## -## Defines some simple functions and verifies that calling -## bfgs on them returns the correct minimum. -## -## Sets 'ok' to 1 if success, 0 otherwise - -## The name of the optimizing function -## modified 2004-05-20 by Michael Creel to adapt to bfgsmin -if ! exist ("optim_func"), optim_func = "bfgsmin"; end - -ok = 1; - -if ! exist ("verbose"), verbose = 0; end - -P = 2; -R = 3; - -## Make tests reproducible -## obsmat = randn(R,P) ; -obsmat = zeros (R,P); -obsmat(sub2ind([R,P],1:R,1+rem(0:R-1,P))) = 1:R; - -## Make test_min_2 repeatable by using fixed starting point -## truep = randn(P,1) ; -## xinit = randn(P,1) ; -truep = rem (1:P, P/4)'; -xinit = truep + 2*(1:P)'/(P); - - -## global obses ; -obses = obsmat*truep ; - -extra = list (obsmat, obses); - - -function v = ff(x, obsmat, obses) - v = mean ( (obses - obsmat*x)(:).^2 ) + 1 ; -endfunction - - -function dv = dff(x, obsmat, obses) - er = -obses + obsmat*x ; - dv = 2*er'*obsmat / rows(obses) ; - ## dv = 2*er'*obsmat ; -endfunction - - - -if verbose - printf (" Checking that extra arguments are accepted\n\n"); - - printf ([" Set 'optim_func' to the name of the optimization\n",\ - " function you want to test (must have same synopsis\n",\ - " as 'bfgs')\n\n"]); - - printf (" Tested function : %s\n",optim_func); - printf (" Nparams = P = %i, Nobses = R = %i\n",P,R); - fflush (stdout); -end -function dt = mytic() - static last_mytic = 0 ; - [t,u,s] = cputime() ; - dt = t - last_mytic ; - last_mytic = t ; -endfunction - -ctl.df = "dff"; -mytic() ; -## [xlev,vlev,nlev] = feval (optim_func, "ff", "dff", xinit, "extra", extra) ; -## [xlev,vlev,nlev] = feval \ -## (optim_func, "ff", "dff", list (xinit, obsmat, obses)); -if strcmp(optim_func,"bfgsmin") - ctl = {-1,2,1,1}; -endif -[xlev,vlev,nlev] = feval \ - (optim_func, "ff", {xinit, obsmat, obses}, ctl); -tlev = mytic() ; - - -if max (abs(xlev-truep)) > 1e-4, - if verbose, - printf ("Error is too big : %8.3g\n", max (abs (xlev-truep))); - end - ok = 0; -end -if verbose, - printf (" Costs : init=%8.3g, final=%8.3g, best=%8.3g\n",\ - ff(xinit,obsmat,obses), vlev, ff(truep,obsmat,obses)); -end -if verbose - printf ( " time : %8.3g\n",tlev); -end -if verbose && ok - printf ( "All tests ok\n"); -end -
--- a/main/optim/test_min_4.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,117 +0,0 @@ -## Copyright (C) 2002 Etienne Grossmann. All rights reserved. -## -## This program 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. -## -## This 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. - -## test_bfgs - Test that bfgs works -## -## Check that bfgs treats struct options correctly -## -## Sets 'ok' to 1 if success, 0 otherwise - -## The name of the optimizing function -if ! exist ("optim_func"), optim_func = "bfgsmin"; end - -ok = 1; -cnt = 0; - -if ! exist ("verbose"), verbose = 0; end - -N = 2; - -## Make test reproducible -## x0 = randn(N,1) ; -## y0 = randn(N,1) ; -x0 = (1:N)'/N; -y0 = (N:-1:1)'/N; - -function v = ff(x,y,t) - A = [1 -1;1 1]; M = A'*diag([100,1])*A; - v = ((x - y)(1:2))'*M*((x-y)(1:2)) + 1; -endfunction - - -function dv = dff(x,y,t) - if nargin < 3, t = 1; end - if t == 1, N = length (x); else N = length (y); end - A = [1 -1;1 1]; M = A'*diag([100,1])*A; - dv = 2*((x-y)(1:2))'*M; - if N>2, dv = [dv, zeros(1,N-2)]; end - if t == 2, dv = -dv; end -endfunction - - -if verbose - printf ("\n Testing that %s accepts struct control variable\n\n",\ - optim_func); - - printf ([" Set 'optim_func' to the name of the optimization\n",\ - " function you want to test (must have same synopsis\n",\ - " as 'bfgsmin')\n\n"]); - - printf (" Nparams = N = %i\n",N); - fflush (stdout); -end - -## Plain run, just to make sure ###################################### -## Minimum wrt 'x' is y0 -## [xlev,vlev,nlev] = feval (optim_func, "ff", "dff", list (x0,y0,1)); -## ctl.df = "dff"; -[xlev,vlev,nlev] = feval (optim_func, "ff", {x0,y0,1}); - -cnt++; -if max (abs (xlev-y0)) > 100*sqrt (eps) - if verbose - printf ("Error is too big : %8.3g\n", max (abs (xlev-y0))); - end - ok = 0; -elseif verbose, printf ("ok %i\n",cnt); -end - -## Minimize wrt 2nd arg ############################################## -## Minimum wrt 'y' is x0 -## ctl = struct ("narg", 2,"df","dff"); -## ctl = [nan,nan,2]; -## [xlev,vlev,nlev] = feval (optim_func, "ff", list (x0,y0,2),ctl); - -[xlev,vlev,nlev] = feval (optim_func, "ff", {x0,y0,2},{inf,0,1,2}); - -cnt++; -if max (abs (xlev-x0)) > 100*sqrt (eps) - if verbose - printf ("Error is too big : %8.3g\n", max (abs (xlev-x0))); - end - ok = 0; -elseif verbose, printf ("ok %i\n",cnt); -end - -## Set the verbose option ############################################ -## Minimum wrt 'x' is y0 -## ctl = struct ("narg", 1,"verbose",verbose, "df", "dff"); -## ctl = [nan,nan,2]; -## [xlev,vlev,nlev] = feval (optim_func, "ff", "dff", list (x0,y0,1),ctl); -[xlev,vlev,nlev] = feval (optim_func, "ff", {x0,y0,1},{inf,1,1,1}); - -cnt++; -if max (abs (xlev-y0)) > 100*sqrt (eps) - if verbose - printf ("Error is too big : %8.3g\n", max (abs (xlev-y0))); - end - ok = 0; -elseif verbose, printf ("ok %i\n",cnt); -end - - - - -if verbose && ok - printf ( "All tests ok\n"); -end -
--- a/main/optim/test_minimize_1.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,253 +0,0 @@ -## Copyright (C) 2002 Etienne Grossmann. All rights reserved. -## -## This program 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. -## -## This 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. - -## ok = test_minimize - Test that minimize works -## - -ok = 1; # Remains set if all ok. Set to 0 otherwise -cnt = 0; # Test counter -page_screen_output = 0; -page_output_immediately = 1; - -if ! exist ("verbose"), verbose = 0; end - -N = 2; - -x0 = randn(N,1) ; -y0 = randn(N,1) ; - -## Return value -function v = ff(x,y,t) - A = [1 -1;1 1]; M = A'*diag([100,1])*A; - v = ((x - y)(1:2))'*M*((x-y)(1:2)) + 1; -endfunction - -## Return differential -function dv = dff(x,y,t) - if nargin < 3, t = 1; end - if t == 1, N = length (x); else N = length (y); end - A = [1 -1;1 1]; M = A'*diag([100,1])*A; - dv = 2*((x-y)(1:2))'*M; - if N>2, dv = [dv, zeros(1,N-2)]; end - if t == 2, dv = -dv; end -endfunction - -## Return value, diff and 2nd diff -function [v,dv,d2v] = d2ff(x,y,t) - if nargin < 3, t = 1; end - if t == 1, N = length (x); else N = length (y); end - A = [1 -1;1 1]; M = A'*diag([100,1])*A; - v = ((x - y)(1:2))'*M*((x-y)(1:2)) + 1; - dv = 2*((x-y)(1:2))'*M; - d2v = zeros (N); d2v(1:2,1:2) = 2*M; - if N>2, dv = [dv, zeros(1,N-2)]; end - if t == 2, dv = -dv; end -endfunction - -## Return value, diff and inv of 2nd diff -function [v,dv,d2v] = d2iff(x,y,t) - if nargin < 3, t = 1; end - if t == 1, N = length (x); else N = length (y); end - A = [1 -1;1 1]; M = A'*diag([100,1])*A; - v = ((x - y)(1:2))'*M*((x-y)(1:2)) + 1; - dv = 2*((x-y)(1:2))'*M; - d2v = zeros (N); d2v(1:2,1:2) = inv (2*M); - if N>2, dv = [dv, zeros(1,N-2)]; end - if t == 2, dv = -dv; end -endfunction - -## PRint Now -function prn (varargin), printf (varargin{:}); fflush (stdout); end - - -if verbose - prn ("\n Testing that minimize() works as it should\n\n"); - prn (" Nparams = N = %i\n",N); - fflush (stdout); -end - -## Plain run, just to make sure ###################################### -## Minimum wrt 'x' is y0 -[xlev,vlev,nlev] = minimize ("ff",list (x0,y0,1)); - -cnt++; -if max (abs (xlev-y0)) > 100*sqrt (eps) - if verbose - prn ("Error is too big : %8.3g\n", max (abs (xlev-y0))); - end - ok = 0; -elseif verbose, prn ("ok %i\n",cnt); -end - -## See what 'backend' gives in that last case ######################## -[method,ctl] = minimize ("ff",list (x0,y0,1),"order",0,"backend"); - -cnt++; -if ! ischar (method) || ! strcmp (method,"nelder_mead_min") - if verbose - if ischar (method) - prn ("Wrong method '%s' != 'nelder_mead_min' was chosen\n", method); - else - prn ("minimize pretends to use a method that isn't a string\n"); - end - return - end - ok = 0; -elseif verbose, prn ("ok %i\n",cnt); -end - -[xle2,vle2,nle2] = feval (method, "ff",list (x0,y0,1), ctl); -cnt++; - # nelder_mead_min is not very repeatable - # because of restarts from random positions -if max (abs (xlev-xle2)) > 100*sqrt (eps) - if verbose - prn ("Error is too big : %8.3g\n", max (abs (xlev-xle2))); - end - ok = 0; -elseif verbose, prn ("ok %i\n",cnt); -end - - -## Run, w/ differential, just to make sure ########################### -## Minimum wrt 'x' is y0 - -# [xlev,vlev,nlev] = minimize ("ff",list (x0,y0,1),"df","dff"); - -# cnt++; -# if max (abs (xlev-y0)) > 100*sqrt (eps) -# if verbose -# prn ("Error is too big : %8.3g\n", max (abs (xlev-y0))); -# end -# ok = 0; -# elseif verbose, prn ("ok %i\n",cnt); -# en - -## Run, w/ differential returned by function ('jac' option) ########## -## Minimum wrt 'x' is y0 -# [xlev,vlev,nlev] = minimize ("d2ff",list (x0,y0,1),"jac"); - -# cnt++; -# if max (abs (xlev-y0)) > 100*sqrt (eps) -# if verbose -# prn ("Error is too big : %8.3g\n", max (abs (xlev-y0))); -# end -# ok = 0; -# elseif verbose, prn ("ok %i\n",cnt); -# end - -## Run, w/ 2nd differential, just to make sure ####################### -## Minimum wrt 'x' is y0 -[xlev,vlev,nlev] = minimize ("ff",list (x0,y0,1),"d2f","d2ff"); - -cnt++; -if max (abs (xlev-y0)) > 100*sqrt (eps) - if verbose - prn ("Error is too big : %8.3g\n", max (abs (xlev-y0))); - end - ok = 0; -elseif verbose, prn ("ok %i\n",cnt); -end - -## Use the 'hess' option, when f can return 2nd differential ######### -## Minimum wrt 'x' is y0 -[xlev,vlev,nlev] = minimize ("d2ff",list (x0,y0,1),"hess"); - -cnt++; -if max (abs (xlev-y0)) > 100*sqrt (eps) - if verbose - prn ("Error is too big : %8.3g\n", max (abs (xlev-y0))); - end - ok = 0; -elseif verbose, prn ("ok %i\n",cnt); -end - -## Run, w/ inverse of 2nd differential, just to make sure ############ -## Minimum wrt 'x' is y0 -[xlev,vlev,nlev] = minimize ("ff",list (x0,y0,1),"d2i","d2iff"); - -cnt++; -if max (abs (xlev-y0)) > 100*sqrt (eps) - if verbose - prn ("Error is too big : %8.3g\n", max (abs (xlev-y0))); - end - ok = 0; -elseif verbose, prn ("ok %i\n",cnt); -end - -## Use the 'ihess' option, when f can return pinv of 2nd differential -## Minimum wrt 'x' is y0 -[xlev,vlev,nlev] = minimize ("d2iff",list (x0,y0,1),"ihess"); - -cnt++; -if max (abs (xlev-y0)) > 100*sqrt (eps) - if verbose - prn ("Error is too big : %8.3g\n", max (abs (xlev-y0))); - end - ok = 0; -elseif verbose, prn ("ok %i\n",cnt); -end - -## Run, w/ numerical differential #################################### -## Minimum wrt 'x' is y0 -[xlev,vlev,nlev] = minimize ("ff",list (x0,y0,1),"ndiff"); - -cnt++; -if max (abs (xlev-y0)) > 100*sqrt (eps) - if verbose - prn ("Error is too big : %8.3g\n", max (abs (xlev-y0))); - end - ok = 0; -elseif verbose, prn ("ok %i\n",cnt); -end - -## Run, w/ numerical differential, specified by "order" ############## -## Minimum wrt 'x' is y0 -[xlev,vlev,nlev] = minimize ("ff",list (x0,y0,1),"order",1); - -cnt++; -if max (abs (xlev-y0)) > 100*sqrt (eps) - if verbose - prn ("Error is too big : %8.3g\n", max (abs (xlev-y0))); - end - ok = 0; -elseif verbose, prn ("ok %i\n",cnt); -end - -# ## See what 'backend' gives in that last case ######################## -# [method,ctl] = minimize ("ff",list (x0,y0,1),"order",1,"backend"); - -# cnt++; -# if ! strcmp (method,"bfgsmin") -# if verbose -# prn ("Wrong method '%s' != 'bfgsmin' was chosen\n", method); -# end -# ok = 0; -# elseif verbose, prn ("ok %i\n",cnt); -# end - -## [xle2,vle2,nle2] = feval (method, "ff",list (x0,y0,1), ctl); -[xle2,vle2,nle2] = minimize ("ff",list (x0,y0,1),"order",1); -cnt++; -if max (abs (xlev-xle2)) > 100*eps - if verbose - prn ("Error is too big : %8.3g\n", max (abs (xlev-y0))); - end - ok = 0; -elseif verbose, prn ("ok %i\n",cnt); -end - - -if verbose && ok - prn ( "All tests ok\n"); -end -
--- a/main/optim/test_nelder_mead_min_1.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,190 +0,0 @@ -## Copyright (C) 2002 Etienne Grossmann. All rights reserved. -## -## This program 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. -## -## This 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. - - -## -## Checks wether the function 'nelder_mead_min' works, by making it minimize a -## quadratic function. -## - -## Author: Etienne Grossmann <etienne@cs.uky.edu> - -ok = 1; -cnt = 1; - -if ! exist ("verbose"), verbose = 0; end -if verbose, printf (" test_nelder_mead : \n"); end - -if ! exist ("inspect"), inspect = 0; end - -tol = 100*sqrt (eps); - -R = 3 ; -C = 2; - -if verbose, - printf (" optimization problem has dimension %i\n",R*C); -end - -function c = my_quad_func (x,y,z) - c = 1 + sum ((x-y)(:)'*z*((x-y)(:))); -end - -function c = non_quad_func_1 (x,y,z) - tmp = sum ((x-y)(:)'*z*((x-y)(:))); - c = 1 + 1.1*tmp + sin (sqrt(tmp)); -end - -function c = non_quad_func_2 (x,y,z) - tmp1 = sum ((x-y)(:)'*z*((x-y)(:))); - tmp2 = max (abs ((x-y)(:)))^2; - c = 1 + 1.1*tmp1 + tmp2 ; -end - -## dt = mytic() -## -## Returns the cputime since last call to 'mytic'. - -function dt = mytic() - static last_mytic = 0 ; - [t,u,s] = cputime() ; - dt = t - last_mytic ; - last_mytic = t ; -endfunction - -fnames = list ( "my_quad_func", "non_quad_func_1", "non_quad_func_2"); - -x0 = randn(R,C) ; -x1 = x0 + randn(R,C) ; -z = randn (R*C); z = z*z'; - -for i = 1:length (fnames) - fname = nth (fnames, i); - if verbose, - printf ("trying to minimize '%s'\n", fname); - end - ctl = nan*zeros (1,6); - - mytic (); - [x2,v,nf] = nelder_mead_min (fname, list (x1,x0,z), ctl) ; - t0 = mytic (); - - if any (abs (x2-x0)(:) > 100*tol), - if verbose || inspect, printf ("not ok %i\n",cnt); end - [max(abs (x2-x0)(:)), 100*tol] - if inspect, keyboard; end - ok = 0 ; - else - if verbose, - printf ("ok %i\n function evaluations = %i\n",cnt,nf); - end - end - cnt++; - - # Use vanilla nelder_mead_min - mytic (); - [x2,v,nf] = nelder_mead_min (fname, list (x1,x0,z)) ; - t1 = mytic (); - - if any (abs (x2-x0)(:) > 100*tol), - if verbose || inspect, printf ("not ok %i\n",cnt); end - [max(abs (x2-x0)(:)), 100*tol] - if inspect, keyboard; end - ok = 0 ; - else - if verbose, - printf ("ok %i\n function evaluations = %i\n",cnt,nf); - end - end - cnt++; - - - # Optimize wrt 2nd arg. - ctl = nan * zeros (1,6); - ctl(6) = 0; - ctl(3) = 2; - - mytic (); - [x2,v,nf] = nelder_mead_min (fname, list (x1,x0,z), ctl) ; - t0 = mytic (); - - if any (abs (x2-x1)(:) > 100*tol), - if verbose || inspect, printf ("not ok %i\n",cnt); end - [max(abs (x2-x0)(:)), 100*tol] - if inspect, keyboard; end - ok = 0 ; - else - if verbose, - printf ("ok %i\n function evaluations = %i\n",cnt,nf); - end - end - cnt++; - - # Optimize wrt 2nd arg. - ctl = nan * zeros (1,6); - ctl(3) = 2; - - mytic (); - [x2,v,nf] = nelder_mead_min (fname, list (x1,x0,z), ctl) ; - t1 = mytic (); - - if any (abs (x2-x1)(:) > tol), - if verbose || inspect, printf ("not ok %i\n",cnt); end - [max(abs (x2-x0)(:)), 100*tol] - if inspect, keyboard; end - ok = 0 ; - else - if verbose, - printf ("ok %i\n function evaluations = %i\n",cnt,nf); - end - end - cnt++; - if 0 - # Check with struct control variable - ctls = struct ("narg", 2); - [x2bis,vbis,nfbis] = nelder_mead_min (fname, list (x1,x0,z), ctls) ; - t1 = mytic (); - ## [nf,nfbis] - if any ((x2-x2bis)(:)) - if verbose || inspect, printf ("not ok %i\n",cnt); end - printf (" struct ctl : x2 - x2bis -> %g\n", max(abs (x2-x2bis)(:))); - if inspect, keyboard; end - ok = 0 ; - else - if verbose, - printf ("ok %i\n function evaluations = %i\n",cnt,nfbis); - end - end - cnt++; - - # Check with named args - [x2bis,vbis,nfbis] = nelder_mead_min (fname, list (x1,x0,z), "narg", 2) ; - t1 = mytic (); - ## [nf,nfbis] - if any ((x2-x2bis)(:)) - if verbose || inspect, printf ("not ok %i\n",cnt); end - printf (" named arg : x2 - x2bis -> %g\n", max(abs (x2-x2bis)(:))); - if inspect, keyboard; end - ok = 0 ; - else - if verbose, - printf ("ok %i\n function evaluations = %i\n",cnt,nfbis); - end - end - cnt++; - end -end - -if verbose && ok - printf ("All tests ok\n"); -end -
--- a/main/optim/test_nelder_mead_min_2.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,155 +0,0 @@ -## Copyright (C) 2002 Etienne Grossmann. All rights reserved. -## -## This program 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. -## -## This 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. - - -## -## Checks wether the function 'nelder_mead_min' accepts options properly -## - -## Author: Etienne Grossmann <etienne@cs.uky.edu> - -ok = 1; -cnt = 1; - -if ! exist ("verbose"), verbose = 0; end -if ! exist ("inspect"), inspect = 0; end - -if verbose, - printf (["test_nelder_mead_2\n",\ - " Check whether nelder_mead_min accepts options properly\n\n"]); -end - -N = 2; -x1 = zeros (1,N); -small = 1e-3; -vol = (small^N) / factorial (N); - -## Define simple 2D function : [x,y] -> x^2, start from [0,0] -## - -function c = my_func (x) - c = x(1)^2; -end - -###################################################################### -## Test using volume ################################################# - -## Choose vtol and initial simplex so that algo should stop immediately. -ctl = struct ("verbose",verbose, "isz",small, "vtol",vol*1.01, "rst",0); - -[x2,v,nev] = nelder_mead_min ("my_func", x1, ctl); - -if nev != N+1 - if verbose || inspect, printf ("not ok %i\n",cnt); end - if inspect, keyboard; end - ok = 0 ; -else - if verbose, - printf ("ok %i\n",cnt); - end -end -cnt++; - -## Choose vtol and initial simplex so that algo should stop after one -## iteration (should be a reflexion and a tentative extension). Total is 5 -## evaluations. -ctl = struct ("verbose",verbose, "isz",small, "vtol",vol*0.99, "rst",0); - -x1 = [0,0]; - -[x2,v,nev] = nelder_mead_min ("my_func", x1, ctl); - -if nev != N+3 - if verbose || inspect, printf ("not ok %i\n",cnt); end - if inspect, keyboard; end - ok = 0 ; -else - if verbose, - printf ("ok %i\n",cnt); - end -end -cnt++; - -###################################################################### -## Test using radius ################################################# - -## Choose rtol and initial simplex so that algo stops immediately. -ctl = struct ("verbose",verbose, "isz",small, "rtol",small*2.01, "rst",0); - -[x2,v,nev] = nelder_mead_min ("my_func", x1, ctl); - -if nev != N+1 - if verbose || inspect, printf ("not ok %i\n",cnt); end - if inspect, keyboard; end - ok = 0 ; -else - if verbose, - printf ("ok %i\n",cnt); - end -end -cnt++; - -## Choose rtol and initial simplex so that algo does not stop immediately. -ctl = struct ("verbose",verbose, "isz",small, "rtol",small*1.99, "rst",0); - -[x2,v,nev] = nelder_mead_min ("my_func", x1, ctl); - -if nev <= N+1 - if verbose || inspect, printf ("not ok %i\n",cnt); end - if inspect, keyboard; end - ok = 0 ; -else - if verbose, - printf ("ok %i\n",cnt); - end -end -cnt++; - -###################################################################### -## Test using values ################################################# - -## Choose rtol and initial simplex so that algo should stop immediately. -ctl = struct ("verbose",verbose, "isz",small, "ftol",1.01*small^2, "rst",0); - -[x2,v,nev] = nelder_mead_min ("my_func", x1, ctl); - -if nev != N+1 - if verbose || inspect, printf ("not ok %i\n",cnt); end - if inspect, keyboard; end - ok = 0 ; -else - if verbose, - printf ("ok %i\n",cnt); - end -end -cnt++; - -## Choose rtol and initial simplex so that algo does not stop immediately. -ctl = struct ("verbose",verbose, "isz",small, "ftol",0.99*small^2, "rst",0); - -[x2,v,nev] = nelder_mead_min ("my_func", x1, ctl); - -if nev <= N+1 - if verbose || inspect, printf ("not ok %i\n",cnt); end - if inspect, keyboard; end - ok = 0 ; -else - if verbose - printf ("ok %i\n",cnt); - end -end -cnt++; - -cnt--; -if verbose && ok - printf ("All %i tests ok\n", cnt); -end
--- a/main/optim/test_wpolyfit.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,512 +0,0 @@ -## Tests for wpolyfit. -## -## Test cases are taken from the NIST Statistical Reference Datasets -## http://www.itl.nist.gov/div898/strd/ - -## Author: Paul Kienzle -## This program is public domain - -1; - -function do_test(n,x,y,p,dp,varargin) - [myp,s] = wpolyfit(x,y,n,varargin{:}); - %if length(varargin)==0, [myp,s] = polyfit(x,y,n); else return; end - mydp = sqrt(sumsq(inv(s.R'))'/s.df)*s.normr; - if length(varargin)>0, mydp = [mydp;0]; end %origin - %[svdp,j,svddp] = svdfit(x,y,n); - disp('parameter certified value rel. error'); - [myp(:), p, abs((myp(:)-p)./p)] %, svdp, abs((svdp-p)./p) ] - disp('p-error certified value rel. error'); - [mydp(:), dp, abs((mydp(:) - dp)./dp)] %, svdp, abs((svddp - dp)./dp)] - input('Press <Enter> to proceed to the next test'); -endfunction - -## x y dy -data = [0.0013852 0.2144023 0.0020470 - 0.0018469 0.2516856 0.0022868 - 0.0023087 0.3070443 0.0026362 - 0.0027704 0.3603186 0.0029670 - 0.0032322 0.4260864 0.0033705 - 0.0036939 0.4799956 0.0036983 ]; -x=data(:,1); y=data(:,2); dy=data(:,3); -wpolyfit(x,y,dy,1); -disp('computing parameter uncertainty from monte carlo simulation...'); -fflush(stdout); -n=100; p=zeros(2,n); -for i=1:n, p(:,i)=(polyfit(x,y+randn(size(y)).*dy,1)).'; end -printf("%15s %15s\n", "Coefficient", "Error"); -printf("%15g %15g\n", [mean(p'); std(p')]); -input('Press <Enter> to see some sample regression lines: '); -t = [x(1), x(length(x))]; -[p,s] = wpolyfit(x,y,dy,1); dp=sqrt(sumsq(inv(s.R'))'/s.df)*s.normr; -hold off; -for i=1:15, plot(t,polyval(p(:)+randn(size(dp)).*dp,t),'-g;;'); hold on; end -errorbar(x,y,dy,"~b;;"); -[yf,dyf]=polyconf(p,x,s,0.05,'ci'); -plot(x,yf-dyf,"-r;;",x,yf+dyf,'-r;95% confidence interval;') -hold off; -input('Press <Enter> to continue with the tests: '); - - -##Procedure: Linear Least Squares Regression -##Reference: Filippelli, A., NIST. -##Model: Polynomial Class -## 11 Parameters (B0,B1,...,B10) -## -## y = B0 + B1*x + B2*(x**2) + ... + B9*(x**9) + B10*(x**10) + e - -##Data: -## y x -data = [ 0.8116 -6.860120914 - 0.9072 -4.324130045 - 0.9052 -4.358625055 - 0.9039 -4.358426747 - 0.8053 -6.955852379 - 0.8377 -6.661145254 - 0.8667 -6.355462942 - 0.8809 -6.118102026 - 0.7975 -7.115148017 - 0.8162 -6.815308569 - 0.8515 -6.519993057 - 0.8766 -6.204119983 - 0.8885 -5.853871964 - 0.8859 -6.109523091 - 0.8959 -5.79832982 - 0.8913 -5.482672118 - 0.8959 -5.171791386 - 0.8971 -4.851705903 - 0.9021 -4.517126416 - 0.909 -4.143573228 - 0.9139 -3.709075441 - 0.9199 -3.499489089 - 0.8692 -6.300769497 - 0.8872 -5.953504836 - 0.89 -5.642065153 - 0.891 -5.031376979 - 0.8977 -4.680685696 - 0.9035 -4.329846955 - 0.9078 -3.928486195 - 0.7675 -8.56735134 - 0.7705 -8.363211311 - 0.7713 -8.107682739 - 0.7736 -7.823908741 - 0.7775 -7.522878745 - 0.7841 -7.218819279 - 0.7971 -6.920818754 - 0.8329 -6.628932138 - 0.8641 -6.323946875 - 0.8804 -5.991399828 - 0.7668 -8.781464495 - 0.7633 -8.663140179 - 0.7678 -8.473531488 - 0.7697 -8.247337057 - 0.77 -7.971428747 - 0.7749 -7.676129393 - 0.7796 -7.352812702 - 0.7897 -7.072065318 - 0.8131 -6.774174009 - 0.8498 -6.478861916 - 0.8741 -6.159517513 - 0.8061 -6.835647144 - 0.846 -6.53165267 - 0.8751 -6.224098421 - 0.8856 -5.910094889 - 0.8919 -5.598599459 - 0.8934 -5.290645224 - 0.894 -4.974284616 - 0.8957 -4.64454848 - 0.9047 -4.290560426 - 0.9129 -3.885055584 - 0.9209 -3.408378962 - 0.9219 -3.13200249 - 0.7739 -8.726767166 - 0.7681 -8.66695597 - 0.7665 -8.511026475 - 0.7703 -8.165388579 - 0.7702 -7.886056648 - 0.7761 -7.588043762 - 0.7809 -7.283412422 - 0.7961 -6.995678626 - 0.8253 -6.691862621 - 0.8602 -6.392544977 - 0.8809 -6.067374056 - 0.8301 -6.684029655 - 0.8664 -6.378719832 - 0.8834 -6.065855188 - 0.8898 -5.752272167 - 0.8964 -5.132414673 - 0.8963 -4.811352704 - 0.9074 -4.098269308 - 0.9119 -3.66174277 - 0.9228 -3.2644011]; - -##Certified values: -## p dP -target = [ -1467.48961422980 298.084530995537 - -2772.17959193342 559.779865474950 - -2316.37108160893 466.477572127796 - -1127.97394098372 227.204274477751 - -354.478233703349 71.6478660875927 - -75.1242017393757 15.2897178747400 - -10.8753180355343 2.23691159816033 - -1.06221498588947 0.221624321934227 - -0.670191154593408E-01 0.142363763154724E-01 - -0.246781078275479E-02 0.535617408889821E-03 - -0.402962525080404E-04 0.896632837373868E-05]; -if 1 - disp("Filippelli, A., NIST."); - do_test(10, data(:,2),data(:,1),flipud(target(:,1)),flipud(target(:,2))); -endif - -##Procedure: Linear Least Squares Regression -## -##Reference: Pontius, P., NIST. -## Load Cell Calibration. -## -##Model: Quadratic Class -## 3 Parameters (B0,B1,B2) -## y = B0 + B1*x + B2*(x**2) - - -##Data: y x -data = [ \ - .11019 150000 - .21956 300000 - .32949 450000 - .43899 600000 - .54803 750000 - .65694 900000 - .76562 1050000 - .87487 1200000 - .98292 1350000 - 1.09146 1500000 - 1.20001 1650000 - 1.30822 1800000 - 1.41599 1950000 - 1.52399 2100000 - 1.63194 2250000 - 1.73947 2400000 - 1.84646 2550000 - 1.95392 2700000 - 2.06128 2850000 - 2.16844 3000000 - .11052 150000 - .22018 300000 - .32939 450000 - .43886 600000 - .54798 750000 - .65739 900000 - .76596 1050000 - .87474 1200000 - .98300 1350000 - 1.09150 1500000 - 1.20004 1650000 - 1.30818 1800000 - 1.41613 1950000 - 1.52408 2100000 - 1.63159 2250000 - 1.73965 2400000 - 1.84696 2550000 - 1.95445 2700000 - 2.06177 2850000 - 2.16829 3000000 ]; - -## Certified Regression Statistics -## -## Standard Deviation -## Estimate of Estimate -target = [ \ - 0.673565789473684E-03 0.107938612033077E-03 - 0.732059160401003E-06 0.157817399981659E-09 - -0.316081871345029E-14 0.486652849992036E-16 ]; - -if 1 - disp("Pontius, P., NIST"); - do_test(2, data(:,2),data(:,1),flipud(target(:,1)),flipud(target(:,2))); -endif - - - -#Procedure: Linear Least Squares Regression -#Reference: Eberhardt, K., NIST. -#Model: Linear Class -# 1 Parameter (B1) -# -# y = B1*x + e - -#Data: y x -data =[\ - 130 60 - 131 61 - 132 62 - 133 63 - 134 64 - 135 65 - 136 66 - 137 67 - 138 68 - 139 69 - 140 70 ]; - - -# Certified Regression Statistics -# -# Standard Deviation -# Estimate of Estimate -target = [ \ - 0 0 - 2.07438016528926 0.165289256198347E-01 ]; - - -if 1 - disp("Eberhardt, K., NIST"); - do_test(1, data(:,2),data(:,1),flipud(target(:,1)),flipud(target(:,2)),'origin'); -endif - - -#Reference: Wampler, R. H. (1970). -# A Report of the Accuracy of Some Widely-Used Least -# Squares Computer Programs. -# Journal of the American Statistical Association, 65, 549-565. -# -#Model: Polynomial Class -# 6 Parameters (B0,B1,...,B5) -# -# y = B0 + B1*x + B2*(x**2) + B3*(x**3)+ B4*(x**4) + B5*(x**5) -# -# Certified Regression Statistics -# -# Standard Deviation -# Parameter Estimate of Estimate -target = [\ - 1.00000000000000 0.000000000000000 - 1.00000000000000 0.000000000000000 - 1.00000000000000 0.000000000000000 - 1.00000000000000 0.000000000000000 - 1.00000000000000 0.000000000000000 - 1.00000000000000 0.000000000000000 ]; - -#Data: y x -data = [\ - 1 0 - 6 1 - 63 2 - 364 3 - 1365 4 - 3906 5 - 9331 6 - 19608 7 - 37449 8 - 66430 9 - 111111 10 - 177156 11 - 271453 12 - 402234 13 - 579195 14 - 813616 15 - 1118481 16 - 1508598 17 - 2000719 18 - 2613660 19 - 3368421 20 ]; - -if 1 - disp("Wampler1"); - do_test(5, data(:,2),data(:,1),flipud(target(:,1)),flipud(target(:,2))); -endif - -##Reference: Wampler, R. H. (1970). -## A Report of the Accuracy of Some Widely-Used Least -## Squares Computer Programs. -## Journal of the American Statistical Association, 65, 549-565. -##Model: Polynomial Class -## 6 Parameters (B0,B1,...,B5) -## -## y = B0 + B1*x + B2*(x**2) + B3*(x**3)+ B4*(x**4) + B5*(x**5) -## -## Certified Regression Statistics -## Standard Deviation -## Parameter Estimate of Estimate -target = [ \ - 1.00000000000000 0.000000000000000 - 0.100000000000000 0.000000000000000 - 0.100000000000000E-01 0.000000000000000 - 0.100000000000000E-02 0.000000000000000 - 0.100000000000000E-03 0.000000000000000 - 0.100000000000000E-04 0.000000000000000 ]; - - -#Data: y x -data = [ \ - 1.00000 0 - 1.11111 1 - 1.24992 2 - 1.42753 3 - 1.65984 4 - 1.96875 5 - 2.38336 6 - 2.94117 7 - 3.68928 8 - 4.68559 9 - 6.00000 10 - 7.71561 11 - 9.92992 12 - 12.75603 13 - 16.32384 14 - 20.78125 15 - 26.29536 16 - 33.05367 17 - 41.26528 18 - 51.16209 19 - 63.00000 20 ]; - -if 1 - disp("Wampler2"); - do_test(5, data(:,2),data(:,1),flipud(target(:,1)),flipud(target(:,2))); -endif - - - - -##Reference: Wampler, R. H. (1970). -## A Report of the Accuracy of Some Widely-Used Least -## Squares Computer Programs. -## Journal of the American Statistical Association, 65, 549-565. -## -##Model: Polynomial Class -## 6 Parameters (B0,B1,...,B5) -## -## y = B0 + B1*x + B2*(x**2) + B3*(x**3)+ B4*(x**4) + B5*(x**5) -## -## Certified Regression Statistics -## -## Standard Deviation -## Parameter Estimate of Estimate -target = [\ - 1.00000000000000 2152.32624678170 - 1.00000000000000 2363.55173469681 - 1.00000000000000 779.343524331583 - 1.00000000000000 101.475507550350 - 1.00000000000000 5.64566512170752 - 1.00000000000000 0.112324854679312 ]; - -#Data: y x -data = [ \ - 760. 0 - -2042. 1 - 2111. 2 - -1684. 3 - 3888. 4 - 1858. 5 - 11379. 6 - 17560. 7 - 39287. 8 - 64382. 9 - 113159. 10 - 175108. 11 - 273291. 12 - 400186. 13 - 581243. 14 - 811568. 15 - 1121004. 16 - 1506550. 17 - 2002767. 18 - 2611612. 19 - 3369180. 20 ]; -if 1 - disp("Wampler3"); - do_test(5, data(:,2),data(:,1),flipud(target(:,1)),flipud(target(:,2))); -endif - -##Model: Polynomial Class -## 6 Parameters (B0,B1,...,B5) -## -## y = B0 + B1*x + B2*(x**2) + B3*(x**3)+ B4*(x**4) + B5*(x**5) -## -## Certified Regression Statistics -## -## Standard Deviation -## Parameter Estimate of Estimate -target = [\ - 1.00000000000000 215232.624678170 - 1.00000000000000 236355.173469681 - 1.00000000000000 77934.3524331583 - 1.00000000000000 10147.5507550350 - 1.00000000000000 564.566512170752 - 1.00000000000000 11.2324854679312 ]; - -#Data: y x -data = [\ - 75901 0 - -204794 1 - 204863 2 - -204436 3 - 253665 4 - -200894 5 - 214131 6 - -185192 7 - 221249 8 - -138370 9 - 315911 10 - -27644 11 - 455253 12 - 197434 13 - 783995 14 - 608816 15 - 1370781 16 - 1303798 17 - 2205519 18 - 2408860 19 - 3444321 20 ]; - -if 1 - disp("Wampler4"); - do_test(5, data(:,2),data(:,1),flipud(target(:,1)),flipud(target(:,2))); -endif - - - -##Model: Polynomial Class -## 6 Parameters (B0,B1,...,B5) -## -## y = B0 + B1*x + B2*(x**2) + B3*(x**3)+ B4*(x**4) + B5*(x**5) -## -## Certified Regression Statistics -## -## Standard Deviation -## Parameter Estimate of Estimate -target = [\ - 1.00000000000000 21523262.4678170 - 1.00000000000000 23635517.3469681 - 1.00000000000000 7793435.24331583 - 1.00000000000000 1014755.07550350 - 1.00000000000000 56456.6512170752 - 1.00000000000000 1123.24854679312 ]; - -##Data: y x -data = [ \ - 7590001 0 - -20479994 1 - 20480063 2 - -20479636 3 - 25231365 4 - -20476094 5 - 20489331 6 - -20460392 7 - 18417449 8 - -20413570 9 - 20591111 10 - -20302844 11 - 18651453 12 - -20077766 13 - 21059195 14 - -19666384 15 - 26348481 16 - -18971402 17 - 22480719 18 - -17866340 19 - 10958421 20 ]; -if 1 - disp("Wampler5"); - do_test(5, data(:,2),data(:,1),flipud(target(:,1)),flipud(target(:,2))); -endif
--- a/main/optim/wpolyfit.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,247 +0,0 @@ -## -*- texinfo -*- -## @deftypefn {Function File} {[@var{p}, @var{s}] =} wpolyfit (@var{x}, @var{y}, @var{dy}, @var{n}) -## Return the coefficients of a polynomial @var{p}(@var{x}) of degree -## @var{n} that minimizes -## @iftex -## @tex -## $$ -## \sum_{i=1}^N (p(x_i) - y_i)^2 -## $$ -## @end tex -## @end iftex -## @ifinfo -## @code{sumsq (p(x(i)) - y(i))}, -## @end ifinfo -## to best fit the data in the least squares sense. The standard error -## on the observations @var{y} if present are given in @var{dy}. -## -## The returned value @var{p} contains the polynomial coefficients -## suitable for use in the function polyval. The structure @var{s} returns -## information necessary to compute uncertainty in the model. -## -## To compute the predicted values of y with uncertainty use -## @example -## [y,dy] = polyconf(p,x,s,'ci'); -## @end example -## You can see the effects of different confidence intervals and -## prediction intervals by calling the wpolyfit internal plot -## function with your fit: -## @example -## feval('wpolyfit:plt',x,y,dy,p,s,0.05,'pi') -## @end example -## Use @var{dy}=[] if uncertainty is unknown. -## -## You can use a chi^2 test to reject the polynomial fit: -## @example -## p = 1-chisquare_cdf(s.normr^2,s.df); -## @end example -## p is the probability of seeing a chi^2 value higher than that which -## was observed assuming the data are normally distributed around the fit. -## If p < 0.01, you can reject the fit at the 1% level. -## -## You can use an F test to determine if a higher order polynomial -## improves the fit: -## @example -## [poly1,S1] = wpolyfit(x,y,dy,n); -## [poly2,S2] = wpolyfit(x,y,dy,n+1); -## F = (S1.normr^2 - S2.normr^2)/(S2.normr^2/S2.df); -## p = 1-f_cdf(F,1,S2.df); -## @end example -## p is the probability of observing the improvement in chi^2 obtained -## by adding the extra parameter to the fit. If p < 0.01, you can reject -## the higher order polynomial at the 1% level. -## -## You can estimate the uncertainty in the polynomial coefficients -## themselves using -## @example -## dp = sqrt(sumsq(inv(s.R'))'/s.df)*s.normr; -## @end example -## but the high degree of covariance amongst them makes this a questionable -## operation. -## -## @deftypefnx {Function File} {[@var{p}, @var{s}, @var{mu}] =} wpolyfit (...) -## -## If an additional output @code{mu = [mean(x),std(x)]} is requested then -## the @var{x} values are centered and normalized prior to computing the fit. -## This will give more stable numerical results. To compute a predicted -## @var{y} from the returned model use -## @code{y = polyval(p, (x-mu(1))/mu(2)} -## -## @deftypefnx {Function File} wpolyfit (...) -## -## If no output arguments are requested, then wpolyfit plots the data, -## the fitted line and polynomials defining the standard error range. -## -## Example -## @example -## x = linspace(0,4,20); -## dy = (1+rand(size(x)))/2; -## y = polyval([2,3,1],x) + dy.*randn(size(x)); -## wpolyfit(x,y,dy,2); -## @end example -## -## @deftypefnx {Function File} wpolyfit (..., 'origin') -## -## If 'origin' is specified, then the fitted polynomial will go through -## the origin. This is generally ill-advised. Use with caution. -## -## Hocking, RR (2003). Methods and Applications of Linear Models. -## New Jersey: John Wiley and Sons, Inc. -## -## @end deftypefn -## -## @seealso{polyfit,polyconf} - -## This program is in the public domain. -## Author: Paul Kienzle <pkienzle@users.sf.net> - -function [p_out, s, mu] = wpolyfit (varargin) - - ## strip 'origin' of the end - args = length(varargin); - if args>0 && ischar(varargin{args}) - origin = varargin{args}; - args--; - else - origin=''; - endif - ## strip polynomial order off the end - if args>0 - n = varargin{args}; - args--; - else - n = []; - end - ## interpret the remainder as x,y or x,y,dy or [x,y] or [x,y,dy] - if args == 3 - x = varargin{1}; - y = varargin{2}; - dy = varargin{3}; - elseif args == 2 - x = varargin{1}; - y = varargin{2}; - dy = []; - elseif args == 1 - A = varargin{1}; - [nr,nc]=size(A); - if all(nc!=[2,3]) - error("wpolyfit expects vectors x,y,dy or matrix [x,y,dy]"); - endif - dy = []; - if nc == 3, dy = A(:,3); endif - y = A(:,2); - x = A(:,1); - else - usage ("wpolyfit (x, y [, dy], n [, 'origin'])"); - end - - if (length(origin) == 0) - through_origin = 0; - elseif strcmp(origin,'origin') - through_origin = 1; - else - error ("wpolyfit: expected 'origin' but found '%s'", origin) - endif - - if any(size (x) != size (y)) - error ("wpolyfit: x and y must be vectors of the same size"); - endif - if length(dy)>1 && length(y) != length(dy) - error ("wpolyfit: dy must be a vector the same length as y"); - endif - - if (! (isscalar (n) && n >= 0 && ! isinf (n) && n == round (n))) - error ("wpolyfit: n must be a nonnegative integer"); - endif - - if nargout == 3 - mu = [mean(x), std(x)]; - x = (x - mu(1))/mu(2); - endif - - k = length (x); - - ## observation matrix - if through_origin - ## polynomial through the origin y = ax + bx^2 + cx^3 + ... - A = (x(:) * ones(1,n)) .^ (ones(k,1) * (n:-1:1)); - else - ## polynomial least squares y = a + bx + cx^2 + dx^3 + ... - A = (x(:) * ones (1, n+1)) .^ (ones (k, 1) * (n:-1:0)); - endif - - [p,s] = wsolve(A,y(:),dy(:)); - - if through_origin - p(n+1) = 0; - endif - - if nargout == 0 - good_fit = 1-chisquare_cdf(s.normr^2,s.df); - printf("Polynomial: %s [ p(chi^2>observed)=%.2f%% ]\n", polyout(p,'x'), good_fit*100); - plt(x,y,dy,p,s,'ci'); - else - p_out = p'; - endif - -function plt(x,y,dy,p,s,varargin) - - if iscomplex(p) - # XXX FIXME XXX how to plot complex valued functions? - # Maybe using hue for phase and saturation for magnitude - # e.g., Frank Farris (Santa Cruz University) has this: - # http://www.maa.org/pubs/amm_complements/complex.html - # Could also look at the book - # Visual Complex Analysis by Tristan Needham, Oxford Univ. Press - # but for now we punt - return - end - - ## decorate the graph - grid('on'); - xlabel('abscissa X'); ylabel('data Y'); - title('Least-squares Polynomial Fit with Error Bounds'); - - ## draw fit with estimated error bounds - xf = linspace(min(x),max(x),150)'; - [yf,dyf] = polyconf(p,xf,s,varargin{:}); - plot(xf,yf+dyf,"g.;;", xf,yf-dyf,"g.;;", xf,yf,"g-;fit;"); - - ## plot the data - hold on; - if (isempty(dy)) - plot(x,y,"x;data;"); - else - if isscalar(dy), dy = ones(size(y))*dy; end - errorbar (x, y, dy, "~;data;"); - endif - hold off; - - if strcmp(deblank(input('See residuals? [y,n] ','s')),'y') - clf; - if (isempty(dy)) - plot(x,y-polyval(p,x),"x;data;"); - else - errorbar(x,y-polyval(p,x),dy, '~;data;'); - endif - hold on; - grid on; - ylabel('Residuals'); - xlabel('abscissa X'); - plot(xf,dyf,'g.;;',xf,-dyf,'g.;;'); - hold off; - endif - -%!demo % #1 -%! x = linspace(0,4,20); -%! dy = (1+rand(size(x)))/2; -%! y = polyval([2,3,1],x) + dy.*randn(size(x)); -%! wpolyfit(x,y,dy,2); - -%!demo % #2 -%! x = linspace(-i,+2i,20); -%! noise = ( randn(size(x)) + i*randn(size(x)) )/10; -%! P = [2-i,3,1+i]; -%! y = polyval(P,x) + noise; -%! wpolyfit(x,y,2) -
--- a/main/optim/wpolyfitdemo.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,28 +0,0 @@ -## wpolyfitdemo(p) -## Generate some random data for the polynomial p, then fit that -## data. If p ends with 0, then the fit will be constrained to -## go through the origin. -## -## To force a variety of weights, poisson statistics are used to -## estimate the variance on the individual points, but gaussian -## statistics are used to generate new values within that variance. - -## Author: Paul Kienzle -## This program is public domain. -function wpolyfitdemo(pin) - if (nargin == 0) pin = [3 -1 2]'; endif - x = [-3:0.1:3]; - y = polyval(pin,x); - ## poisson weights - % dy = sqrt(abs(y)); - ## uniform weights in [0.5,1] - dy = 0.5 + 0.5*rand(size(y)); - - y = y + randn(size(y)).*dy; - printf("Original polynomial: %s\n", polyout(pin,'x')); - if (pin(length(pin)) == 0) - wpolyfit(x,y,dy,length(pin)-1,'origin'); - else - wpolyfit(x,y,dy,length(pin)-1); - endif -endfunction
--- a/main/optim/wsolve.m Sun Aug 20 13:29:36 2006 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,127 +0,0 @@ -## [x,s] = wsolve(A,y,dy) -## -## Solve a potentially over-determined system with uncertainty in -## the values. -## -## A x = y +/- dy -## -## Use QR decomposition for increased accuracy. Estimate the -## uncertainty for the solution from the scatter in the data. -## -## The returned structure s contains -## -## normr = sqrt( A x - y ), weighted by dy -## R such that R'R = A'A -## df = n-p, n = rows of A, p = columns of A -## -## See polyconf for details on how to use s to compute dy. -## The covariance matrix is inv(R'*R). If you know that the -## parameters are independent, then uncertainty is given by -## the diagonal of the covariance matrix, or -## -## dx = sqrt(N*sumsq(inv(s.R'))') -## -## where N = normr^2/df, or N = 1 if df = 0. -## -## Example 1: weighted system -## -## A=[1,2,3;2,1,3;1,1,1]; xin=[1;2;3]; -## dy=[0.2;0.01;0.1]; y=A*xin+randn(size(dy)).*dy; -## [x,s] = wsolve(A,y,dy); -## dx = sqrt(sumsq(inv(s.R'))'); -## res = [xin, x, dx] -## -## Example 2: weighted overdetermined system y = x1 + 2*x2 + 3*x3 + e -## -## A = fullfact([3,3,3]); xin=[1;2;3]; -## y = A*xin; dy = rand(size(y))/50; y+=dy.*randn(size(y)); -## [x,s] = wsolve(A,y,dy); -## dx = s.normr*sqrt(sumsq(inv(s.R'))'/s.df); -## res = [xin, x, dx] -## -## Note there is a counter-intuitive result that scaling the -## uncertainty in the data does not affect the uncertainty in -## the fit. Indeed, if you perform a monte carlo simulation -## with x,y datasets selected from a normal distribution centered -## on y with width 10*dy instead of dy you will see that the -## variance in the parameters indeed increases by a factor of 100. -## However, if the error bars really do increase by a factor of 10 -## you should expect a corresponding increase in the scatter of -## the data, which will increase the variance computed by the fit. - -## This program is public domain. - -function [x_out,s]=wsolve(A,y,dy) - if nargin < 2, usage("[x dx] = wsolve(A,y[,dy])"); end - if nargin < 3, dy = []; end - - [nr,nc] = size(A); - if nc > nr, error("underdetermined system"); end - - ## apply weighting term, if it was given - if prod(size(dy))==1 - A = A ./ dy; - y = y ./ dy; - elseif ~isempty(dy) - A = A ./ (dy * ones (1, columns(A))); - y = y ./ dy; - endif - - ## system solution: A x = y => x = inv(A) y - ## QR decomposition has good numerical properties: - ## AP = QR, with P'P = Q'Q = I, and R upper triangular - ## so - ## inv(A) y = P inv(R) inv(Q) y = P inv(R) Q' y = P (R \ (Q' y)) - ## Note that b is usually a vector and Q is matrix, so it will - ## be faster to compute (y' Q)' than (Q' y). - [Q,R,p] = qr(A,0); - x = R\(y'*Q)'; - x(p) = x; - - s.R = R; - s.R(:,p) = R; - s.df = nr-nc; - s.normr = norm(y - A*x); - - if nargout == 0, - cov = s.R'*s.R - if s.df, normalized_chisq = s.normr^2/s.df, end - x = x' - else - x_out = x; - endif - -## We can show that uncertainty dx = sumsq(inv(R'))' = sqrt(diag(inv(A'A))). -## -## Rather than calculate inv(A'A) directly, we are going to use the QR -## decomposition we have already computed: -## -## AP = QR, with P'P = Q'Q = I, and R upper triangular -## -## so -## -## A'A = PR'Q'QRP' = PR'RP' -## -## and -## -## inv(A'A) = inv(PR'RP') = inv(P')inv(R'R)inv(P) = P inv(R'R) P' -## -## For a permutation matrix P, -## -## diag(PXP') = P diag(X) -## -## so -## diag(inv(A'A)) = diag(P inv(R'R) P') = P diag(inv(R'R)) -## -## For R upper triangular, inv(R') = inv(R)' so inv(R'R) = inv(R)inv(R)'. -## Conveniently, for X upper triangular, diag(XX') = sumsq(X')', so -## -## diag(inv(A'A)) = P sumsq(inv(R)')' -## -## This is both faster and more accurate than computing inv(A'A) -## directly. -## -## One small problem: if R is not square then inv(R) does not exist. -## This happens when the system is underdetermined, but in that case -## you shouldn't be using wsolve. -