/* nag_correg_pls_fit (g02lcc) Example Program.
 *
 * Copyright 2019 Numerical Algorithms Group.
 *
 * Mark 27.0, 2019.
 */
/* Pre-processor includes */
#include <stdio.h>
#include <math.h>
#include <string.h>
#include <nag.h>

int main(void)
{
  /*Integer scalar and array declarations */
  Integer exit_status = 0;
  Integer i, ip, ip1, j, maxfac, my, nfact, vipopt;
  Integer pdb, pdc, pdob, pdp, pdvip, pdw, pdycv;
  /*Double scalar and array declarations */
  double rcond;
  double *b = 0, *c = 0, *ob = 0, *p = 0, *vip = 0, *w = 0;
  double *xbar = 0, *xstd = 0, *ybar = 0, *ycv = 0, *ystd = 0;
  /*Character scalar and array declarations */
  char siscale[40], sorig[40];
  /*NAG Types */
  Nag_OrderType order;
  Nag_ScalePredictor iscale;
  Nag_EstimatesOption orig;
  NagError fail;

  INIT_FAIL(fail);

  printf("nag_correg_pls_fit (g02lcc) Example Program Results\n");
  /* Skip header in data file */
  scanf("%*[^\n] ");
  /* Read data values */
  scanf("%" NAG_IFMT "%" NAG_IFMT "%" NAG_IFMT "%" NAG_IFMT "%39s "
        "%39s %" NAG_IFMT "%*[^\n] ", &ip, &my, &maxfac, &nfact, sorig,
        siscale, &vipopt);
  orig = (Nag_EstimatesOption) nag_enum_name_to_value(sorig);
  iscale = (Nag_ScalePredictor) nag_enum_name_to_value(siscale);

#ifdef NAG_COLUMN_MAJOR
  pdb = ip;
  pdc = my;
#define C(I, J)   c[(J-1)*pdc + I-1]
  pdob = ip + 1;
  pdp = ip;
#define P(I, J)   p[(J-1)*pdp + I-1]
  pdvip = ip;
  pdw = ip;
#define W(I, J)   w[(J-1)*pdw + I-1]
  pdycv = maxfac;
#define YCV(I, J) ycv[(J-1)*pdycv + I-1]
  order = Nag_ColMajor;
#else
  pdb = my;
  pdc = maxfac;
#define C(I, J)   c[(I-1)*pdc + J-1]
  pdob = my;
  pdp = maxfac;
#define P(I, J)   p[(I-1)*pdp + J-1]
  pdvip = vipopt;
  pdw = maxfac;
#define W(I, J)   w[(I-1)*pdw + J-1]
  pdycv = my;
#define YCV(I, J) ycv[(I-1)*pdycv + J-1]
  order = Nag_RowMajor;
#endif
  if (!(b = NAG_ALLOC(pdb * (order == Nag_RowMajor ? ip : my), double)) ||
      !(c = NAG_ALLOC(pdc * (order == Nag_RowMajor ? my : maxfac), double)) ||
      !(ob = NAG_ALLOC(pdob * (order == Nag_RowMajor ? (ip + 1) : my),
                       double)) ||
      !(p = NAG_ALLOC(pdp * (order == Nag_RowMajor ? ip : maxfac), double)) ||
      !(vip = NAG_ALLOC(pdvip * (order == Nag_RowMajor ? ip : vipopt),
                        double)) ||
      !(w = NAG_ALLOC(pdw * (order == Nag_RowMajor ? ip : maxfac), double)) ||
      !(xbar = NAG_ALLOC(ip, double)) ||
      !(xstd = NAG_ALLOC(ip, double)) ||
      !(ybar = NAG_ALLOC(my, double)) ||
      !(ycv = NAG_ALLOC(pdycv * (order == Nag_RowMajor ? maxfac : my),
                        double)) || !(ystd = NAG_ALLOC(my, double)))
  {
    printf("Allocation failure\n");
    exit_status = -1;
    goto END;
  }
  /* Read P */
  for (i = 1; i <= ip; i++) {
    for (j = 1; j <= maxfac; j++)
      scanf("%lf ", &P(i, j));
  }
  scanf("%*[^\n] ");
  /* Read C */
  for (i = 1; i <= my; i++) {
    for (j = 1; j <= maxfac; j++)
      scanf("%lf ", &C(i, j));
  }
  scanf("%*[^\n] ");
  /* Read W */
  for (i = 1; i <= ip; i++) {
    for (j = 1; j <= maxfac; j++)
      scanf("%lf ", &W(i, j));
  }
  scanf("%*[^\n] ");
  /* Read YCV */
  for (i = 1; i <= maxfac; i++) {
    for (j = 1; j <= my; j++)
      scanf("%lf ", &YCV(i, j));
  }
  scanf("%*[^\n] ");
  /* Read means */
  if (orig == Nag_EstimatesOrig) {
    for (j = 0; j < ip; j++)
      scanf("%lf ", &xbar[j]);
    scanf("%*[^\n] ");
    for (j = 0; j < my; j++)
      scanf("%lf ", &ybar[j]);
    scanf("%*[^\n] ");
    if (iscale != Nag_PredNoScale) {
      for (j = 0; j < ip; j++)
        scanf("%lf ", &xstd[j]);
      scanf("%*[^\n] ");
      for (j = 0; j < my; j++)
        scanf("%lf ", &ystd[j]);
      scanf("%*[^\n] ");
    }
  }
  /* Calculate predictions */
  rcond = -1.00e0;
  ip1 = ip + 1;
  /*
   * nag_correg_pls_fit (g02lcc)
   * Partial least squares
   */
  nag_correg_pls_fit(order, ip, my, maxfac, nfact, p, pdp, c, pdc, w,
                          pdw, rcond, b, pdb, orig, xbar, ybar, iscale, xstd,
                          ystd, ob, pdob, vipopt, ycv, pdycv, vip,
                          pdvip, &fail);
  if (fail.code != NE_NOERROR) {
    printf("Error from nag_correg_pls_fit (g02lcc).\n%s\n",
           fail.message);
    exit_status = 1;
    goto END;
  }
  /*
   * nag_file_print_matrix_real_gen (x04cac)
   * Print real general matrix (easy-to-use)
   */
  fflush(stdout);
  nag_file_print_matrix_real_gen(order, Nag_GeneralMatrix, Nag_NonUnitDiag, ip, my,
                         b, pdb, "B ", 0, &fail);
  if (fail.code != NE_NOERROR) {
    printf("Error from nag_file_print_matrix_real_gen (x04cac).\n%s\n", fail.message);
    exit_status = 1;
    goto END;
  }
  if (orig == Nag_EstimatesOrig) {
    /*
     * nag_file_print_matrix_real_gen (x04cac)
     * Print real general matrix (easy-to-use)
     */
    fflush(stdout);
    nag_file_print_matrix_real_gen(order, Nag_GeneralMatrix, Nag_NonUnitDiag, ip1,
                           my, ob, pdob, "OB", 0, &fail);
    if (fail.code != NE_NOERROR) {
      printf("Error from nag_file_print_matrix_real_gen (x04cac).\n%s\n",
             fail.message);
      exit_status = 1;
      goto END;
    }
  }
  if (vipopt != 0) {
    /*
     * nag_file_print_matrix_real_gen (x04cac)
     * Print real general matrix (easy-to-use)
     */
    fflush(stdout);
    nag_file_print_matrix_real_gen(order, Nag_GeneralMatrix, Nag_NonUnitDiag, ip,
                           vipopt, vip, pdvip, "VIP", 0, &fail);
    if (fail.code != NE_NOERROR) {
      printf("Error from nag_file_print_matrix_real_gen (x04cac).\n%s\n",
             fail.message);
      exit_status = 1;
      goto END;
    }
  }

END:
  NAG_FREE(b);
  NAG_FREE(c);
  NAG_FREE(ob);
  NAG_FREE(p);
  NAG_FREE(vip);
  NAG_FREE(w);
  NAG_FREE(xbar);
  NAG_FREE(xstd);
  NAG_FREE(ybar);
  NAG_FREE(ycv);
  NAG_FREE(ystd);

  return exit_status;
}