/* nag_glopt_bnd_mcs_optset_file (e05jcc) Example Program.
 *
 * Copyright 2006 Numerical Algorithms Group.
 *
 * Mark 9, 2009.
 */
#include <string.h>
#include <stdio.h>
#include <math.h>
#include <nag.h>
#include <nag_stdlib.h>
#include <nage05.h>
#include <nagx04.h>

#ifdef __cplusplus
extern "C" {
#endif
static void NAG_CALL objfun(Integer n, const double x[], double *f,
                            Integer nstate, Nag_Comm *comm, Integer *inform);
static void NAG_CALL monit(Integer n, Integer ncall, const double xbest[],
                           const Integer icount[], Integer sdlist,
                           const double list[], const Integer numpts[],
                           const Integer initpt[], Integer nbaskt,
                           const double xbaskt[], const double boxl[],
                           const double boxu[], Integer nstate, Nag_Comm *comm,
                           Integer *inform);
static void NAG_CALL output_current_box(Integer n, const double boxl[],
                                        const double boxu[], FILE *fpout);
#ifdef __cplusplus
}
#endif

int main(int argc, char *argv[])
{
  FILE              *fpin, *fpout;
  char              *optionsfile;
  char              *outfile;

  /* Scalars */
  double            infbnd, obj;
  Integer           exit_status, i, ibdchk, n, nf, plot, sdlist, stclim;
  Nag_BoundType     boundenum;
  Nag_MCSInitMethod initmethodenum;

  /* Arrays */
  char              bound[16], initmethod[18];
  double            *bl = 0, *bu = 0, *list = 0, *x = 0;
  char              lcsrch[3];
  Integer           *initpt = 0, *numpts = 0;
  Integer           iuser[1];

#define LIST(I, J) list[(I-1)*sdlist + (J-1)]

  /*Nag Types*/
  Nag_E05State      state;
  NagError          fail;
  Nag_Comm          comm;
  Nag_FileID        fileid;

  comm.iuser = iuser;

  exit_status = 0;
  INIT_FAIL(fail);


  /* Check for command-line IO options */
  fpin = nag_example_file_io(argc, argv, "-data", NULL);
  fpout = nag_example_file_io(argc, argv, "-results", NULL);
  (void) nag_example_file_io(argc, argv, "-nag_write", &outfile);
  (void) nag_example_file_io(argc, argv, "-options", &optionsfile);
  fprintf(fpout,
          "nag_glopt_bnd_mcs_optset_file (e05jcc) Example Program Results\n");

  comm.p = (Pointer) fpout;

  /* Skip heading in data file */
  fscanf(fpin, "%*[^\n] ");

  /* Read n and sdlist from data file */
  fscanf(fpin, "%ld%ld%*[^\n] ", &n, &sdlist);
  if (n > 0 && sdlist > 0)
    {
      /* Allocate memory */
      if (!(bl = NAG_ALLOC(n, double)) ||
          !(bu = NAG_ALLOC(n, double)) ||
          !(list = NAG_ALLOC(n*sdlist, double)) ||
          !(x = NAG_ALLOC(n, double)) ||
          !(initpt = NAG_ALLOC(n, Integer)) ||
          !(numpts = NAG_ALLOC(n, Integer)))
        {
          fprintf(fpout, "Allocation failure\n");
          exit_status = -1;
          goto END;
        }

      /* Read in bound (and bl and bu if necessary) */
      fscanf(fpin, "%s%*[^\n] ", bound);

      /*
       * nag_enum_name_to_value (x04nac).
       * Converts NAG enum member name to value
       */
      boundenum = (Nag_BoundType) nag_enum_name_to_value(bound);

      if (boundenum == Nag_Bounds)
      /* Read in the whole of each bound */
        {
          for (i = 0; i < n; ++i)
            fscanf(fpin, "%lf", &bl[i]);
          fscanf(fpin, "%*[^\n] ");

          for (i = 0; i < n; ++i)
            fscanf(fpin, "%lf", &bu[i]);
          fscanf(fpin, "%*[^\n] ");
        }
      else if (boundenum == Nag_BoundsEqual)
      /* Bounds are uniform: read in only the first entry of each */
        {
          fscanf(fpin, "%lf%*[^\n] ", &bl[0]);
          fscanf(fpin, "%lf%*[^\n] ", &bu[0]);
        }

      /* Read in initmethod (and list, numpts and initpt if necessary) */
      fscanf(fpin, "%s%*[^\n] ", initmethod);

      /*
       * nag_enum_name_to_value (x04nac).
       * Converts NAG enum member name to value
       */
      initmethodenum = (Nag_MCSInitMethod) nag_enum_name_to_value(initmethod);

      if (initmethodenum == Nag_UserSet)
        {
          for (i = 0; i < n*sdlist; ++i)
            fscanf(fpin, "%lf", &list[i]);
          fscanf(fpin, "%*[^\n] ");

          for (i = 0; i < n; ++i)
            fscanf(fpin, "%ld", &numpts[i]);
          fscanf(fpin, "%*[^\n] ");

          for (i = 0; i < n; ++i)
            fscanf(fpin, "%ld", &initpt[i]);
          fscanf(fpin, "%*[^\n] ");
        }

      /* Read in plot. Its value determines whether monit displays
         information on the current search box */

      fscanf(fpin, "%ld%*[^\n] ", &plot);

      /* Communicate plot through to monit */

      iuser[0] = plot;

      /* Call nag_glopt_bnd_mcs_init (e05jac) to initialize
       * nag_glopt_bnd_mcs_solve (e05jbc). */
      nag_glopt_bnd_mcs_init(n, &state, &fail);

      if (fail.code != NE_NOERROR)
        {
          fprintf(
            fpout,
            "Initialization of nag_glopt_bnd_mcs_init (e05jac) failed.\n%s\n",
            fail.message);
          exit_status = 1;
          goto END;
        }

      /* Use nag_glopt_bnd_mcs_optset_file (e05jcc) to read some options
       * from the end of the data file */

      /* Call nag_open_file (x04acc) to set the stdin fileid. */

      /* nag_open_file (x04acc).
       * Open unit number for reading, writing or appending, and
       * associate unit with named file
       */
      nag_open_file(optionsfile, 0, &fileid, &fail);

      if (fail.code != NE_NOERROR)
        {
          fprintf(fpout, "Fileid could not be obtained.\n");
          exit_status = 1;
          goto END;
        }

      /* nag_glopt_bnd_mcs_optset_file (e05jcc).
       * Supply optional parameter values for nag_glopt_bnd_mcs_solve
       * (e05jbc) from external file */
      nag_glopt_bnd_mcs_optset_file(fileid, &state, &fail);

      if (fail.code != NE_NOERROR)
        {
          fprintf(fpout,
                  "nag_glopt_bnd_mcs_optset_file (e05jcc) failed.\n%s\n",
                  fail.message);
          exit_status = 1;
          goto END;
        }

      fprintf(fpout, "\n");

      /* Use nag_glopt_bnd_mcs_optget_int (e05jkc) to find the value of
       * the Integer-valued option 'Function Evaluations Limit' */

      /* nag_glopt_bnd_mcs_optget_int (e05jkc).
       * Get the setting of an Integer-valued option of
       * nag_glopt_bnd_mcs_solve (e05jbc) */
      nag_glopt_bnd_mcs_optget_int("Function Evaluations Limit", &nf, &state,
                                   &fail);

      if (fail.code != NE_NOERROR)
        {
          fprintf(fpout, "nag_glopt_bnd_mcs_optget_int (e05jkc) failed.\n%s\n",
                  fail.message);
          exit_status = 1;
          goto END;
        }

      fprintf(fpout,
              "Option 'Function Evaluations Limit' has the value %ld.\n",
              nf);

      /* Use nag_glopt_bnd_mcs_optset_int (e05jfc) to set the value of the
       * Integer-valued option 'Static Limit' */

      stclim = 4*n;

      /* nag_glopt_bnd_mcs_optset_int (e05jfc).
       * Set a single Integer-valued option of
       * nag_glopt_bnd_mcs_solve (e05jbc) */

      nag_glopt_bnd_mcs_optset_int("Static Limit", stclim, &state, &fail);

      if (fail.code != NE_NOERROR)
        {
          fprintf(fpout, "nag_glopt_bnd_mcs_optset_int (e05jfc) failed.\n%s\n",
                  fail.message);
          exit_status = 1;
          goto END;
        }

      /* Use nag_glopt_bnd_mcs_option_check (e05jhc) to determine whether
       * the real-valued option 'Infinite Bound Size' has been set by us
       * (in which case 1 is returned) or whether it holds its default
       * value (in which case 0 is returned) */

      /* nag_glopt_bnd_mcs_option_check (e05jhc).
       * Determine whether the user has set a single option of
       * nag_glopt_bnd_mcs_solve (e05jbc) */

      ibdchk = nag_glopt_bnd_mcs_option_check("Infinite Bound Size", &state,
                                              &fail);

      if (fail.code != NE_NOERROR)
        {
          fprintf(fpout,
                  "nag_glopt_bnd_mcs_option_check (e05jhc) failed.\n%s\n",
                  fail.message);
          exit_status = 1;
          goto END;
        }

      if (ibdchk == 1)
        {
          fprintf(fpout, "Option 'Infinite Bound Size' has been set by us.\n");
        }
      else if (ibdchk == 0)
        {
          fprintf(fpout,
                  "Option 'Infinite Bound Size' holds its default value.\n");
        }

      /* Use nag_glopt_bnd_mcs_optget_real (e05jlc) to find the value of
       * the real-valued option 'Infinite Bound Size' */

      /* nag_glopt_bnd_mcs_optget_real (e05jlc).
       * Get the setting of a real-valued option of
       * nag_glopt_bnd_mcs_solve (e05jbc) */
      nag_glopt_bnd_mcs_optget_real("Infinite Bound Size", &infbnd, &state,
                                    &fail);

      if (fail.code != NE_NOERROR)
        {
          fprintf(fpout,
                  "nag_glopt_bnd_mcs_optget_real (e05jlc) failed.\n%s\n",
                  fail.message);
          exit_status = 1;
          goto END;
        }

      fprintf(fpout, "Option 'Infinite Bound Size' has the value %14.5e\n",
              infbnd);

      /* Use nag_glopt_bnd_mcs_optset_real (e05jgc) to increase the value of
       * the real-valued option 'Infinite Bound Size' tenfold */

      infbnd = 10.0*infbnd;

      /* nag_glopt_bnd_mcs_optset_real (e05jgc).
       * Set the value of a real-valued option of
       * nag_glopt_bnd_mcs_solve (e05jbc) */
      nag_glopt_bnd_mcs_optset_real("Infinite Bound Size", infbnd, &state,
                                    &fail);

      if (fail.code != NE_NOERROR)
        {
          fprintf(fpout,
                  "nag_glopt_bnd_mcs_optset_real (e05jgc) failed.\n%s\n",
                  fail.message);
          exit_status = 1;
          goto END;
        }

      /* Use nag_glopt_bnd_mcs_optset_string (e05jdc) to set the value of
       * the Integer-valued option 'Local Searches Limit' */

      /* nag_glopt_bnd_mcs_optset_string (e05jdc).
       * Set the value of an option of nag_glopt_bnd_mcs_solve (e05jbc)
       * from a string */
      nag_glopt_bnd_mcs_optset_string("Local Searches Limit = 40", &state,
                                      &fail);

      if (fail.code != NE_NOERROR)
        {
          fprintf(fpout,
                  "nag_glopt_bnd_mcs_optset_string (e05jdc) failed.\n%s\n",
                  fail.message);
          exit_status = 1;
          goto END;
        }

      /* Use nag_glopt_bnd_mcs_optset_char (e05jec) to set the value of
       * the 'On'/'Off'-valued character option 'Local Searches' */

      strcpy(&lcsrch[0], "On");

      /* nag_glopt_bnd_mcs_optset_char (e05jec).
       * Set the value of an 'On'/'Off'-valued character option of
       * nag_glopt_bnd_mcs_solve (e05jbc) */
      nag_glopt_bnd_mcs_optset_char("Local Searches", lcsrch, &state, &fail);

      if (fail.code != NE_NOERROR)
        {
          fprintf(fpout,
                  "nag_glopt_bnd_mcs_optset_string (e05jdc) failed.\n%s\n",
                  fail.message);
          exit_status = 1;
          goto END;
        }

      /* Solve the problem. */

      /* nag_glopt_bnd_mcs_solve (e05jbc).
       * Global optimization by multilevel coordinate search, simple bounds */
      nag_glopt_bnd_mcs_solve(n, objfun, boundenum, initmethodenum, bl, bu,
                              sdlist, list, numpts, initpt, monit, x, &obj,
                              &state, &comm, &fail);

      if (fail.code == NE_NOERROR)
        {
          fprintf(fpout, "Final objective value = %11.5f\n", obj);
          fprintf(fpout, "Global optimum X = ");

          for (i = 0; i < n; ++i)
            fprintf(fpout, "%9.5f", x[i]);
          fprintf(fpout, "\n");
        }
      else
        {
          fprintf(fpout,
                  "Error message from nag_glopt_bnd_mcs_solve (e05jbc).\n%s\n",
                  fail.message);
          exit_status = 1;
        }
    }
 END:
  if (fpin != stdin) fclose(fpin);
  if (fpout != stdout) fclose(fpout);
  if (bl) NAG_FREE(bl);
  if (bu) NAG_FREE(bu);
  if (list) NAG_FREE(list);
  if (x) NAG_FREE(x);
  if (initpt) NAG_FREE(initpt);
  if (numpts) NAG_FREE(numpts);
  if (optionsfile) NAG_FREE(optionsfile);

  return exit_status;
}

