/* nag_mv_factor_score (g03ccc) Example Program.
 *
 * Copyright 2024 Numerical Algorithms Group.
 *
 * Mark 30.1, 2024.
 *
 */

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

#define FL(I, J) fl[(I)*tdfl + J]
#define FS(I, J) fs[(I)*tdfs + J]
#define X(I, J) x[(I)*tdx + J]
int main(void) {

  Integer exit_status = 0, i, *isx = 0, j, m, n, nfac, nvar, tdfl, tdfs, tdr;
  Integer tdx;
  NagError fail;
  Nag_E04_Opt options;
  Nag_FacMat matrix;
  Nag_FacScoreMethod method;
  Nag_Boolean weight;
  char nag_enum_arg[40];
  double *com = 0, *e = 0, eps, *fl = 0, *fs = 0, *psi = 0, *r = 0;
  double *stat = 0, *wt = 0, *wtptr = 0, *x = 0;

  INIT_FAIL(fail);

  printf("nag_mv_factor_score (g03ccc) 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 && nvar >= nfac) {
    if (!(com = NAG_ALLOC(nvar, double)) || !(e = NAG_ALLOC(nvar, double)) ||
        !(fl = NAG_ALLOC(nvar * nfac, double)) ||
        !(fs = NAG_ALLOC(nvar * nfac, double)) ||
        !(psi = NAG_ALLOC(nvar, double)) || !(r = NAG_ALLOC(m * m, 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;
    tdfs = nfac;
    tdr = m;
    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-3;
  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,
                r, 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("\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]);
  }
  scanf("%39s", nag_enum_arg);
  method = (Nag_FacScoreMethod)nag_enum_name_to_value(nag_enum_arg);

  /* nag_mv_factor_score (g03ccc).
   * Factor score coefficients, following nag_mv_factor
   * (g03cac)
   */
  nag_mv_factor_score(method, Nag_FacNoRotate, nvar, nfac, fl, tdfl, psi, e, r,
                      tdr, fs, tdfs, &fail);
  if (fail.code != NE_NOERROR) {
    printf("Error from nag_mv_factor_score (g03ccc).\n%s\n", fail.message);
    exit_status = 1;
    goto END;
  }
  printf("\nFactor score coefficients\n\n");
  for (i = 0; i < nvar; ++i) {
    for (j = 0; j < nfac; ++j)
      printf("  %8.3f", FS(i, j));
    printf("\n");
  }

END:
  NAG_FREE(com);
  NAG_FREE(e);
  NAG_FREE(fl);
  NAG_FREE(fs);
  NAG_FREE(psi);
  NAG_FREE(r);
  NAG_FREE(stat);
  NAG_FREE(wt);
  NAG_FREE(x);
  NAG_FREE(isx);
  return exit_status;
}