NAG Library Manual, Mark 30
Interfaces:  FL   CL   CPP   AD 

NAG CL Interface Introduction
Example description
/* nag_rand_times_smooth_exp (g05pmc) Example Program.
 *
 * Copyright 2024 Numerical Algorithms Group.
 *
 * Mark 30.0, 2024.
 */
/* 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] ", &param[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] ", &param[0], &param[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] ", &param[0], &param[1], &param[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] ", &param[0], &param[1],
          &param[2], &param[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] ", &param[0], &param[1],
          &param[2], &param[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;
}