/* nag_mv_fac_score (g03ccc) Example Program. * * Copyright 1998 Numerical Algorithms Group. * * Mark 5, 1998. * Mark 8 revised, 2004. * */ #include #include #include #include #include #include #define FL(I,J) fl[(I)*tdfl + J] #define FS(I,J) fs[(I)*tdfs + J] #define R(I,J) r[(I)*tdr + 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; char char_matrix[2], char_method[2], char_weight[2]; double *com=0, *e=0, eps, *fl=0, *fs=0, *psi=0, *r=0, *stat=0, *wt=0; double *wtptr=0, *x=0; INIT_FAIL(fail); Vprintf("nag_mv_fac_score (g03ccc) Example Program Results\n\n"); /* Skip headings in data file */ Vscanf("%*[^\n]"); Vscanf("%s",char_matrix); Vscanf("%s",char_weight); Vscanf("%ld",&n); Vscanf("%ld",&m); Vscanf("%ld",&nvar); Vscanf("%ld",&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((*char_matrix == 'C'?m:n)*m, double)) || !( isx = NAG_ALLOC(m, Integer)) ) { Vprintf("Allocation failure\n"); exit_status = -1; goto END; } tdfl = nfac; tdfs = nfac; tdr = m; tdx = m; } else { Vprintf("Invalid nvar or m or n.\n"); exit_status = 1; return exit_status; } if (*char_matrix == 'C') { for (i = 0; i < m; ++i) { for (j = 0; j < m; ++j) Vscanf("%lf",&X(i,j)); } } else { if (*char_weight == 'W') { for (i = 0; i < n; ++i) { for (j = 0; j < m; ++j) Vscanf("%lf",&X(i,j)); Vscanf("%lf",&wt[i]); } wtptr=wt; } else { for (i = 0; i < n; ++i) { for (j = 0; j < m; ++j) Vscanf("%lf",&X(i,j)); } } } for (j = 0; j < m; ++j) Vscanf("%ld",&isx[j]); if (*char_matrix == 'D') { matrix = Nag_DataCorr; } else if (*char_matrix == 'S') { matrix = Nag_DataCovar; } else if (*char_matrix == 'C') { matrix = Nag_MatCorr_Covar; } /* 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 */ 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) { Vprintf("Error from nag_mv_factor (g03cac).\n%s\n", fail.message); exit_status = 1; goto END; } Vprintf("\nLoadings, Communalities and PSI\n\n"); for (i = 0; i < nvar; ++i) { for (j = 0; j < nfac; ++j) Vprintf(" %8.3f",FL(i,j)); Vprintf("%8.3f%8.3f\n",com[i], psi[i]); } Vscanf("%s",char_method); if (*char_method == 'R') { method = Nag_FacScoreRegsn; } else if (*char_method == 'B') { method = Nag_FacScoreBart; } /* nag_mv_fac_score (g03ccc). * Factor score coefficients, following nag_mv_factor * (g03cac) */ nag_mv_fac_score(method, Nag_FacNoRotate, nvar, nfac, fl, tdfl, psi, e, r, tdr, fs, tdfs, &fail); if (fail.code != NE_NOERROR) { Vprintf("Error from nag_mv_fac_score (g03ccc).\n%s\n", fail.message); exit_status = 1; goto END; } Vprintf("\nFactor score coefficients\n\n"); for (i = 0; i < nvar; ++i) { for (j = 0; j < nfac; ++j) Vprintf(" %8.3f",FS(i,j)); Vprintf("\n"); } END: if (com) NAG_FREE(com); if (e) NAG_FREE(e); if (fl) NAG_FREE(fl); if (fs) NAG_FREE(fs); if (psi) NAG_FREE(psi); if (r) NAG_FREE(r); if (stat) NAG_FREE(stat); if (wt) NAG_FREE(wt); if (x) NAG_FREE(x); if (isx) NAG_FREE(isx); return exit_status; }