/* nag_rand_times_smooth_exp (g05pmc) Example Program.
*
* Copyright 2023 Numerical Algorithms Group.
*
* Mark 29.3, 2023.
*/
/* Pre-processor includes */
#include <math.h>
#include <nag.h>
#include <stdio.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_times_smooth_exp (g05pmc) Example Program Results\n\n");
/* Get the length of the state array */
lstate = -1;
nag_rand_init_repeat(genid, subid, seed, lseed, state, &lstate, &fail);
if (fail.code != NE_NOERROR) {
printf("Error from nag_rand_init_repeat (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_repeat(genid, subid, seed, lseed, state, &lstate, &fail);
if (fail.code != NE_NOERROR) {
printf("Error from nag_rand_init_repeat (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_times_smooth_exp (g05pmc) and state in g13amc are in
the same format) */
nag_tsa_uni_smooth_exp(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_uni_smooth_exp (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_times_smooth_exp(mode, nf, itype, p, param, init, var, r, state, e,
0, tsim1, &fail);
if (fail.code != NE_NOERROR) {
printf("Error from nag_rand_times_smooth_exp (g05pmc).\n%s\n",
fail.message);
exit_status = 1;
goto END;
}
/* Bootstrapping errors */
bvar = 0.0e0;
nag_rand_times_smooth_exp(mode, nf, itype, p, param, init, bvar, r, state,
res, en, tsim2, &fail);
if (fail.code != NE_NOERROR) {
printf("Error from nag_rand_times_smooth_exp (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_stat_quantiles(nsim, &GSIM(0, i), nq, q, &GLIM(0, i), &fail);
if (fail.code != NE_NOERROR) {
printf("Error from nag_stat_quantiles (g01amc).\n%s\n", fail.message);
exit_status = 1;
goto END;
}
nag_stat_quantiles(nsim, &BSIM(0, i), nq, q, &BLIM(0, i), &fail);
if (fail.code != NE_NOERROR) {
printf("Error from nag_stat_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_stat_inv_cdf_normal(tail, q[1], &fail);
if (fail.code != NE_NOERROR) {
printf("Error from nag_stat_inv_cdf_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;
}