/* nag_pls_orth_scores_svd (g02lac) Example Program. * * Copyright 2008, Numerical Algorithms Group. * * Mark 9, 2009. */ /* Pre-processor includes */ #include #include #include #include #include #include int main(void) { /*Integer scalar and array declarations */ Integer exit_status = 0; Integer i, ip, j, maxfac, mx, my, n; Integer pdc, pdp, pdt, pdu, pdw, pdx, pdxres, pdy, pdycv, pdyres; Integer *isx = 0; /*Double scalar and array declarations */ double *c = 0, *p = 0, *t = 0, *u = 0, *w = 0, *x = 0, *xbar = 0; double *xcv = 0, *xres = 0, *xstd = 0, *y = 0, *ybar = 0; double *ycv = 0, *yres = 0, *ystd = 0; /*Character scalar and array declarations */ char sscale[18]; /*NAG Types */ Nag_OrderType order; Nag_ScalePredictor scale; NagError fail; INIT_FAIL(fail); printf( "nag_pls_orth_scores_svd (g02lac) Example Program Results\n"); /* Skip header in data file.*/ scanf("%*[^\n] "); /* Read data values.*/ scanf("%ld%ld%ld%s %ld%*[^\n] ", &n, &mx, &my, sscale, &maxfac); scale = (Nag_ScalePredictor) nag_enum_name_to_value(sscale); if (!(isx = NAG_ALLOC(mx, Integer))) { printf("Allocation failure\n"); exit_status = -1; goto END; } for (j = 0; j < mx; j++) scanf("%ld ", &isx[j]); scanf("%*[^\n] "); ip = 0; for (j = 0; j < mx; j++) { if (isx[j] == 1) ip = ip+1; } #ifdef NAG_COLUMN_MAJOR pdc = my; #define C(I, J) c[(J-1)*pdc + I-1] pdp = ip; #define P(I, J) p[(J-1)*pdp + I-1] pdt = n; #define T(I, J) t[(J-1)*pdt + I-1] pdu = n; #define U(I, J) u[(J-1)*pdu + I-1] pdw = ip; #define W(I, J) w[(J-1)*pdw + I-1] pdx = n; #define X(I, J) x[(J-1)*pdx + I-1] pdxres = n; #define XRES(I, J) xres[(J-1)*pdxres + I-1] pdy = n; #define Y(I, J) y[(J-1)*pdy + I-1] pdycv = maxfac; #define YCV(I, J) ycv[(J-1)*pdycv + I-1] pdyres = n; #define YRES(I, J) yres[(J-1)*pdyres + I-1] order = Nag_ColMajor; #else pdc = maxfac; #define C(I, J) c[(I-1)*pdc + J-1] pdp = maxfac; #define P(I, J) p[(I-1)*pdp + J-1] pdt = maxfac; #define T(I, J) t[(I-1)*pdt + J-1] pdu = maxfac; #define U(I, J) u[(I-1)*pdu + J-1] pdw = maxfac; #define W(I, J) w[(I-1)*pdw + J-1] pdx = mx; #define X(I, J) x[(I-1)*pdx + J-1] pdxres = ip; #define XRES(I, J) xres[(I-1)*pdxres + J-1] pdy = my; #define Y(I, J) y[(I-1)*pdy + J-1] pdycv = my; #define YCV(I, J) ycv[(I-1)*pdycv + J-1] pdyres = my; #define YRES(I, J) yres[(I-1)*pdyres + J-1] order = Nag_RowMajor; #endif /* Assign parameter values to corresponding variables */ if (!(c = NAG_ALLOC(pdc*(order == Nag_RowMajor?my:maxfac), double)) || !(p = NAG_ALLOC(pdp*(order == Nag_RowMajor?ip:maxfac), double)) || !(t = NAG_ALLOC(pdt*(order == Nag_RowMajor?n:maxfac), double)) || !(u = NAG_ALLOC(pdu*(order == Nag_RowMajor?n:maxfac), double)) || !(w = NAG_ALLOC(pdw*(order == Nag_RowMajor?ip:maxfac), double)) || !(x = NAG_ALLOC(pdx*(order == Nag_RowMajor?n:mx), double)) || !(xbar = NAG_ALLOC(ip, double)) || !(xcv = NAG_ALLOC(maxfac, double)) || !(xres = NAG_ALLOC(pdxres*(order == Nag_RowMajor?n:ip), double)) || !(xstd = NAG_ALLOC(ip, double)) || !(y = NAG_ALLOC(pdy*(order == Nag_RowMajor?n:my), double)) || !(ybar = NAG_ALLOC(my, double)) || !(ycv = NAG_ALLOC(pdycv*(order == Nag_RowMajor?maxfac:my), double)) || !(yres = NAG_ALLOC(pdyres*(order == Nag_RowMajor?n:my), double)) || !(ystd = NAG_ALLOC(my, double))) { printf("Allocation failure\n"); exit_status = -1; goto END; } /* Read data values.*/ for (i = 1; i <= n; i++) { for (j = 1; j <= mx; j++) scanf("%lf ", &X(i, j)); for (j = 1; j <= my; j++) scanf("%lf ", &Y(i, j)); } scanf("%*[^\n] "); /* Fit a PLS model.*/ /* * nag_pls_orth_scores_svd (g02lac) * Partial least-squares */ nag_pls_orth_scores_svd(order, n, mx, x, pdx, isx, ip, my, y, pdy, xbar, ybar, scale, xstd, ystd, maxfac, xres, pdxres, yres, pdyres, w, pdw, p, pdp, t, pdt, c, pdc, u, pdu, xcv, ycv, pdycv, &fail); if (fail.code != NE_NOERROR) { printf("Error from nag_pls_orth_scores_svd (g02lac).\n%s\n", fail.message); exit_status = 1; goto END; } /* * nag_gen_real_mat_print (x04cac) * Print real general matrix (easy-to-use) */ fflush(stdout); nag_gen_real_mat_print(order, Nag_GeneralMatrix, Nag_NonUnitDiag, ip, maxfac, p, pdp, "x-loadings, P", 0, &fail); if (fail.code != NE_NOERROR) { printf("Error from nag_gen_real_mat_print (x04cac).\n%s\n", fail.message); exit_status = 1; goto END; } /* * nag_gen_real_mat_print (x04cac) * Print real general matrix (easy-to-use) */ fflush(stdout); nag_gen_real_mat_print(order, Nag_GeneralMatrix, Nag_NonUnitDiag, n, maxfac, t, pdt, "x-scores, T", 0, &fail); if (fail.code != NE_NOERROR) { printf("Error from nag_gen_real_mat_print (x04cac).\n%s\n", fail.message); exit_status = 1; goto END; } /* * nag_gen_real_mat_print (x04cac) * Print real general matrix (easy-to-use) */ fflush(stdout); nag_gen_real_mat_print(order, Nag_GeneralMatrix, Nag_NonUnitDiag, my, maxfac, c, pdc, "y-loadings, C", 0, &fail); if (fail.code != NE_NOERROR) { printf("Error from nag_gen_real_mat_print (x04cac).\n%s\n", fail.message); exit_status = 1; goto END; } /* * nag_gen_real_mat_print (x04cac) * Print real general matrix (easy-to-use) */ fflush(stdout); nag_gen_real_mat_print(order, Nag_GeneralMatrix, Nag_NonUnitDiag, n, maxfac, u, pdu, "y-scores, U", 0, &fail); if (fail.code != NE_NOERROR) { printf("Error from nag_gen_real_mat_print (x04cac).\n%s\n", fail.message); exit_status = 1; goto END; } printf("\n"); printf("%s\n", "Explained Variance"); printf("%12s%24s\n", "Model effects", "Dependent variable(s)"); for (i = 1; i <= maxfac; i++) { printf("%12.6f", xcv[i-1]); for (j = 1; j <= my; j++) printf("%12.6f%s", YCV(i, j), j%10?" ":"\n"); printf("\n"); } END: if (c) NAG_FREE(c); if (p) NAG_FREE(p); if (t) NAG_FREE(t); if (u) NAG_FREE(u); if (w) NAG_FREE(w); if (x) NAG_FREE(x); if (xbar) NAG_FREE(xbar); if (xcv) NAG_FREE(xcv); if (xres) NAG_FREE(xres); if (xstd) NAG_FREE(xstd); if (y) NAG_FREE(y); if (ybar) NAG_FREE(ybar); if (ycv) NAG_FREE(ycv); if (yres) NAG_FREE(yres); if (ystd) NAG_FREE(ystd); if (isx) NAG_FREE(isx); return exit_status; }