static void arma_init_transcribe_coeffs (arma_info *ainfo, MODEL *pmod, double *b) { int q0 = ainfo->ifc + ainfo->np + ainfo->P; int totq = ainfo->nq + ainfo->Q; int i, j = 0; for (i=0; i<pmod->ncoeff; i++) { if (i == q0 && totq > 0) { /* reserve space for MA terms */ j += totq; } if (j < ainfo->nc) { b[j++] = pmod->coeff[i]; } } if (arma_xdiff(ainfo) && ainfo->ifc) { /* is this a good idea? */ b[0] /= ainfo->T; } /* insert near-zeros for MA terms */ for (i=0; i<totq; i++) { b[q0 + i] = 0.0001; } }
static int hr_transcribe_coeffs (arma_info *ainfo, MODEL *pmod, double *b) { const double *theta = NULL; const double *Theta = NULL; int j = ainfo->nexo + ainfo->ifc; int i, k = 0; int err = 0; if (ainfo->ifc) { b[0] = pmod->coeff[0]; if (arma_xdiff(ainfo)) { b[0] /= ainfo->T; } k = 1; } for (i=0; i<ainfo->p; i++) { if (AR_included(ainfo, i)) { b[k++] = pmod->coeff[j++]; } } for (i=0; i<ainfo->P; i++) { b[k++] = pmod->coeff[j]; j += ainfo->np + 1; /* assumes ainfo->p < pd */ } theta = pmod->coeff + j; for (i=0; i<ainfo->q; i++) { if (MA_included(ainfo, i)) { b[k++] = pmod->coeff[j++]; } } Theta = pmod->coeff + j; for (i=0; i<ainfo->Q; i++) { b[k++] = pmod->coeff[j]; j += ainfo->nq + 1; /* assumes ainfo->q < pd */ } j = ainfo->ifc; for (i=0; i<ainfo->nexo; i++) { b[k++] = pmod->coeff[j++]; } /* check MA values? */ if (ainfo->q > 0 || ainfo->Q > 0) { err = ma_out_of_bounds(ainfo, theta, Theta); bounds_checker_cleanup(); } return err; }
static int arma_init_build_dataset (arma_info *ainfo, int ptotal, int narmax, const int *list, const DATASET *dset, DATASET *aset, int nonlin) { double **aZ = aset->Z; const double *y; const gretl_matrix *X = NULL; int i, j, k, kx, ky; int t, s, k0 = 2; int undo_diff = 0; int xstart; int err = 0; if (arima_levels(ainfo)) { /* we'll need differences for initialization */ err = arima_difference(ainfo, dset, 1); if (err) { return err; } undo_diff = 1; y = ainfo->y; X = ainfo->dX; } else if (arma_xdiff(ainfo)) { /* run init in levels (FIXME?) */ y = dset->Z[ainfo->yno]; } else { y = ainfo->y; } /* add variable names to auxiliary dataset */ arma_init_add_varnames(ainfo, ptotal, narmax, aset); /* starting position for reading exogeneous vars */ if (ainfo->d > 0 || ainfo->D > 0) { xstart = (arma_has_seasonal(ainfo))? 10 : 6; } else { xstart = (arma_has_seasonal(ainfo))? 8 : 5; } /* set "local" globals */ xlist = list + xstart; for (t=0; t<aset->n; t++) { int realt = t + ainfo->t1; int miss = 0; if (ainfo->yscale != 1.0 && !na(y[realt])) { aZ[1][t] = y[realt] * ainfo->yscale; } else { aZ[1][t] = y[realt]; } k = k0; kx = ptotal + ainfo->nexo + k0; for (i=0; i<ainfo->p; i++) { if (!AR_included(ainfo, i)) { continue; } s = realt - (i + 1); if (s < 0) { miss = 1; aZ[k++][t] = NADBL; for (j=0; j<narmax; j++) { aZ[kx++][t] = NADBL; } } else { aZ[k][t] = y[s]; if (ainfo->yscale != 1.0 && !na(y[s])) { aZ[k][t] *= ainfo->yscale; } k++; for (j=0; j<narmax; j++) { aZ[kx++][t] = get_xti(dset, j, s, X); } } } ky = ainfo->np + ainfo->P + k0; for (j=0; j<ainfo->P; j++) { s = realt - (j + 1) * ainfo->pd; k = ainfo->np + k0 + j; if (s < 0) { miss = 1; aZ[k][t] = NADBL; for (k=0; k<narmax; k++) { aZ[kx++][t] = NADBL; } } else { aZ[k][t] = y[s]; if (ainfo->yscale != 1.0 && !na(y[s])) { aZ[k][t] *= ainfo->yscale; } for (k=0; k<narmax; k++) { aZ[kx++][t] = get_xti(dset, k, s, X); } } for (i=0; i<ainfo->p; i++) { if (!AR_included(ainfo, i)) { continue; } s = realt - ((j + 1) * ainfo->pd + (i + 1)); if (s < 0) { miss = 1; aZ[ky++][t] = NADBL; for (k=0; k<narmax; k++) { aZ[kx++][t] = NADBL; } } else { aZ[ky][t] = y[s]; if (ainfo->yscale != 1.0 && !na(y[s])) { aZ[ky][t] *= ainfo->yscale; } ky++; for (k=0; k<narmax; k++) { aZ[kx++][t] = get_xti(dset, k, s, X); } } } } kx = ptotal + k0; for (i=0; i<ainfo->nexo; i++) { aZ[kx++][t] = get_xti(dset, i, realt, X); } if (miss) { aset->t1 = t + 1; } } if (nonlin && arma_missvals(ainfo)) { err = arma_init_add_dummies(ainfo, aset); } if (undo_diff) { arima_difference_undo(ainfo, dset); } #if AINIT_DEBUG fprintf(stderr, "arma init dataset:\n"); for (i=0; i<aset->v; i++) { fprintf(stderr, "var %d '%s', obs[0] = %g\n", i, aset->varname[i], aset->Z[i][0]); } #endif return err; }
static int real_hr_arma_init (double *coeff, const DATASET *dset, arma_info *ainfo, PRN *prn) { const int *list = ainfo->alist; int np = ainfo->p, nq = ainfo->q; int nP = ainfo->P, nQ = ainfo->Q; int ptotal = np + nP + np * nP; int qtotal = nq + nQ + nq * nQ; int nexo = ainfo->nexo; int pass1lags, pass1v; const double *y; DATASET *aset = NULL; int *pass1list = NULL; int *pass2list = NULL; int *arlags = NULL; int *malags = NULL; MODEL armod; int xstart; int m, pos, s; int i, j, t; int err = 0; pass1lags = (ainfo->Q + ainfo->P) * dset->pd; if (pass1lags < HR_MINLAGS) { pass1lags = HR_MINLAGS; } pass1v = pass1lags + nexo + 2; /* dependent variable */ if (arma_xdiff(ainfo)) { /* for initialization, use the level of y */ y = dset->Z[ainfo->yno]; } else { y = ainfo->y; } aset = create_auxiliary_dataset(pass1v + qtotal, ainfo->T, 0); if (aset == NULL) { return E_ALLOC; } #if AINIT_DEBUG fprintf(stderr, "hr_arma_init: dataset allocated: %d vars, %d obs\n", pass1v + qtotal, ainfo->T); #endif /* in case we bomb before estimating a model */ gretl_model_init(&armod, dset); /* Start building stuff for pass 1 */ pass1list = gretl_list_new(pass1v); if (pass1list == NULL) { err = E_ALLOC; goto bailout; } pass1list[1] = 1; pass1list[2] = 0; for (i=2; i<pass1v; i++) { pass1list[i+1] = i; } /* variable names */ strcpy(aset->varname[1], "y"); for (i=0; i<nexo; i++) { /* exogenous vars */ sprintf(aset->varname[i+1], "x%d", i); } for (i=1; i<=pass1lags; i++) { /* lags */ sprintf(aset->varname[i+1+nexo], "y_%d", i); } /* Fill the dataset with the data for pass 1 */ /* starting position for reading exogeneous vars */ if (ainfo->d > 0 || ainfo->D > 0) { xstart = (arma_has_seasonal(ainfo))? 10 : 6; } else { xstart = (arma_has_seasonal(ainfo))? 8 : 5; } for (t=0; t<ainfo->T; t++) { s = t + ainfo->t1; aset->Z[1][t] = y[s]; for (i=0, pos=2; i<nexo; i++) { m = list[xstart + i]; aset->Z[pos++][t] = dset->Z[m][s]; } for (i=1; i<=pass1lags; i++) { s = t + ainfo->t1 - i; aset->Z[pos++][t] = (s >= 0)? y[s] : NADBL; } } /* pass 1 proper */ armod = lsq(pass1list, aset, OLS, OPT_A); if (armod.errcode) { err = armod.errcode; goto bailout; } #if AINIT_DEBUG fprintf(stderr, "pass1 model: t1=%d, t2=%d, nobs=%d, ncoeff=%d, dfd = %d\n", armod.t1, armod.t2, armod.nobs, armod.ncoeff, armod.dfd); #endif /* allocations for pass 2 */ if (qtotal > 0) { malags = malloc(qtotal * sizeof *malags); if (malags == NULL) { err = E_ALLOC; } else { for (i=0, pos=0; i<nq; i++) { malags[pos++] = i+1; } for (i=0; i<ainfo->Q; i++) { for (j=0; j<=nq; j++) { malags[pos++] = (i+1) * dset->pd + j; } } } } if (ptotal > 0 && !err) { arlags = malloc(ptotal * sizeof *arlags); if (arlags == NULL) { err = E_ALLOC; } else { for (i=0, pos=0; i<np; i++) { arlags[pos++] = i+1; } for (i=0; i<ainfo->P; i++) { for (j=0; j<=np; j++) { arlags[pos++] = (i+1) * dset->pd + j; } } } } if (!err) { pass2list = gretl_list_new(2 + nexo + ptotal + qtotal); if (pass2list == NULL) { err = E_ALLOC; } } /* handle error in pass2 allocations */ if (err) { goto bailout; } /* stick lagged residuals into temp dataset */ pos = pass1v; for (i=0; i<qtotal; i++) { sprintf(aset->varname[pos], "e_%d", malags[i]); for (t=0; t<ainfo->T; t++) { s = t - malags[i]; aset->Z[pos][t] = (s >= 0)? armod.uhat[s] : NADBL; } pos++; } /* compose pass 2 regression list */ for (i=1, pos=1; i<=nexo+2; i++) { pass2list[pos++] = pass1list[i]; } for (i=0; i<ptotal; i++) { /* FIXME? */ if (AR_included(ainfo,i)) { pass2list[pos++] = arlags[i] + nexo + 1; } } for (i=0; i<qtotal; i++) { /* FIXME? */ if (MA_included(ainfo,i)) { pass2list[pos++] = pass1v + i; } } /* now do pass2 */ clear_model(&armod); armod = lsq(pass2list, aset, OLS, OPT_A); if (armod.errcode) { err = armod.errcode; } else { #if AINIT_DEBUG PRN *modprn = gretl_print_new(GRETL_PRINT_STDERR, NULL); printmodel(&armod, aset, OPT_S, modprn); gretl_print_destroy(modprn); #endif err = hr_transcribe_coeffs(ainfo, &armod, coeff); if (!err && arma_exact_ml(ainfo) && ainfo->ifc && ainfo->nexo == 0) { transform_arma_const(coeff, ainfo); } } #if AINIT_DEBUG if (!err) { fprintf(stderr, "HR init:\n"); for (i=0; i<ainfo->nc; i++) { fprintf(stderr, "coeff[%d] = %g\n", i, coeff[i]); } } #endif bailout: free(pass1list); free(pass2list); free(arlags); free(malags); destroy_dataset(aset); clear_model(&armod); if (!err && prn != NULL) { pprintf(prn, "\n%s: %s\n\n", _("ARMA initialization"), _("Hannan-Rissanen method")); } return err; }
int arima_difference (arma_info *ainfo, const DATASET *dset, int fullX) { const double *y = dset->Z[ainfo->yno]; double *dy = NULL; int *delta = NULL; int s = ainfo->pd; int k, t, t1 = 0; int err = 0; #if ARMA_DEBUG fprintf(stderr, "doing arima_difference: d = %d, D = %d\n", ainfo->d, ainfo->D); fprintf(stderr, "ainfo->t1 = %d, ainfo->t2 = %d\n", ainfo->t1, ainfo->t2); #endif /* note: dy is a full length series (dset->n) */ dy = malloc(dset->n * sizeof *dy); if (dy == NULL) { return E_ALLOC; } delta = arima_delta_coeffs(ainfo->d, ainfo->D, s); if (delta == NULL) { free(dy); return E_ALLOC; } for (t=0; t<dset->n; t++) { dy[t] = NADBL; } for (t=0; t<dset->n; t++) { if (na(y[t])) { t1++; } else { break; } } t1 += ainfo->d + ainfo->D * s; k = ainfo->d + s * ainfo->D; real_arima_difference_series(dy + t1, y, t1, ainfo->t2, delta, k); #if ARMA_DEBUG > 1 for (t=0; t<dset->n; t++) { fprintf(stderr, "dy[%d] = % 12.7g\n", t, dy[t]); } #endif ainfo->y = dy; set_arima_ydiff(ainfo); if (arma_xdiff(ainfo)) { /* also difference the ARIMAX regressors */ int xt1 = ainfo->t1, xT = ainfo->T; if (fullX) { xt1 = 0; xT = ainfo->t2 + 1; } ainfo->dX = gretl_matrix_alloc(xT, ainfo->nexo); if (ainfo->dX == NULL) { err = E_ALLOC; } else { double *val = ainfo->dX->val; int i, vi; for (i=0; i<ainfo->nexo; i++) { vi = ainfo->xlist[i+1]; real_arima_difference_series(val, dset->Z[vi], xt1, ainfo->t2, delta, k); val += xT; } } } free(delta); return err; }
static int arma_adjust_sample (arma_info *ainfo, const DATASET *dset, int *missv, int *misst) { int *list = ainfo->alist; int ypos = arma_list_y_position(ainfo); int t0, t1 = dset->t1, t2 = dset->t2; int i, vi, vlmax, k, t; int missing; int err = 0; #if ARMA_DEBUG fprintf(stderr, "arma_adjust_sample: at start, t1=%d, t2=%d, maxlag = %d\n", t1, t2, ainfo->maxlag); #endif t0 = t1 - ainfo->maxlag; if (t0 < 0) { t1 -= t0; } /* list position of last var to check for lags */ if (arma_xdiff(ainfo)) { vlmax = list[0]; } else { vlmax = ypos; } /* advance the starting point if need be */ for (t=t1; t<=t2; t++) { missing = 0; for (i=ypos; i<=list[0] && !missing; i++) { vi = list[i]; if (na(dset->Z[vi][t])) { /* current value missing */ missing = 1; } if (i <= vlmax) { for (k=1; k<=ainfo->maxlag && !missing; k++) { if (na(dset->Z[vi][t-k])) { /* lagged value missing */ missing = 1; } } } } if (missing) { t1++; } else { break; } } /* retard the ending point if need be */ for (t=t2; t>=t1; t--) { missing = 0; for (i=ypos; i<=list[0] && !missing; i++) { vi = list[i]; if (na(dset->Z[vi][t])) { missing = 1; } } if (missing) { t2--; } else { break; } } if (t2 < t1) { gretl_errmsg_set(_("No usable data were found")); return E_MISSDATA; } missing = 0; /* check for missing obs within the adjusted sample range */ for (t=t1; t<t2; t++) { int tmiss = 0; for (i=ypos; i<=list[0]; i++) { vi = list[i]; if (na(dset->Z[vi][t])) { if (missv != NULL && misst != NULL && *missv == 0) { /* record info on first missing obs */ *missv = vi; *misst = t + 1; } tmiss = 1; } } if (tmiss) { missing++; } } if (missing > 0 && !arma_na_ok(ainfo)) { err = E_MISSDATA; } if (!err) { ainfo->fullT = t2 - t1 + 1; ainfo->T = ainfo->fullT - missing; if (ainfo->T <= ainfo->nc) { /* insufficient observations */ err = E_DF; } } if (!err) { #if ARMA_DEBUG fprintf(stderr, "arma_adjust_sample: at end, t1=%d, t2=%d\n", t1, t2); #endif ainfo->t1 = t1; ainfo->t2 = t2; } return err; }