/* nag_mv_discrim_group (g03dcc) Example Program. * * Copyright 1998 Numerical Algorithms Group. * * Mark 5, 1998. * Mark 8 revised, 2004. * */ #include #include #include #include #define ATI(I, J) ati[(I) *tdati + J] #define GMEAN(I, J) gmean[(I) *tdgmean + J] #define P(I, J) p[(I) *tdp + J] #define X(I, J) x[(I) *tdx + J] int main(void) { Integer exit_status = 0, i, *iag = 0, *ing = 0, *isx = 0, j, m, n, ng, *nig = 0, nobs; Integer nvar, tdati, tdgmean, tdp, tdx; double *ati = 0, *det = 0, df, *gc = 0, *gmean = 0, *p = 0; double *prior = 0, sig, stat, *wt = 0, *wtptr = 0, *x = 0; char nag_enum_arg[40]; Nag_Boolean atiq = Nag_TRUE, weight; Nag_DiscrimMethod type; Nag_GroupCovars equal; NagError fail; INIT_FAIL(fail); printf("nag_mv_discrim_group (g03dcc) Example Program Results\n\n"); /* Skip headings in data file */ scanf("%*[^\n]"); scanf("%ld", &n); scanf("%ld", &m); scanf("%ld", &nvar); scanf("%ld", &ng); scanf("%39s", nag_enum_arg); /* nag_enum_name_to_value (x04nac). * Converts NAG enum member name to value */ weight = (Nag_Boolean) nag_enum_name_to_value(nag_enum_arg); if (n >= 1 && nvar >= 1 && m >= nvar && ng >= 2) { if (!(det = NAG_ALLOC(ng, double)) || !(gc = NAG_ALLOC((ng+1)*nvar*(nvar+1)/2, double)) || !(gmean = NAG_ALLOC((ng)*(nvar), double)) || !(prior = NAG_ALLOC(ng, double)) || !(wt = NAG_ALLOC(n, double)) || !(x = NAG_ALLOC((n)*(m), double)) || !(ing = NAG_ALLOC(n, Integer)) || !(isx = NAG_ALLOC(m, Integer)) || !(nig = NAG_ALLOC(ng, Integer))) { printf("Allocation failure\n"); exit_status = -1; goto END; } tdati = ng; tdgmean = nvar; tdp = ng; tdx = m; } else { printf("Invalid n or nvar or ng.\n"); exit_status = 1; return exit_status; } if (weight) { for (i = 0; i < n; ++i) { for (j = 0; j < m; ++j) scanf("%lf", &X(i, j)); scanf("%ld", &ing[i]); scanf("%lf", &wt[i]); } wtptr = wt; } else { for (i = 0; i < n; ++i) { for (j = 0; j < m; ++j) scanf("%lf", &X(i, j)); scanf("%ld", &ing[i]); } } for (j = 0; j < m; ++j) scanf("%ld", &isx[j]); /* nag_mv_discrim (g03dac). * Test for equality of within-group covariance matrices */ nag_mv_discrim(n, m, x, tdx, isx, nvar, ing, ng, wtptr, nig, gmean, tdgmean, det, gc, &stat, &df, &sig, &fail); if (fail.code != NE_NOERROR) { printf("Error from nag_mv_discrim (g03dac).\n%s\n", fail.message); exit_status = 1; goto END; } scanf("%ld", &nobs); scanf("%39s", nag_enum_arg); equal = (Nag_GroupCovars) nag_enum_name_to_value(nag_enum_arg); scanf("%39s", nag_enum_arg); type = (Nag_DiscrimMethod) nag_enum_name_to_value(nag_enum_arg); if (nobs >= 1) { if (!(ati = NAG_ALLOC((nobs)*(ng), double)) || !(p = NAG_ALLOC((nobs)*(ng), double)) || !(iag = NAG_ALLOC(nobs, Integer))) { printf("Allocation failure\n"); exit_status = -1; goto END; } tdati = ng; tdp = ng; for (i = 0; i < nobs; ++i) { for (j = 0; j < m; ++j) { scanf("%lf", &X(i, j)); } } /* nag_mv_discrim_group (g03dcc). * Allocates observations to groups, following * nag_mv_discrim (g03dac) */ nag_mv_discrim_group(type, equal, Nag_EqualPrior, nvar, ng, nig, gmean, tdgmean, gc, det, nobs, m, isx, x, tdx, prior, p, tdp, iag, atiq, ati, &fail); if (fail.code != NE_NOERROR) { printf("Error from nag_mv_discrim_group (g03dcc).\n%s\n", fail.message); exit_status = 1; goto END; } printf("\n"); printf(" Obs Posterior Allocated "); printf(" Atypicality "); printf("\n"); printf(" probabilities to group index "); printf("\n"); printf("\n"); for (i = 0; i < nobs; ++i) { printf(" %6ld ", i+1); for (j = 0; j < ng; ++j) { printf("%6.3f", P(i, j)); } printf(" %6ld ", iag[i]); for (j = 0; j < ng; ++j) { printf("%6.3f", ATI(i, j)); } printf("\n"); } } END: NAG_FREE(ati); NAG_FREE(det); NAG_FREE(gc); NAG_FREE(gmean); NAG_FREE(p); NAG_FREE(prior); NAG_FREE(wt); NAG_FREE(x); NAG_FREE(iag); NAG_FREE(ing); NAG_FREE(isx); NAG_FREE(nig); return exit_status; }