#
#NMSMAX  [x, fmax, nf] = NMSMAX(fun, x0, STOPIT, SAVIT) attempts to
#        maximize the function specified by the string 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).
#        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.

# References:
# J.E. Dennis, Jr., and D.J. Woods, Optimization on microcomputers:
#     The Nelder-Mead simplex algorithm, in New Computing Environments:
#     Microcomputers in Large-Scale Computing, A. Wouk, ed., Society for
#     Industrial and Applied Mathematics, Philadelphia, 1987, pp. 116-122.
#  N.J. Higham, Optimization by direct search in matrix computations,
#     Numerical Analysis Report No. 197, University of Manchester, UK, 1991;
#     to appear in SIAM J. Matrix Anal. Appl, 14 (2), April 1993.

# This is a heavily modified version of FMINS.M supplied with 386-MATLAB
# version 3.5j.

# By Nick Higham, Department of Mathematics, University of Manchester, UK.
#                 na.nhigham@na-net.ornl.gov
# July 27, 1991.

# Translated to RLaB, Ian Searle
# Feburary 1994.

nmsmax = function (fun, X, stopit, savit)
{
  global (eps)

  x = X;	# Copy the input
  n = prod(size(x));
  x0 = x[:];	# Work with column vector internally.

  # Set up convergence parameters etc.
  if (!exist (stopit)) { stopit[1] = 1e-3; }
  tol = stopit[1];	# Tolerance for cgce test based on relative size of simplex.
  if (max(size(stopit)) == 1) { stopit[2] = inf(); }	# Max no. of f-evaluations.
  if (max(size(stopit)) == 2) { stopit[3] = inf(); }	# Default target for f-values.
  if (max(size(stopit)) == 3) { stopit[4] = 0; }	# Default initial simplex.
  if (max(size(stopit)) == 4) { stopit[5] = 1; }	# Default: show progress.
  trace  = stopit[5];
  if (!exist (savit)) { savit = []; }			# File name for snapshots.

  V = [zeros(n,1), eye(n,n)];
  f = zeros(n+1,1);
  V[;1] = x0; 
  x = reshape (x0, x.nr, x.nc); 
  f[1] = fun (x);
  fmax_old = f[1];

  if (trace) { printf("f(x0) = %9.4e\n", f[1]); }

  k = 0; m = 0;

  # Set up initial simplex.
  scale = max([norm(x0,"i"),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 in 2:n+1)
    {
      V[j-1;j] = x0[j-1] + alpha[1];
      x = reshape (V[;j], x.nr, x.nc); 
      f[j] = fun (x);
    }
  else
    # Right-angled simplex based on co-ordinate axes.
    alpha = scale*ones(n+1,1);
    for (j in 2:n+1)
    {
      V[;j] = x0 + alpha[j]*V[;j];
      x = reshape (V[;j], x.nr, x.nc); 
      f[j] = fun (x);
    }
  }
  nf = n+1;
  how = "initial  ";

  temp = sort (f).val;
  j = sort (f).ind;
  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 = reshape (V[;1], x.nr, x.nc); 
        write("savit", x, fmax, nf);
      }
      if (trace)
      {
        printf("Iter. %2.0f"', k);
        printf("  how = %s  ", how);
        printf("nf = %3.0f,  f = %9.4e  (%2.1f)\n", nf, fmax, ...
               100*(fmax-fmax_old)/(abs(fmax_old)+eps));
      }
    }
    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.
    }

    # Stopping Test 2 - too many f-evals?
    if (nf >= stopit[2])
    {
      msg = "Max no. of function evaluations exceeded...quitting\n";
      break  # Quit.
    }

    # 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)
    {
      sprintf(msg, "Simplex size %9.4e <= %9.4e...quitting\n", ...
              size_simplex, tol);
      break  # Quit.
    }

    #  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 = reshape (vr, x.nr, x.nc);
    fr = fun (x);
    nf = nf + 1;
    vk = vr;  fk = fr; how = "reflect, ";
    if (fr > f[n])
    {
      if (fr > f[1])
      {
        ve = gamma*vr + (1-gamma)*vbar; 
        x = reshape (ve, x.nr, x.nc);
        fe = fun (x);
        nf = nf + 1;
        if (fe > f[1])
        {
          vk = ve; fk = fe;
          how = "expand,  ";
        }
      }
    else
      vt = V[;n+1];
      ft = f[n+1];
      if (fr > ft)
      {
        vt = vr;
        ft = fr;
      }
      vc = beta*vt + (1-beta)*vbar; 
      x = reshape (vc, x.nr, x.nc);
      fc = fun (x);
      nf = nf + 1;
      if (fc > f[n])
      {
        vk = vc; fk = fc;
        how = "contract,";
      else
        for (j in 2:n)
        {
          V[;j] = (V[;1] + V[;j])/2;
          x = reshape (V[;j], x.nr, x.nc);
          f[j] = fun (x);
        }
        nf = nf + n-1;
        vk = (V[;1] + V[;n+1])/2; 
        x = reshape (vk, x.nr, x.nc);
        fk = fun (x);
        nf = nf + 1;
        how = "shrink,  ";
      }
    }
    V[;n+1] = vk;
    f[n+1] = fk;
    temp = sort(f).val;
    j = sort (f).ind;
    j = j[n+1:1:-1];
    f = f[j]; 
    V = V[;j];

  }	###### End of outer (and only) loop.

  # Finished.
  if (trace) { printf(msg); }
  x = reshape (V[;1], x.nr, x.nc);

  return <<x = x; fmax = fmax; nf = nf>>;
};
