/* nag_mv_factor (g03cac) Example Program. * * Copyright 1998 Numerical Algorithms Group. * * Mark 5, 1998. * Mark 8 revised, 2004. * */ #include #include #include #include #include #define FL(I,J) fl[(I)*tdfl + J] #define X(I,J) x[(I)*tdx + J] int main(void) { Integer exit_status=0, i, *isx=0, j, l, m, n, nfac, nvar, tdfl, tdx; NagError fail; Nag_E04_Opt options; Nag_FacMat matrix; char char_matrix[2], weight[2]; double *com=0, *e=0, eps, *fl=0, *psi=0, *res=0, *stat=0, *wt=0, *wtptr=0; double *x=0; INIT_FAIL(fail); Vprintf("nag_mv_factor (g03cac) Example Program Results\n\n"); /* Skip headings in data file */ Vscanf("%*[^\n]"); Vscanf("%s",char_matrix); Vscanf("%s",weight); Vscanf("%ld",&n); Vscanf("%ld",&m); Vscanf("%ld",&nvar); Vscanf("%ld",&nfac); if (nvar>=2 && m>=nvar && n>nvar) { if ( !( com = NAG_ALLOC(nvar, double)) || !( e = NAG_ALLOC(nvar, double)) || !( fl = NAG_ALLOC(nvar*nfac, double)) || !( psi = NAG_ALLOC(nvar, double)) || !( res = NAG_ALLOC(nvar*(nvar-1)/2, 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; 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 (*weight == 'W' || *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-2; 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, res, 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("\nEigenvalues\n\n"); for (j = 0; j < m; ++j) { Vprintf(" %12.4e%s",e[j], (j+1)%6==0 ? "\n" : ""); } Vprintf("\n\n%s%6.3f\n"," Test Statistic = ",stat[1]); Vprintf("%s%6.3f\n"," df = ",stat[2]); Vprintf("%s%6.3f\n\n","Significance level = ",stat[3]); Vprintf("Residuals\n\n"); l = 1; for (i = 1; i <= nvar-1; ++i) { for (j = l; j <= l+i-1; ++j) Vprintf(" %8.3f",res[j-1]); Vprintf("\n"); l += i; } 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]); } END: if (com) NAG_FREE(com); if (e) NAG_FREE(e); if (fl) NAG_FREE(fl); if (psi) NAG_FREE(psi); if (res) NAG_FREE(res); if (stat) NAG_FREE(stat); if (wt) NAG_FREE(wt); if (x) NAG_FREE(x); if (isx) NAG_FREE(isx); return exit_status; }