/* nag_tsa_varma_update (g13dkc) Example Program. * * Copyright 2005 Numerical Algorithms Group. * * Mark 8, 2004. */ #include #include #include #include #include static void fprint(Integer k, Integer nm, Integer lmax, double predz[], double sefz[], Integer kmax); int main(void) { /* Scalars */ double cgetol, rlogl; Integer exit_status = 0, i, icm, idmax, idmin, kmax, ip, iprint, iq; Integer ishow, j, k, lmax, npar, lref, m, maxcal, mlast, n, nd; Integer niter, nm; /* Arrays */ double *cm = 0, *delta = 0, *g = 0, *par = 0, *predz = 0, *qq = 0; double *ref = 0, *sefz = 0, *v = 0, *w = 0, *z = 0; Integer *id = 0, *tr = 0; char nag_enum_arg[40]; /* Nag types */ Nag_Boolean *parhld = 0; Nag_Boolean exact; Nag_IncludeMean mean; NagError fail; #define DELTA(I, J) delta[(J - 1) * kmax + I - 1] #define QQ(I, J) qq[(J - 1) * kmax + I - 1] #define Z(I, J) z[(J - 1) * kmax + I - 1] INIT_FAIL(fail); printf("nag_tsa_varma_update (g13dkc) Example Program Results\n"); /* Skip heading in data file */ scanf("%*[^\n] "); scanf("%ld%ld%ld%ld %39s %ld%*[^\n]", &k, &n, &ip, &iq, nag_enum_arg, &lmax); /* nag_enum_name_to_value (x04nac). * Converts NAG enum member name to value */ mean = (Nag_IncludeMean) nag_enum_name_to_value(nag_enum_arg); npar = (ip + iq) * k * k; if (mean == Nag_MeanInclude) { npar += k; } if (k > 0 && n >= 1 && npar >= 1 && lmax >= 1) { kmax = 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 * kmax, double)) || !(qq = NAG_ALLOC(k * kmax, double)) || !(ref = NAG_ALLOC(lref, double)) || !(sefz = NAG_ALLOC(lmax * kmax, double)) || !(v = NAG_ALLOC(n * kmax, double)) || !(w = NAG_ALLOC(n * kmax, double)) || !(z = NAG_ALLOC(n * kmax, double)) || !(id = NAG_ALLOC(k, Integer)) || !(parhld = NAG_ALLOC(npar, Nag_Boolean))) { printf("Allocation failure\n"); exit_status = -1; goto END; } } else { printf("Invalid parameters\n"); exit_status = -1; goto END; } for (i = 1; i <= k; ++i) { scanf("%ld", &id[i-1]); } scanf("%*[^\n]"); idmax = 0; idmin = 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))) { printf("Allocation failure\n"); exit_status = -1; goto END; } for (i = 1; i <= k; ++i) { for (j = 1; j <= n; ++j) { scanf("%lf", &Z(i, j)); } } scanf("%*[^\n]"); for (i = 1; i <= k; ++i) { scanf("%ld", &tr[i - 1]); } scanf("%*[^\n]"); if (idmax > 0) { for (i = 1; i <= k; ++i) { for (j = 1; j <= id[i-1]; ++j) { scanf("%lf", &DELTA(i, j)); } scanf("%*[^\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) { printf("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 (j = 1; j <= k; ++j) { for (i = j; i <= k; ++i) { QQ(i, j) = 0.0; } } parhld[2] = Nag_TRUE; exact = Nag_TRUE; /* ** Set iprint > 0 for no intermediate monitoring */ iprint = -1; cgetol = 1e-4; maxcal = npar * 40 * (npar + 5); /* ** Set ishow = 0 for no results from nag_tsa_varma_estimate (g13ddc) */ 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, kmax, w, parhld, exact, iprint, cgetol, maxcal, ishow, 0, &niter, &rlogl, v, g, cm, icm, &fail); if (fail.code != NE_NOERROR) { printf("\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_G13D_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, kmax, tr, id, delta, ip, iq, mean, par, npar, qq, v, lmax, predz, sefz, ref, lref, &fail); if (fail.code != NE_NOERROR) { printf( "\n nag_tsa_varma_forecast (g13djc) message: %s\n\n", fail.message); exit_status = 1; goto END; } fprint(k, n, lmax, predz, sefz, kmax); m = 1; mlast = 0; Z(1, 1) = 8.1; Z(2, 1) = 10.2; /* nag_tsa_varma_update (g13dkc). * Multivariate time series, updates forecasts and their * standard errors */ nag_tsa_varma_update(k, lmax, m, &mlast, z, k, ref, lref, v, predz, sefz, &fail); if (fail.code != NE_NOERROR) { printf( "\n nag_tsa_varma_update (g13dkc) message: %s\n\n", fail.message); exit_status = 1; goto END; } nm = n + mlast; fprint(k, nm, lmax, predz, sefz, kmax); m = 1; /* Leave mlast unchanged from last call */ Z(1, 1) = 8.5; Z(2, 1) = 10.; /* nag_tsa_varma_update (g13dkc), see above. */ nag_tsa_varma_update(k, lmax, m, &mlast, z, k, ref, lref, v, predz, sefz, &fail); if (fail.code != NE_NOERROR) { printf( "\n nag_tsa_varma_update (g13dkc) message: %s\n\n", fail.message); exit_status = 1; goto END; } nm = n + mlast; fprint(k, nm, lmax, predz, sefz, kmax); } } END: NAG_FREE(tr); NAG_FREE(cm); NAG_FREE(delta); NAG_FREE(g); NAG_FREE(par); NAG_FREE(predz); NAG_FREE(qq); NAG_FREE(ref); NAG_FREE(sefz); NAG_FREE(v); NAG_FREE(w); NAG_FREE(z); NAG_FREE(id); NAG_FREE(parhld); return exit_status; } static void fprint(Integer k, Integer nm, Integer lmax, double predz[], double sefz[], Integer kmax) { /* Scalars */ Integer i2, i, j, l, l2, loop; #define SEFZ(I, J) sefz[(J - 1) * kmax + I - 1] #define PREDZ(I, J) predz[(J - 1) * kmax + I - 1] printf("\n"); printf("Forecast summary table\n"); printf("----------------------\n\n"); printf("Forecast origin is set at t = %4ld\n\n", nm); loop = lmax / 5; if (lmax % 5 != 0) { ++loop; } for (j = 1; j <= loop; ++j) { i2 = (j - 1) * 5; l2 = MIN(i2 + 5, lmax); printf("%s%13s", "Lead Time", ""); for (i = i2 + 1; i <= l2; ++i) { printf("%10ld%s", i, (i % 5 == 0 || i == l2?"\n":" ")); } printf("\n"); for (i = 1; i <= k; ++i) { printf("%-7s%2ld%-15s", "Series", i, ": Forecast"); for (l = i2 + 1; l <= l2; ++l) { printf("%10.2f%s", PREDZ(i, l), (l % 5 == 0 || l == l2?"\n":" ")); } printf("%9s%-18s", "", ": Standard Error "); for (l = i2 + 1; l <= l2; ++l) { printf("%7.2f%s", SEFZ(i, l), (l % 5 == 0 || l == l2?"\n":" ")); } printf("\n"); } } }