/* nag_pls_orth_scores_fit (g02lcc) Example Program.
 *
 * Copyright 2014 Numerical Algorithms Group.
 *
 * Mark 9, 2009.
 */
/* Pre-processor includes */
#include <stdio.h>
#include <math.h>
#include <string.h>
#include <nag.h>
#include <nag_stdlib.h>
#include <nagg02.h>
#include <nagx04.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_pls_orth_scores_fit (g02lcc) Example Program Results\n");
  /* Skip header in data file*/
  scanf("%*[^\n] ");
  /* Read data values*/
  scanf("%ld%ld%ld%ld%39s "
        "%39s %ld%*[^\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;
    #define B(I, J)   b[(J-1)*pdb + I-1]
  pdc = my;
    #define C(I, J)   c[(J-1)*pdc + I-1]
  pdob = ip+1;
    #define OB(I, J)  ob[(J-1)*pdob + I-1]
  pdp = ip;
    #define P(I, J)   p[(J-1)*pdp + I-1]
  pdvip = ip;
    #define VIP(I, J) vip[(J-1)*pdvip + I-1]
  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;
    #define B(I, J)   b[(I-1)*pdb + J-1]
  pdc = maxfac;
    #define C(I, J)   c[(I-1)*pdc + J-1]
  pdob = my;
    #define OB(I, J)  ob[(I-1)*pdob + J-1]
  pdp = maxfac;
    #define P(I, J)   p[(I-1)*pdp + J-1]
  pdvip = vipopt;
    #define VIP(I, J) vip[(I-1)*pdvip + J-1]
  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_pls_orth_scores_fit (g02lcc)
   * Partial least-squares
   */
  nag_pls_orth_scores_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_pls_orth_scores_fit (g02lcc).\n%s\n",
              fail.message);
      exit_status = 1;
      goto END;
    }
  /*
   * nag_gen_real_mat_print (x04cac)
   * Print real general matrix (easy-to-use)
   */
  fflush(stdout);
  nag_gen_real_mat_print(order, Nag_GeneralMatrix, Nag_NonUnitDiag, ip, my,
                         b, pdb, "B ", 0, &fail);
  if (fail.code != NE_NOERROR)
    {
      printf("Error from nag_gen_real_mat_print (x04cac).\n%s\n",
              fail.message);
      exit_status = 1;
      goto END;
    }
  if (orig == Nag_EstimatesOrig)
    {
      /*
       * nag_gen_real_mat_print (x04cac)
       * Print real general matrix (easy-to-use)
       */
      fflush(stdout);
      nag_gen_real_mat_print(order, Nag_GeneralMatrix, Nag_NonUnitDiag, ip1,
                             my, ob, pdob, "OB", 0, &fail);
      if (fail.code != NE_NOERROR)
        {
          printf("Error from nag_gen_real_mat_print (x04cac).\n%s\n",
                  fail.message);
          exit_status = 1;
          goto END;
        }
    }
  if (vipopt != 0)
    {
      /*
       * nag_gen_real_mat_print (x04cac)
       * Print real general matrix (easy-to-use)
       */
      fflush(stdout);
      nag_gen_real_mat_print(order, Nag_GeneralMatrix, Nag_NonUnitDiag, ip,
                             vipopt, vip, pdvip, "VIP", 0, &fail);
      if (fail.code != NE_NOERROR)
        {
          printf("Error from nag_gen_real_mat_print (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;
}