/* nag_mv_discrim_mahaldist (g03dbc) Example Program. * * Copyright 1998 Numerical Algorithms Group. * * Mark 5, 1998. * Mark 8 revised, 2004. * */ #include #include #include #include #define D(I, J) d[(I) *tdd + J] #define GMEAN(I, J) gmean[(I) *tdgmean + J] #define X(I, J) x[(I) *tdx + J] int main(void) { Integer i, j, m, n, ng, nobs, nvar, tdd, tdgmean, tdx; Integer exit_status = 0, *ing = 0, *isx = 0, *nig = 0; char nag_enum_arg[40]; double df, sig, stat; double *d = 0, *det = 0, *gc = 0, *gmean = 0, *wt = 0; double *wtptr = 0, *x = 0; Nag_GroupCovars equal; Nag_Boolean weight; NagError fail; INIT_FAIL(fail); printf( "nag_mv_discrim_mahaldist (g03dbc) 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)) || !(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; } tdgmean = nvar; tdx = m; } else { printf("Invalid n or nvar or m 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); if (nobs >= 1) { if (!(d = NAG_ALLOC(nobs*ng, double))) { printf("Allocation failure\n"); exit_status = -1; goto END; } tdd = ng; for (i = 0; i < nobs; ++i) { for (j = 0; j < m; ++j) scanf("%lf", &X(i, j)); } /* nag_mv_discrim_mahaldist (g03dbc). * Mahalanobis squared distances, following nag_mv_discrim * (g03dac) */ nag_mv_discrim_mahaldist(equal, Nag_SamplePoints, nvar, ng, gmean, tdgmean, gc, nobs, m, isx, x, tdx, d, tdd, &fail); if (fail.code != NE_NOERROR) { printf("Error from nag_mv_discrim_mahaldist (g03dbc).\n%s\n", fail.message); exit_status = 1; goto END; } printf("\n Obs Distances\n\n"); for (i = 0; i < nobs; ++i) { printf(" %3ld", i+1); for (j = 0; j < ng; ++j) printf("%10.3f", D(i, j)); printf("\n"); } } END: NAG_FREE(d); NAG_FREE(det); NAG_FREE(gc); NAG_FREE(gmean); NAG_FREE(wt); NAG_FREE(x); NAG_FREE(ing); NAG_FREE(isx); NAG_FREE(nig); return exit_status; }