/* nag_tsa_varma_forecast (g13djc) Example Program. * * Copyright 2005 Numerical Algorithms Group. * * Mark 8, 2004. */ #include #include #include #include int main(void) { /* Scalars */ double cgetol, rlogl; Integer exit_status, i, i2, idmax, idmin, ip, iprint, iq, ishow, j, k, l, l2; Integer lref, lmax, loop, maxcal, n, nd, niter, npar; Integer ik, icm; Nag_Boolean exact; Nag_IncludeMean mean; char meanc; /* Arrays */ double *cm = 0, *delta = 0, *g = 0, *par = 0, *predz = 0, *qq = 0, *ref = 0; double *sefz = 0, *v = 0, *w = 0, *z = 0; const char *outfile = 0; Integer *id = 0, *tr = 0; /* Nag types */ NagError fail; Nag_Boolean *parhld = 0; #define DELTA(I,J) delta[(J - 1) * ik + I - 1] #define PREDZ(I,J) predz[(J - 1) * ik + I - 1] #define QQ(I,J) qq[(J - 1) * ik + I - 1] #define SEFZ(I,J) sefz[(J - 1) * ik + I - 1] #define Z(I,J) z[(J - 1) * ik + I - 1] Vprintf("nag_tsa_varma_forecast (g13djc) Example Program Results\n\n"); INIT_FAIL(fail); exit_status = 0; /* Skip heading in data file */ Vscanf("%*[^\n]"); Vscanf("%ld%ld%ld%ld %c %ld%*[^\n]", &k, &n, &ip, &iq, &meanc, &lmax); npar = (ip + iq) * k * k; mean = Nag_MeanZero; if (meanc == 'M' || meanc == 'm') { npar += k; mean = Nag_MeanInclude; } if (k > 0 && n >= 1 && npar >= 1 && lmax >= 1) { ik = k; icm = npar; lref = (lmax - 1) * k * k + 2 * k * lmax + k; /* Allocate memory */ if ( !(tr = NAG_ALLOC(k, Integer)) || !(cm = NAG_ALLOC(npar * icm, double)) || !(g = NAG_ALLOC(npar, double)) || !(par = NAG_ALLOC(npar, double)) || !(predz = NAG_ALLOC(lmax * ik, double)) || !(qq = NAG_ALLOC(k * ik, double)) || !(ref = NAG_ALLOC(lref, double)) || !(sefz = NAG_ALLOC(lmax * ik, double)) || !(v = NAG_ALLOC(n * ik, double)) || !(w = NAG_ALLOC(n * ik, double)) || !(z = NAG_ALLOC(n * ik, double)) || !(id = NAG_ALLOC(k, Integer)) || !(parhld = NAG_ALLOC(npar, Nag_Boolean)) ) { Vprintf("Allocation failure\n"); exit_status = -1; goto END; } } else { Vprintf("Invalid parameters\n"); exit_status = -1; goto END; } for (i = 1; i <= k; ++i) { Vscanf("%"NAG_IFMT, &id[i-1]); } Vscanf("%*[^\n]"); idmin = 0; idmax = 0; for (i = 1; i <= k; ++i) { idmin = MIN(id[i-1], idmin); idmax = MAX(id[i-1], idmax); } if (idmin >= 0) { if ( !(delta = NAG_ALLOC(k * idmax, double)) ) { Vprintf("Allocation failure\n"); exit_status = -1; goto END; } for (i = 1; i <= k; ++i) { for (j = 1; j <= n; ++j) { Vscanf("%lf ", &Z(i,j)); } } Vscanf("%*[^\n]"); for (i = 1; i <= k; ++i) { Vscanf("%ld ", &tr[i-1]); } Vscanf("%*[^\n]"); if (idmax > 0) { for (i = 1; i <= k; ++i) { for (j = 1; j <= id[i-1]; ++j) { Vscanf("%lf", &DELTA(i,j)); } Vscanf("%*[^\n] "); } } /* nag_tsa_multi_diff (g13dlc). * Multivariate time series, differences and/or transforms */ nag_tsa_multi_diff(k, n, z, tr, id, delta, w, &nd, &fail); if (fail.code != NE_NOERROR) { Vprintf("Error from nag_tsa_multi_diff (g13dlc).\n%s\n", fail.message); exit_status = 1; goto END; } for (i = 1; i <= npar; ++i) { par[i-1] = 0.0; parhld[i-1] = Nag_FALSE; } for (i = 1; i <= k; ++i) { for (j = 1; j <= i; ++j) { QQ(i,j) = 0.0; } } parhld[2] = Nag_TRUE; exact = Nag_TRUE; /* ** Set iprint < 0 for no monitoring */ iprint = -1; cgetol = 1.0e-4; maxcal = npar * 40 * (npar + 5); ishow = 0; /* nag_tsa_varma_estimate (g13ddc). * Multivariate time series, estimation of VARMA model */ nag_tsa_varma_estimate(k, nd, ip, iq, mean, par, npar, qq, ik, w, parhld, exact, iprint, cgetol, maxcal, ishow, outfile, &niter, &rlogl, v, g, cm, icm, &fail); if (fail.code != NE_NOERROR) { Vprintf("\n nag_tsa_varma_estimate (g13ddc) message: %s\n\n", fail.message); exit_status = 1; goto END; } if (fail.code == NE_NOERROR || fail.code == NE_G13D_MAXCAL || fail.code == NE_MAX_LOGLIK || fail.code == NE_G13D_BOUND || fail.code == NE_G13D_DERIV || fail.code == NE_HESS_NOT_POS_DEF) { /* nag_tsa_varma_forecast (g13djc). * Multivariate time series, forecasts and their standard * errors */ nag_tsa_varma_forecast(k, n, z, ik, tr, id, delta, ip, iq, mean, par, npar, qq, v, lmax, predz, sefz, ref, lref, &fail); if (fail.code != NE_NOERROR) { Vprintf("\n nag_tsa_varma_forecast (g13djc) message: %s\n\n", fail.message); exit_status = 1; goto END; } Vprintf("\n"); Vprintf("Forecast summary table\n"); Vprintf("----------------------\n\n"); Vprintf("Forecast origin is set at t = %4ld\n\n", n); loop = lmax / 5; if (lmax % 5 != 0) { ++loop; } for (j = 1; j <= loop; ++j) { i2 = (j - 1) * 5; l2 = MIN(i2 + 5, lmax); Vprintf("%s%13s","Lead Time",""); for (i = i2 + 1; i <= l2; ++i) { Vprintf("%10ld%s", i, (i % 5 == 0 || i == l2 ? "\n": " ")); } Vprintf("\n"); for (i = 1; i <= k; ++i) { Vprintf("%-7s%2ld%-15s", "Series",i,": Forecast"); for (l = i2 + 1; l <= l2; ++l) { Vprintf("%10.2f%s", PREDZ(i,l), (l % 5 == 0 || l == l2 ?"\n":" ")); } Vprintf("%9s%-18s", "", ": Standard Error "); for (l = i2 + 1; l <= l2; ++l) { Vprintf("%7.2f%s", SEFZ(i,l), (l % 5 == 0 || l == l2 ? "\n":" ")); } Vprintf("\n"); } } } } END: if (tr) NAG_FREE(tr); if (cm) NAG_FREE(cm); if (delta) NAG_FREE(delta); if (g) NAG_FREE(g); if (par) NAG_FREE(par); if (predz) NAG_FREE(predz); if (qq) NAG_FREE(qq); if (ref) NAG_FREE(ref); if (sefz) NAG_FREE(sefz); if (v) NAG_FREE(v); if (w) NAG_FREE(w); if (z) NAG_FREE(z); if (id) NAG_FREE(id); if (parhld) NAG_FREE(parhld); return exit_status; }