/* nag_mv_prin_comp (g03aac) Example Program. * * Copyright 1998 Numerical Algorithms Group. * * Mark 5, 1998. * Mark 8 revised, 2004. * */ #include #include #include #include #define X(I,J) x[(I)*tdx + J] #define P(I,J) p[(I)*tdp + J] #define E(I,J) e[(I)*tde + J] #define V(I,J) v[(I)*tdv + J] int main(void) { Integer exit_status=0, i, *isx=0, j, m, n, nvar, tde=6, tdp, tdv, tdx; NagError fail; Nag_PrinCompMat pcmatrix; Nag_PrinCompScores scores; char matrix[2], std[2], weight[2]; double *e=0, *p=0, *s=0, *v=0, *wt=0, *wtptr=0, *x=0; INIT_FAIL(fail); Vprintf("nag_mv_prin_comp (g03aac) Example Program Results\n\n"); /* Skip heading in data file */ Vscanf("%*[^\n]"); Vscanf("%s",matrix); Vscanf("%s",std); Vscanf("%s",weight); Vscanf("%ld",&n); Vscanf("%ld",&m); if (*matrix == 'C') pcmatrix = Nag_MatCorrelation; else if (*matrix == 'S') pcmatrix = Nag_MatStandardised; else if (*matrix == 'U') pcmatrix = Nag_MatSumSq; else pcmatrix = Nag_MatVarCovar; if (*std == 'S') scores = Nag_ScoresStand; else if (*std == 'U') scores = Nag_ScoresNotStand; else if (*std == 'Z') scores = Nag_ScoresUnitVar; else scores = Nag_ScoresEigenval; if (n>=2 && m>=1) { if ( !( x = NAG_ALLOC((n)*(m), double)) || !( wt = NAG_ALLOC(n, double)) || !( s = NAG_ALLOC(m, double)) || !( isx = NAG_ALLOC(m, Integer)) ) { Vprintf("Allocation failure\n"); exit_status = -1; goto END; } tdx = m; } else { Vprintf("Invalid n or m.\n"); exit_status = 1; return exit_status; } if (*weight == 'U') { for (i = 0; i < n; ++i) { for (j = 0; j < m; ++j) Vscanf("%lf",&X(i,j)); } } else { for (i = 0; i < n; ++i) { for (j = 0; j < m; ++j) Vscanf("%lf",&X(i,j)); Vscanf("%lf",&wt[i]); } wtptr = wt; } for (j = 0; j < m; ++j) { Vscanf("%ld",&isx[j]); } Vscanf("%ld",&nvar); if (nvar >=1 && nvar <= MIN(n-1,m)) { if ( !( p = NAG_ALLOC(nvar*nvar, double)) || !( e = NAG_ALLOC(nvar*6, double)) || !( v = NAG_ALLOC(n*nvar, double)) ) { Vprintf("Allocation failure\n"); exit_status = -1; goto END; } tdp = nvar; tde = 6; tdv = nvar; } else { Vprintf("Invalid nvar.\n"); exit_status = 1; goto END; } if (pcmatrix == Nag_MatStandardised) { for (j = 0; j < m; ++j) Vscanf("%lf",&s[j]); } /* nag_mv_prin_comp (g03aac). * Principal component analysis */ nag_mv_prin_comp(pcmatrix, scores, n, m, x, tdx, isx, s, wtptr, nvar, e, tde, p, tdp, v, tdv, &fail); if (fail.code != NE_NOERROR) { Vprintf("Error from nag_mv_prin_comp (g03aac).\n%s\n", fail.message); exit_status = 1; goto END; } Vprintf("Eigenvalues Percentage Cumulative Chisq DF Sig\n"); Vprintf(" variation variation\n\n"); for (i = 0; i < nvar; ++i) { for (j = 0; j < 6; ++j) Vprintf("%11.4f",E(i,j)); Vprintf("\n"); } Vprintf("\nEigenvalues \n\n"); for (i = 0; i < nvar; ++i) { for (j = 0; j < nvar; ++j) Vprintf("%9.4f",P(i,j)); Vprintf("\n"); } Vprintf("\nPrincipal component scores \n\n"); for (i = 0; i < n; ++i) { Vprintf("%2ld", i+1); for (j = 0; j < nvar; ++j) Vprintf("%9.3f", V(i,j)); Vprintf("\n"); } END: if (x) NAG_FREE(x); if (wt) NAG_FREE(wt); if (s) NAG_FREE(s); if (isx) NAG_FREE(isx); if (p) NAG_FREE(p); if (e) NAG_FREE(e); if (v) NAG_FREE(v); return exit_status; }