/* nag_rand_exp_smooth (g05pmc) Example Program.
*
* NAGPRODCODE Version.
*
* Copyright 2016 Numerical Algorithms Group.
*
* Mark 26, 2016.
*/
/* Pre-processor includes */
#include <stdio.h>
#include <math.h>
#include <nag.h>
#include <nag_stdlib.h>
#include <nagg01.h>
#include <nagg05.h>
#include <nagg13.h>
#define BLIM(I, J) blim[J*2 + I]
#define BSIM(I, J) bsim[J*nsim + I]
#define GLIM(I, J) glim[J*2 + I]
#define GSIM(I, J) gsim[J*nsim + I]
int main(void)
{
/* Integer scalar and array declarations */
Integer exit_status = 0;
Integer en, i, ival, j, k, lstate, n, nf, nsim, p, nq;
Integer *state = 0;
/* NAG structures */
NagError fail;
Nag_TailProbability tail;
Nag_InitialValues mode;
Nag_ExpSmoothType itype;
/* Double scalar and array declarations */
double ad, alpha, dv, tmp, var, z, bvar;
double *blim = 0, *bsim = 0, *e = 0, *fse = 0, *fv = 0;
double *glim = 0, *gsim = 0, *init = 0, *param = 0, *r = 0;
double *res = 0, *tsim1 = 0, *tsim2 = 0, *y = 0, *yhat = 0;
double q[2];
/* Character scalar and array declarations */
char smode[40], sitype[40];
/* Choose the base generator */
Nag_BaseRNG genid = Nag_Basic;
Integer subid = 0;
/* Set the seed */
Integer seed[] = { 1762543 };
Integer lseed = 1;
/* Initialize the error structure */
INIT_FAIL(fail);
printf("nag_rand_exp_smooth (g05pmc) Example Program Results\n\n");
/* Get the length of the state array */
lstate = -1;
nag_rand_init_repeatable(genid, subid, seed, lseed, state, &lstate, &fail);
if (fail.code != NE_NOERROR) {
printf("Error from nag_rand_init_repeatable (g05kfc).\n%s\n",
fail.message);
exit_status = 1;
goto END;
}
/* Skip headings in data file */
scanf("%*[^\n] ");
/* Read in the initial arguments and check array sizes */
scanf("%39s%39s%" NAG_IFMT "%" NAG_IFMT "%" NAG_IFMT "%lf%*[^\n] ", smode,
sitype, &n, &nf, &nsim, &alpha);
/*
* nag_enum_name_to_value (x04nac).
* Converts NAG enum member name to value
*/
mode = (Nag_InitialValues) nag_enum_name_to_value(smode);
itype = (Nag_ExpSmoothType) nag_enum_name_to_value(sitype);
/* Allocate arrays */
if (!(blim = NAG_ALLOC(2 * nf, double)) ||
!(bsim = NAG_ALLOC(nsim * nf, double)) ||
!(e = NAG_ALLOC(1, double)) ||
!(fse = NAG_ALLOC(nf, double)) ||
!(fv = NAG_ALLOC(nf, double)) ||
!(glim = NAG_ALLOC(2 * nf, double)) ||
!(gsim = NAG_ALLOC(nsim * nf, double)) ||
!(res = NAG_ALLOC(n, double)) ||
!(tsim1 = NAG_ALLOC(nf, double)) ||
!(tsim2 = NAG_ALLOC(nf, double)) ||
!(y = NAG_ALLOC(n, double)) ||
!(yhat = NAG_ALLOC(n, double)) || !(state = NAG_ALLOC(lstate, Integer)))
{
printf("Allocation failure\n");
exit_status = -1;
goto END;
}
/* Initialize the generator to a repeatable sequence */
nag_rand_init_repeatable(genid, subid, seed, lseed, state, &lstate, &fail);
if (fail.code != NE_NOERROR) {
printf("Error from nag_rand_init_repeatable (g05kfc).\n%s\n",
fail.message);
exit_status = 1;
goto END;
}
for (i = 0; i < n; i++)
scanf("%lf ", &y[i]);
scanf("%*[^\n] ");
/* Read in the itype dependent arguments (skipping headings) */
scanf("%*[^\n] ");
if (itype == Nag_SingleExponential) {
/* Single exponential smoothing required */
if (!(param = NAG_ALLOC(1, double)))
{
printf("Allocation failure\n");
exit_status = -1;
goto END;
}
scanf("%lf%*[^\n] ", ¶m[0]);
p = 0;
ival = 1;
}
else if (itype == Nag_BrownsExponential) {
/* Browns exponential smoothing required */
if (!(param = NAG_ALLOC(2, double)))
{
printf("Allocation failure\n");
exit_status = -1;
goto END;
}
scanf("%lf %lf%*[^\n] ", ¶m[0], ¶m[1]);
p = 0;
ival = 2;
}
else if (itype == Nag_LinearHolt) {
/* Linear Holt smoothing required */
if (!(param = NAG_ALLOC(3, double)))
{
printf("Allocation failure\n");
exit_status = -1;
goto END;
}
scanf("%lf %lf %lf%*[^\n] ", ¶m[0], ¶m[1], ¶m[2]);
p = 0;
ival = 2;
}
else if (itype == Nag_AdditiveHoltWinters) {
/* Additive Holt Winters smoothing required */
if (!(param = NAG_ALLOC(4, double)))
{
printf("Allocation failure\n");
exit_status = -1;
goto END;
}
scanf("%lf %lf %lf %lf %" NAG_IFMT "%*[^\n] ", ¶m[0], ¶m[1],
¶m[2], ¶m[3], &p);
ival = p + 2;
}
else if (itype == Nag_MultiplicativeHoltWinters) {
/* Multiplicative Holt Winters smoothing required */
if (!(param = NAG_ALLOC(4, double)))
{
printf("Allocation failure\n");
exit_status = -1;
goto END;
}
scanf("%lf %lf %lf %lf %" NAG_IFMT "%*[^\n] ", ¶m[0], ¶m[1],
¶m[2], ¶m[3], &p);
ival = p + 2;
}
else {
printf("%s is an unknown type\n", sitype);
exit_status = -1;
goto END;
}
/* Allocate arrays */
if (!(init = NAG_ALLOC(p + 2, double)) || !(r = NAG_ALLOC(p + 13, double)))
{
printf("Allocation failure\n");
exit_status = -1;
goto END;
}
/* Read in the mode dependent arguments (skipping headings) */
scanf("%*[^\n] ");
if (mode == Nag_InitialValuesSupplied) {
/* User supplied initial values */
for (i = 0; i < ival; i++)
scanf("%lf ", &init[i]);
scanf("%*[^\n] ");
}
else if (mode == Nag_ContinueAndUpdate) {
/* Continuing from a previously saved R */
for (i = 0; i < p + 13; i++)
scanf("%lf ", &r[i]);
scanf("%*[^\n] ");
}
else if (mode == Nag_EstimateInitialValues) {
/* Initial values calculated from first k observations */
scanf("%" NAG_IFMT "%*[^\n] ", &k);
}
else {
printf("%s is an unknown mode\n", smode);
exit_status = -1;
goto END;
}
/* Fit a smoothing model (parameter r in
* nag_rand_exp_smooth (g05pmc) and state in g13amc are in
the same format) */
nag_tsa_exp_smooth(mode, itype, p, param, n, y, k, init, nf, fv, fse, yhat,
res, &dv, &ad, r, &fail);
if (fail.code != NE_NOERROR) {
printf("Error from nag_tsa_exp_smooth (g13amc).\n%s\n", fail.message);
exit_status = 1;
goto END;
}
/* Simulate forecast values from the model, and don't update r */
var = dv * dv;
en = n;
/* Change the mode used to continue from fit model */
mode = Nag_ContinueAndUpdate;
/* Simulate nsim forecasts */
for (i = 0; i < nsim; i++) {
/* Simulations assuming Gaussian errors */
nag_rand_exp_smooth(mode, nf, itype, p, param, init, var, r, state,
e, 0, tsim1, &fail);
if (fail.code != NE_NOERROR) {
printf("Error from nag_rand_exp_smooth (g05pmc).\n%s\n", fail.message);
exit_status = 1;
goto END;
}
/* Bootstrapping errors */
bvar = 0.0e0;
nag_rand_exp_smooth(mode, nf, itype, p, param, init, bvar, r, state,
res, en, tsim2, &fail);
if (fail.code != NE_NOERROR) {
printf("Error from nag_rand_exp_smooth (g05pmc).\n%s\n", fail.message);
exit_status = 1;
goto END;
}
/* Copy and transpose the simulated values */
for (j = 0; j < nf; j++) {
GSIM(i, j) = tsim1[j];
BSIM(i, j) = tsim2[j];
}
}
/* Calculate CI based on the quantiles for each simulated forecast */
q[0] = alpha / 2.0e0;
q[1] = 1.0e0 - q[0];
nq = 2;
for (i = 0; i < nf; i++) {
nag_double_quantiles(nsim, &GSIM(0, i), nq, q, &GLIM(0, i), &fail);
if (fail.code != NE_NOERROR) {
printf("Error from nag_double_quantiles (g01amc).\n%s\n", fail.message);
exit_status = 1;
goto END;
}
nag_double_quantiles(nsim, &BSIM(0, i), nq, q, &BLIM(0, i), &fail);
if (fail.code != NE_NOERROR) {
printf("Error from nag_double_quantiles (g01amc).\n%s\n", fail.message);
exit_status = 1;
goto END;
}
}
/* Display the forecast values and associated prediction intervals */
printf("Initial values used:\n");
for (i = 0; i < ival; i++)
printf("%4" NAG_IFMT " %12.3f \n", i + 1, init[i]);
printf("\n");
printf("Mean Deviation = %13.4e\n", dv);
printf("Absolute Deviation = %13.4e\n\n", ad);
printf(" Observed 1-Step\n");
printf(" Period Values Forecast Residual\n\n");
for (i = 0; i < n; i++)
printf("%4" NAG_IFMT " %11.3f %11.3f %11.3f\n", i + 1, y[i],
yhat[i], res[i]);
printf("\n");
tail = Nag_LowerTail;
z = nag_deviates_normal(tail, q[1], &fail);
if (fail.code != NE_NOERROR) {
printf("Error from nag_deviates_normal (g01fac).\n%s\n", fail.message);
exit_status = 1;
goto END;
}
printf(" Simulated CI"
" Simulated CI\n");
printf(" Obs. Forecast Estimated CI (Gaussian Errors)"
" (Bootstrap Errors)\n");
for (i = 0; i < nf; i++) {
tmp = z * fse[i];
printf("%3" NAG_IFMT " %10.3f %10.3f %10.3f"
" %10.3f %10.3f %10.3f %10.3f\n", n + i + 1, fv[i], fv[i] - tmp,
fv[i] + tmp, GLIM(0, i), GLIM(1, i), BLIM(0, i), BLIM(1, i));
}
printf(" %5.1f%% CIs were produced\n", 100.0e0 * (1.0e0 - alpha));
END:
NAG_FREE(blim);
NAG_FREE(bsim);
NAG_FREE(e);
NAG_FREE(fse);
NAG_FREE(fv);
NAG_FREE(glim);
NAG_FREE(gsim);
NAG_FREE(init);
NAG_FREE(param);
NAG_FREE(r);
NAG_FREE(res);
NAG_FREE(tsim1);
NAG_FREE(tsim2);
NAG_FREE(y);
NAG_FREE(yhat);
NAG_FREE(state);
return exit_status;
}