/* nag_mv_canon_corr (g03adc) Example Program.
 *
 * NAGPRODCODE Version.
 *
 * Copyright 2016 Numerical Algorithms Group.
 *
 * Mark 26, 2016.
 *
 */

#include <nag.h>
#include <stdio.h>
#include <nag_stdlib.h>
#include <nagg03.h>

#define Z(I, J)   z[(I) *tdz + J]
#define CVX(I, J) cvx[(I) *tdcvx + J]
#define CVY(I, J) cvy[(I) *tdcvy + J]
#define E(I, J)   e[(I) *tde + J]
int main(void)
{
  Integer exit_status = 0, i, *isz = 0, j, m, n, ncv, nx, ny, tdcvx, tdcvy,
         tde = 6;
  Integer tdz;
  NagError fail;
  char weight[2];
  double *cvx = 0, *cvy = 0, *e = 0, tol, *wt = 0, *wtptr, *z = 0;

  INIT_FAIL(fail);

  printf("nag_mv_canon_corr (g03adc) Example Program Results\n\n");

  /* Skip heading in data file */
  scanf("%*[^\n]");
  scanf("%" NAG_IFMT "", &n);
  scanf("%" NAG_IFMT "", &m);
  scanf("%" NAG_IFMT "", &nx);
  scanf("%" NAG_IFMT "", &ny);
  scanf("%1s", weight);

  if (nx >= 1 && ny >= 1 && n > nx + ny && m >= nx + ny) {
    if (!(z = NAG_ALLOC(n * m, double)) ||
        !(wt = NAG_ALLOC(n, double)) ||
        !(isz = NAG_ALLOC(m, Integer)) ||
        !(cvx = NAG_ALLOC(nx * (MIN(nx, ny)), double)) ||
        !(cvy = NAG_ALLOC(ny * (MIN(nx, ny)), double)) ||
        !(e = NAG_ALLOC((MIN(nx, ny)) * 6, double))

           )
    {
      printf("Allocation failure\n");
      exit_status = -1;
      goto END;
    }
    tdz = m;
    tdcvx = MIN(nx, ny);
    tdcvy = MIN(nx, ny);
    tde = 6;
  }
  else {
    printf("Invalid nx or ny or n or m.\n");
    exit_status = 1;
    return exit_status;
  }
  if (*weight == 'W') {
    for (i = 0; i < n; ++i) {
      for (j = 0; j < m; ++j)
        scanf("%lf", &Z(i, j));
      scanf("%lf", &wt[i]);
    }
    wtptr = wt;
  }
  else {
    for (i = 0; i < n; ++i) {
      for (j = 0; j < m; ++j)
        scanf("%lf", &Z(i, j));
    }
    wtptr = 0;
  }
  for (j = 0; j < m; ++j)
    scanf("%" NAG_IFMT "", &isz[j]);
  tol = 1e-6;

  /* nag_mv_canon_corr (g03adc).
   * Canonical correlation analysis
   */
  nag_mv_canon_corr(n, m, z, tdz, isz, nx, ny, wtptr, e, tde,
                    &ncv, cvx, tdcvx, cvy, tdcvy, tol, &fail);
  if (fail.code != NE_NOERROR) {
    printf("Error from nag_mv_canon_corr (g03adc).\n%s\n", fail.message);
    exit_status = 1;
    goto END;
  }

  printf("\n%s%2" NAG_IFMT "%s%2" NAG_IFMT "\n\n", "Rank of x = ", nx,
         " Rank of y = ", ny);
  printf("    Canonical    Eigenvalues Percentage      Chisq "
         "          DF          Sig\n");
  printf("    correlations              variation\n");

  for (i = 0; i < ncv; ++i) {
    for (j = 0; j < 6; ++j)
      printf("%12.4f", E(i, j));
    printf("\n");
  }
  printf("\nCanonical coefficients for x\n");
  for (i = 0; i < nx; ++i) {
    for (j = 0; j < ncv; ++j)
      printf("%9.4f", CVX(i, j));
    printf("\n");
  }
  printf("\nCanonical coefficients for y\n");
  for (i = 0; i < ny; ++i) {
    for (j = 0; j < ncv; ++j)
      printf("%9.4f", CVY(i, j));
    printf("\n");
  }
END:
  NAG_FREE(z);
  NAG_FREE(wt);
  NAG_FREE(isz);
  NAG_FREE(cvx);
  NAG_FREE(cvy);
  NAG_FREE(e);
  return exit_status;
}