NAG Library Manual, Mark 30
Interfaces:  FL   CL   CPP   AD 

NAG CL Interface Introduction
Example description
/* nag_correg_corrmat_partial (g02byc) Example Program.
 *
 * Copyright 2024 Numerical Algorithms Group.
 *
 * Mark 30.0, 2024.
 */

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

#define X(I, J) x[((I)-1) * m + ((J)-1)]
#define R(I, J) r[((I)-1) * m + ((J)-1)]
int main(void) {

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

  INIT_FAIL(fail);

  printf("nag_correg_corrmat_partial (g02byc) Example Program Results\n");

  /* Skip heading in data file */
  scanf("%*[^\n]");
  scanf("%" NAG_IFMT " %" NAG_IFMT "", &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))) {
    printf("Allocation failure\n");
    exit_status = -1;
    goto END;
  }
  for (j = 1; j <= n; ++j)
    for (k = 1; k <= m; ++k)
      scanf("%lf", &X(j, k));

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

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