/* nag_mv_factor (g03cac) Example Program.
 *
 * Copyright 2023 Numerical Algorithms Group.
 *
 * Mark 29.2, 2023.
 *
 */

#include <nag.h>
#include <stdio.h>
#include <string.h>

#define FL(I, J) fl[(I)*tdfl + J]
#define X(I, J) x[(I)*tdx + J]
int main(void) {
  Integer exit_status = 0, i, *isx = 0, j, l, m, n, nfac, nvar, tdfl, tdx;
  double *com = 0, *e = 0, eps, *fl = 0, *psi = 0, *res = 0, *stat = 0;
  double *wt = 0, *wtptr = 0, *x = 0;
  char nag_enum_arg[40];
  Nag_Boolean weight;
  Nag_E04_Opt options;
  Nag_FacMat matrix;
  NagError fail;

  INIT_FAIL(fail);

  printf("nag_mv_factor (g03cac) Example Program Results\n\n");

  /* Skip headings in data file */
  scanf("%*[^\n]");
  scanf("%39s", nag_enum_arg);
  /* nag_enum_name_to_value (x04nac).
   * Converts NAG enum member name to value
   */
  matrix = (Nag_FacMat)nag_enum_name_to_value(nag_enum_arg);
  scanf("%39s", nag_enum_arg);
  weight = (Nag_Boolean)nag_enum_name_to_value(nag_enum_arg);
  scanf("%" NAG_IFMT "", &n);
  scanf("%" NAG_IFMT "", &m);
  scanf("%" NAG_IFMT "", &nvar);
  scanf("%" NAG_IFMT "", &nfac);

  if (nvar >= 2 && m >= nvar && n > nvar) {
    if (!(com = NAG_ALLOC(nvar, double)) || !(e = NAG_ALLOC(nvar, double)) ||
        !(fl = NAG_ALLOC(nvar * nfac, double)) ||
        !(psi = NAG_ALLOC(nvar, double)) ||
        !(res = NAG_ALLOC(nvar * (nvar - 1) / 2, double)) ||
        !(stat = NAG_ALLOC(4, double)) || !(wt = NAG_ALLOC(n, double)) ||
        !(x = NAG_ALLOC((matrix == Nag_MatCorr_Covar ? m : n) * m, double)) ||
        !(isx = NAG_ALLOC(m, Integer))) {
      printf("Allocation failure\n");
      exit_status = -1;
      goto END;
    }
    tdfl = nfac;
    tdx = m;
  } else {
    printf("Invalid nvar or m or n.\n");
    exit_status = 1;
    return exit_status;
  }
  if (matrix == Nag_MatCorr_Covar) {
    for (i = 0; i < m; ++i) {
      for (j = 0; j < m; ++j)
        scanf("%lf", &X(i, j));
    }
  } else {
    if (weight) {
      for (i = 0; i < n; ++i) {
        for (j = 0; j < m; ++j)
          scanf("%lf", &X(i, j));
        scanf("%lf", &wt[i]);
      }
      wtptr = wt;
    } else {
      for (i = 0; i < n; ++i) {
        for (j = 0; j < m; ++j)
          scanf("%lf", &X(i, j));
      }
    }
  }
  for (j = 0; j < m; ++j)
    scanf("%" NAG_IFMT "", &isx[j]);

  /* nag_opt_init (e04xxc).
   * Initialization function for option setting
   */
  nag_opt_init(&options);
  options.max_iter = 500;
  options.optim_tol = 1e-2;
  eps = 1e-5;
  /* nag_mv_factor (g03cac).
   * Maximum likelihood estimates of parameters
   */
  fflush(stdout);
  nag_mv_factor(matrix, n, m, x, tdx, nvar, isx, nfac, wtptr, e, stat, com, psi,
                res, fl, tdfl, &options, eps, &fail);
  if (fail.code != NE_NOERROR) {
    printf("Error from nag_mv_factor (g03cac).\n%s\n", fail.message);
    exit_status = 1;
    goto END;
  }
  printf("\nEigenvalues\n\n");
  for (j = 0; j < nvar; ++j) {
    printf(" %13.4e%s", e[j], (j + 1) % 5 == 0 ? "\n" : "");
  }
  printf("\n\n%s%6.3f\n", "    Test Statistic = ", stat[1]);
  printf("%s%6.3f\n", "                df = ", stat[2]);
  printf("%s%6.3f\n\n", "Significance level = ", stat[3]);
  printf("Residuals\n\n");
  l = 1;
  for (i = 1; i <= nvar - 1; ++i) {
    for (j = l; j <= l + i - 1; ++j)
      printf(" %8.3f", res[j - 1]);
    printf("\n");
    l += i;
  }
  printf("\nLoadings, Communalities and PSI\n\n");
  for (i = 0; i < nvar; ++i) {
    for (j = 0; j < nfac; ++j)
      printf(" %8.3f", FL(i, j));
    printf("%8.3f%8.3f\n", com[i], psi[i]);
  }

END:
  NAG_FREE(com);
  NAG_FREE(e);
  NAG_FREE(fl);
  NAG_FREE(psi);
  NAG_FREE(res);
  NAG_FREE(stat);
  NAG_FREE(wt);
  NAG_FREE(x);
  NAG_FREE(isx);

  return exit_status;
}