/* nag_partial_corr (g02byc) Example Program.
 *
 * Copyright 2000 Numerical Algorithms Group.
 *
 * Mark 6, 2000.
 */

#include <stdio.h>
#include <nag.h>
#include <nagx04.h>
#include <nag_stdlib.h>
#include <nagg02.h>

#define X(I, J) x[((I) -1)*m + ((J) -1)]
#define R(I, J) r[((I) -1)*m + ((J) -1)]
int main(int argc, char *argv[])
{
  FILE     *fpin, *fpout;

  Integer  exit_status = 0, j, k, m, n, nx, ny, *sz = 0;
  NagError fail;
  double   *r = 0, *std = 0, sw, *v, *x = 0, *xbar = 0;

  INIT_FAIL(fail);

  /* Check for command-line IO options */
  fpin = nag_example_file_io(argc, argv, "-data", NULL);
  fpout = nag_example_file_io(argc, argv, "-results", NULL);
  fprintf(fpout, "nag_partial_corr (g02byc) Example Program Results\n");

  /* Skip heading in data file */
  fscanf(fpin, "%*[^\n]");

  fscanf(fpin, "%ld %ld", &n, &m);
  if (!(r = NAG_ALLOC(m*m, double))
     || !(std = NAG_ALLOC(m, double))
     || !(v = NAG_ALLOC(m*m, double))
     || !(x = NAG_ALLOC(n*m, double))
     || !(xbar = NAG_ALLOC(m, double))
     || !(sz = NAG_ALLOC(m, Integer)))
    {
      fprintf(fpout, "Allocation failure\n");
      exit_status = -1;
      goto END;
    }
  for (j = 1; j <= n; ++j)
    for (k = 1; k <= m; ++k)
      fscanf(fpin, "%lf", &X(j, k));

  /* Calculate correlation matrix */
  /* nag_corr_cov (g02bxc).
   * Product-moment correlation, unweighted/weighted
   * correlation and covariance matrix, allows variables to be
   * disregarded
   */
  nag_corr_cov(n, m, x, m, 0, 0, &sw, xbar, std, r, m, v, m,
               &fail);
  if (fail.code == NE_NOERROR)
    {
      /* Print the correlation matrix */
      fprintf(fpout, "\nCorrelation Matrix\n\n");
      for (j = 1; j <= m; j++)
        {
          for (k = 1; k <= m; k++)
            if (j > k)
              fprintf(fpout, "%11s", "");
            else
              fprintf(fpout, "%7.4f%4s", R(j, k), "");
          fprintf(fpout, "\n");
        }

      fscanf(fpin, "%ld %ld", &ny, &nx);
      for (j = 1; j <= m; ++j)
        fscanf(fpin, "%ld", &sz[j - 1]);

      /* Calculate partial correlation matrix */
      /* nag_partial_corr (g02byc).
       * Computes partial correlation/variance-covariance matrix
       * from correlation/variance-covariance matrix computed by
       * nag_corr_cov (g02bxc)
       */
      nag_partial_corr(m, ny, nx, sz, v, m, r, m, &fail);
      if (fail.code != NE_NOERROR)
        {
          fprintf(fpout, "Error from nag_partial_corr (g02byc).\n%s\n",
                  fail.message);
          exit_status = 1;
          goto END;
        }
      /* Print partial correlation matrix */
      fprintf(fpout, "\n");
      fprintf(fpout, "\nPartial Correlation Matrix\n\n");
      for (j = 1; j <= ny; j++)
        {
          for (k = 1; k <= ny; k++)
            {
              if (j > k)
                fprintf(fpout, "%11s", "");
              else if (j == k)
                fprintf(fpout, "%7.4f%4s", 1.0, "");
              else
                fprintf(fpout, "%7.4f%4s", R(j, k), "");
            }
          fprintf(fpout, "\n");
        }
    }
  else
    {
      fprintf(fpout, "Error from nag_corr_cov (g02bxc).\n%s\n", fail.message);
      exit_status = 1;
      goto END;
    }
 END:
  if (fpin != stdin) fclose(fpin);
  if (fpout != stdout) fclose(fpout);
  if (r) NAG_FREE(r);
  if (std) NAG_FREE(std);
  if (v) NAG_FREE(v);
  if (x) NAG_FREE(x);
  if (xbar) NAG_FREE(xbar);
  if (sz) NAG_FREE(sz);
  return exit_status;
}