/* nag_opt_sparse_convex_qp (e04nkc) Example Program.
 *
 * Copyright 1998 Numerical Algorithms Group.
 *
 * Mark 5, 1998.
 * Mark 6 revised, 2000.
 * Mark 7 revised, 2001.
 * Mark 8 revised, 2004.
 *
 */

#include <nag.h>
#include <stdio.h>
#include <string.h>
#include <nag_stdlib.h>
#include <nage04.h>
#include <nagx04.h>

#ifdef __cplusplus
extern "C" {
#endif
static void NAG_CALL qphess(Integer ncolh, double x[], double hx[],
                            Nag_Comm *comm);
#ifdef __cplusplus
}
#endif

/* Declare a data structure for passing sparse Hessian data to qphess */
typedef struct
{
  double  *hess;
  Integer *khess;
  Integer *hhess;
} HessianData;

#define NAMES(I, J) names[(I)*9+J]
#define MAXHESSNNZ MAXNNZ

int main(int argc, char *argv[])
{
  FILE        *fpin, *fpout;
  char        *outfile = 0;
  char        *optionsfile = 0;
  HessianData hess_data;
  Integer     exit_status = 0, *ha = 0, *hhess = 0, i, icol, iobj, j, jcol;
  Integer     *ka = 0, *khess = 0, m, n, nbnd, ncolh, ninf, nnz, nnz_hess;
  Nag_Comm    comm;
  Nag_E04_Opt options;
  char        **crnames = 0, *names = 0;
  double      *a = 0, *bl = 0, *bu = 0, *hess = 0, obj, sinf, *x = 0;
  NagError    fail;

  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, "-options", &optionsfile);
  (void) nag_example_file_io(argc, argv, "-nag_write", &outfile);
  if (!outfile)
    {
      outfile = NAG_ALLOC(7, char);
      strcpy(outfile, "stdout");
    }

  fprintf(fpout, "nag_opt_sparse_convex_qp (e04nkc) Example Program Results\n");

  /* Skip heading in data file */
  fscanf(fpin, " %*[^\n]");
  /* Read the problem dimensions */
  fscanf(fpin, " %*[^\n]");
  fscanf(fpin, "%ld%ld", &n, &m);

  /* Read nnz, iobj, ncolh */
  fscanf(fpin, " %*[^\n]");
  fscanf(fpin, "%ld%ld%ld", &nnz, &iobj, &ncolh);

  if (n >= 1 && m >= 1 && nnz >= 1 && nnz <= n*m)
    {
      nbnd = n + m;
      if (!(a = NAG_ALLOC(nnz, double)) ||
          !(bl = NAG_ALLOC(nbnd, double)) ||
          !(bu = NAG_ALLOC(nbnd, double)) ||
          !(x = NAG_ALLOC(nbnd, double)) ||
          !(hess = NAG_ALLOC(nnz, double)) ||
          !(ha = NAG_ALLOC(nnz, Integer)) ||
          !(ka = NAG_ALLOC(n+1, Integer)) ||
          !(hhess = NAG_ALLOC(nnz, Integer)) ||
          !(khess = NAG_ALLOC(n+1, Integer)) ||
          !(crnames = NAG_ALLOC(nbnd, char *)) ||
          !(names = NAG_ALLOC(nbnd*9, char))
          )
        {
          fprintf(fpout, "Allocation failure\n");
          exit_status = -1;
          goto END;
        }
    }
  else
    {
      fprintf(fpout, "Invalid n or m or nnz.\n");
      exit_status = 1;
      return exit_status;
    }

  /* Read the matrix and set up ka */
  jcol = 1;
  ka[jcol-1] = 0;
  fscanf(fpin, " %*[^\n]");
  for (i = 0; i < nnz; ++i)
    {
      /* a[i] stores the (ha[i], icol) element of matrix */
      fscanf(fpin, "%lf%ld%ld", &a[i], &ha[i], &icol);

      /* Check whether we have started a new column */
      if (icol == jcol+1)
        {
          ka[icol-1] = i;  /* Start of icol-th column in a */
          jcol = icol;
        }
      else if (icol > jcol+1)
        {
          /* Index in a of the start of the icol-th column
           * equals i, but columns jcol+1, jcol+2, ...,
           * icol-1 are empty.  Set the corresponding elements
           * of ka to i.
           */
          for (j = jcol+1; j < icol; ++j)
            ka[j-1] = i;

          ka[icol-1] = i;
          jcol = icol;
        }
    }
  ka[n] = nnz;

  /* If the last columns are empty, set ka accordingly */
  if (n > icol)
    {
      for (j = icol; j <= n - 1; ++j)
        ka[j] = nnz;
    }

  /* Read the bounds */
  nbnd = n+m;
  fscanf(fpin, " %*[^\n]"); /* Skip heading in data file */
  for (i = 0; i < nbnd; ++i)
    fscanf(fpin, "%lf", &bl[i]);
  fscanf(fpin, " %*[^\n]");
  for (i = 0; i < nbnd; ++i)
    fscanf(fpin, "%lf", &bu[i]);

  /* Read the column and row names */
  fscanf(fpin, " %*[^\n]"); /* Skip heading in data file */
  fscanf(fpin, " %*[^']");
  for (i = 0; i < nbnd; ++i)
    {
      fscanf(fpin, " '%8c'", &NAMES(i, 0));
      NAMES(i, 8) = '\0';
      crnames[i] = &NAMES(i, 0);
    }

  /* Read the initial estimate of x */
  fscanf(fpin, " %*[^\n]"); /* Skip heading in data file */
  for (i = 0; i < n; ++i)
    fscanf(fpin, "%lf", &x[i]);

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

  /* Read the hessian matrix and set up khess */
  jcol = 1;
  khess[jcol-1] = 0;
  fscanf(fpin, " %*[^\n]");
  for (i = 0; i < nnz_hess; ++i)
    {
      /* hess[i] stores the (hhess[i], icol) element of matrix */
      fscanf(fpin, "%lf%ld%ld", &hess[i], &hhess[i], &icol);

      /* Check whether we have started a new column */
      if (icol == jcol+1)
        {
          khess[icol-1] = i;  /* Start of icol-th column in hess */
          jcol = icol;
        }
      else if (icol > jcol+1)
        {
          /* Index in hess of the start of the icol-th column
           * equals i, but columns jcol+1, jcol+2, ...,
           * icol-1 are empty.  Set the corresponding elements
           * of khess to i.
           */
          for (j = jcol+1; j < icol; ++j)
            khess[j-1] = i;

          khess[icol-1] = i;
        }
    }
  khess[ncolh] = nnz_hess;

  /* Initialize options structure */
  /* nag_opt_init (e04xxc).
   * Initialization function for option setting
   */
  nag_opt_init(&options);
  strcpy(options.outfile, outfile);
  options.crnames = crnames;

  /* Package up Hessian data for communication via comm */
  hess_data.hess = hess;
  hess_data.khess = khess;
  hess_data.hhess = hhess;

  comm.p = (Pointer)&hess_data;

  /* Solve the problem */
  /* nag_opt_sparse_convex_qp (e04nkc), see above. */
  if (strcmp(outfile, "stdout"))
    fclose(fpout);
  nag_opt_sparse_convex_qp(n, m, nnz, iobj, ncolh, qphess, a, ha, ka, bl, bu,
                           x, &ninf, &sinf, &obj, &options, &comm, &fail);
  if (strcmp(outfile, "stdout"))
    {
      fpout = fopen(outfile, "a");
    }
  if (fail.code != NE_NOERROR)
    {
      fprintf(fpout, "Error from nag_opt_sparse_convex_qp (e04nkc).\n%s\n",
              fail.message);
      exit_status = 1;
      goto END;
    }

  fprintf(fpout, "\nPerturb the problem and re-solve with warm start.\n");
  for (i = 0; i < nnz_hess; ++i)
    hess[i] *= 1.001;

  options.start = Nag_Warm;
  options.print_level = Nag_Soln;
  /* nag_opt_sparse_convex_qp (e04nkc), see above. */
  if (strcmp(outfile, "stdout"))
    fclose(fpout);
  nag_opt_sparse_convex_qp(n, m, nnz, iobj, ncolh, qphess, a, ha, ka, bl, bu,
                           x, &ninf, &sinf, &obj, &options, &comm, &fail);
  if (strcmp(outfile, "stdout"))
    {
      fpout = fopen(outfile, "a");
    }
  if (fail.code != NE_NOERROR)
    {
      fprintf(fpout, "Error from nag_opt_sparse_convex_qp (e04nkc).\n%s\n",
              fail.message);
      exit_status = 1;
      goto END;
    }

  /* Free memory NAG-allocated to members of options */
  /* nag_opt_free (e04xzc).
   * Memory freeing function for use with option setting
   */
  nag_opt_free(&options, "", &fail);
  if (fail.code != NE_NOERROR)
    {
      fprintf(fpout, "Error from nag_opt_free (e04xzc).\n%s\n", fail.message);
      exit_status = 1;
      goto END;
    }

 END:
  if (fpin != stdin) fclose(fpin);
  if (fpout != stdout) fclose(fpout);
  if (a) NAG_FREE(a);
  if (bl) NAG_FREE(bl);
  if (bu) NAG_FREE(bu);
  if (x) NAG_FREE(x);
  if (hess) NAG_FREE(hess);
  if (ha) NAG_FREE(ha);
  if (ka) NAG_FREE(ka);
  if (hhess) NAG_FREE(hhess);
  if (khess) NAG_FREE(khess);
  if (crnames) NAG_FREE(crnames);
  if (names) NAG_FREE(names);
  if (optionsfile) NAG_FREE(optionsfile);
  if (outfile) NAG_FREE(outfile);

  return exit_status;
}

static void NAG_CALL qphess(Integer ncolh, double x[], double hx[],
                            Nag_Comm *comm)
{
  Integer     i, j, jrow;
  HessianData *hd = (HessianData *)(comm->p);
  double      *hess = hd->hess;
  Integer     *hhess = hd->hhess;
  Integer     *khess = hd->khess;


  for (i = 0; i < ncolh; ++i)
    hx[i] = 0.0;

  for (i = 0; i < ncolh; ++i)
    {
      /* For each column of Hessian */
      for (j = khess[i]; j < khess[i+1]; ++j)
        {
          /* For each non-zero in column */

          jrow = hhess[j] - 1;

          /* Using symmetry of hessian, add contribution
           * to hx of hess[j] as a diagonal or upper
           * triangular element of hessian.
           */
          hx[i] += hess[j]*x[jrow];

          /* If hess[j] not a diagonal element add its
           * contribution to hx as a lower triangular
           * element of hessian.
           */
          if (jrow != i)
            hx[jrow] += hess[j]*x[i];
        }
    }
}  /* qphess */