#undef LIST

static void NAG_CALL objfun(Integer n, const double x[], double *f,
                            Integer nstate, Nag_Comm *comm, Integer *inform)
{
  /* Routine to evaluate objective function */

  FILE *fpout = (FILE *) comm->p;
  *inform = 0;

  if (*inform >= 0)
  /* Here we're prepared to evaluate objfun at the current x */
    {
      if (nstate == 1)
      /* This is the first call to objfun */
        {
          fprintf(fpout, "\n(objfun was just called for the first time)\n");
        }

      *f = 3.0*pow((1.0-x[0]), 2)*exp(-pow(x[0], 2)-pow((x[1]+1), 2)) -
           10.0*
           (x[0]/5.0-
            pow(x[0], 3)-pow(x[1], 5))*exp(-pow(x[0], 2)-pow(x[1], 2)) -
           1.0/3.0*exp(-pow((x[0]+1.0), 2)-pow(x[1], 2));
    }
}

static void NAG_CALL monit(Integer n, Integer ncall, const double xbest[],
                           const Integer icount[], Integer sdlist,
                           const double list[], const Integer numpts[],
                           const Integer initpt[], Integer nbaskt,
                           const double xbaskt[], const double boxl[],
                           const double boxu[], Integer nstate, Nag_Comm *comm,
                           Integer *inform)
{
  /* Scalars */
  Integer i, j;
  Integer plot;

#define XBASKT(I, J) xbaskt[(I-1)*nbaskt + (J-1)]

  FILE    *fpout = (FILE *) comm->p;
  *inform = 0;

  if (*inform >= 0)
  /* We are going to allow the iterations to continue */
    {
      /* Extract plot from the communication structure */
      plot = comm->iuser[0];

      if (nstate == 0 || nstate == 1)
      /* When nstate == 1, monit is called for the first time.
       * When nstate == 0, monit is called for the first AND last time.
       * Display a welcome message */
        {
          fprintf(fpout, "\n*** Begin monitoring information ***\n\n");

          if (plot != 0 && n == 2)
            fprintf(fpout, "<Begin displaying search boxes>\n\n");
        }

      if (plot != 0 && n == 2)
        {
          /* Display the coordinates of the edges of the current search box */
          output_current_box(n, boxl, boxu, fpout);
        }

      if (nstate <= 0)
      /* monit is called for the last time */
        {
          if (plot != 0 && n == 2)
            fprintf(fpout, "<End displaying search boxes>\n\n");
          fprintf(fpout, "Total sub-boxes = %5ld\n", icount[0]);
          fprintf(fpout, "Total function evaluations = %5ld\n", ncall);
          fprintf(fpout, "Total function evaluations used in local search"
                  " = %5ld\n", icount[1]);
          fprintf(fpout, "Total points used in local search = %5ld\n",
                  icount[2]);
          fprintf(fpout, "Total sweeps through levels = %5ld\n", icount[3]);
          fprintf(fpout, "Total splits by init. list = %5ld\n", icount[4]);
          fprintf(fpout, "Lowest level with nonsplit boxes = %5ld\n",
                  icount[5]);
          fprintf(fpout, "Number of candidate minima in the 'shopping basket'"
                  " = %5ld\n", nbaskt);
          fprintf(fpout, "Shopping basket:\n");

          for (i = 1; i <= n; ++i)
            {
              fprintf(fpout, "xbaskt(%3ld,:) =", i);
              for (j = 1; j <= nbaskt; ++j)
                fprintf(fpout, "%9.5f", XBASKT(i, j));
              fprintf(fpout, "\n");
            }

          fprintf(fpout, "\n");
          fprintf(fpout, "*** End monitoring information ***\n");
          fprintf(fpout, "\n");
        }
    }
}

static void NAG_CALL output_current_box(Integer n, const double boxl[],
                                        const double boxu[], FILE *fpout)
{
  fprintf(fpout, "%20.15f %20.15f\n", boxl[0], boxl[1]);
  fprintf(fpout, "%20.15f %20.15f\n\n", boxl[0], boxu[1]);
  fprintf(fpout, "%20.15f %20.15f\n", boxl[0], boxl[1]);
  fprintf(fpout, "%20.15f %20.15f\n\n", boxu[0], boxl[1]);
  fprintf(fpout, "%20.15f %20.15f\n", boxl[0], boxu[1]);
  fprintf(fpout, "%20.15f %20.15f\n\n", boxu[0], boxu[1]);
  fprintf(fpout, "%20.15f %20.15f\n", boxu[0], boxl[1]);
  fprintf(fpout, "%20.15f %20.15f\n\n", boxu[0], boxu[1]);
}