static int arma_get_nls_model (MODEL *amod, arma_info *ainfo,
int narmax, const double *coeff,
DATASET *dset, PRN *prn)
{
gretlopt nlsopt = OPT_A;
char fnstr[MAXLINE];
char term[32];
nlspec *spec;
double *parms = NULL;
char **pnames = NULL;
double *b0 = NULL, *by1 = NULL;
int nparam, lag;
int i, j, k, err = 0;
spec = nlspec_new(NLS, dset);
if (spec == NULL) {
return E_ALLOC;
}
if (arma_least_squares(ainfo)) {
/* respect verbose option */
if (prn != NULL) {
nlsopt |= OPT_V;
}
} else {
#if AINIT_DEBUG
nlsopt |= OPT_V;
#else
/* don't bother with standard errors */
nlsopt |= OPT_C;
#endif
}
nlspec_set_t1_t2(spec, 0, ainfo->T - 1);
nparam = ainfo->ifc + ainfo->np + ainfo->P + ainfo->nexo;
if (ainfo->misslist != NULL) {
nparam += ainfo->misslist[0];
}
parms = malloc(nparam * sizeof *parms);
if (parms == NULL) {
err = E_ALLOC;
goto bailout;
}
pnames = strings_array_new_with_length(nparam, VNAMELEN);
if (pnames == NULL) {
err = E_ALLOC;
goto bailout;
}
/* make names for the parameters; construct the param list;
and do some rudimentary fall-back initialization */
for (i=0; i<nparam; i++) {
parms[i] = 0.0;
}
k = 0;
if (ainfo->ifc) {
if (coeff != NULL) {
parms[k] = coeff[k];
} else {
parms[k] = gretl_mean(0, dset->n - 1, dset->Z[1]);
}
b0 = &parms[k];
strcpy(pnames[k++], "_b0");
}
for (i=0; i<ainfo->p; i++) {
if (AR_included(ainfo, i)) {
if (by1 == NULL) {
by1 = &parms[k];
if (coeff == NULL) {
parms[k] = 0.1;
}
}
if (coeff != NULL) {
parms[k] = coeff[k];
}
sprintf(pnames[k++], "_phi%d", i+1);
}
}
for (i=0; i<ainfo->P; i++) {
if (by1 == NULL) {
by1 = &parms[k];
if (coeff == NULL) {
parms[k] = 0.1;
}
}
if (coeff != NULL) {
parms[k] = coeff[k];
}
sprintf(pnames[k++], "_Phi%d", i+1);
}
for (i=0; i<ainfo->nexo; i++) {
if (coeff != NULL) {
parms[k] = coeff[k];
}
sprintf(pnames[k++], "_b%d", i+1);
}
if (ainfo->misslist != NULL) {
for (i=1; i<=ainfo->misslist[0]; i++) {
j = ainfo->misslist[i];
parms[k] = dset->Z[1][j];
sprintf(pnames[k++], "_c%d", i);
}
}
/* construct NLS specification string */
strcpy(fnstr, "y=");
if (ainfo->ifc) {
strcat(fnstr, "_b0");
} else {
strcat(fnstr, "0");
}
for (i=0; i<ainfo->p && !err; i++) {
if (AR_included(ainfo, i)) {
lag = i + 1;
sprintf(term, "+_phi%d*", lag);
err = add_to_spec(fnstr, term);
if (!err) {
err = y_Xb_at_lag(fnstr, ainfo, narmax, lag);
}
}
}
for (j=0; j<ainfo->P && !err; j++) {
sprintf(term, "+_Phi%d*", j+1);
strcat(fnstr, term);
lag = (j + 1) * ainfo->pd;
y_Xb_at_lag(fnstr, ainfo, narmax, lag);
for (i=0; i<ainfo->p; i++) {
if (AR_included(ainfo, i)) {
sprintf(term, "-_phi%d*_Phi%d*", i+1, j+1);
err = add_to_spec(fnstr, term);
if (!err) {
lag = (j+1) * ainfo->pd + (i+1);
y_Xb_at_lag(fnstr, ainfo, narmax, lag);
}
}
}
}
for (i=0; i<ainfo->nexo && !err; i++) {
sprintf(term, "+_b%d*x%d", i+1, i+1);
err = add_to_spec(fnstr, term);
}
if (!err && ainfo->misslist != NULL) {
for (i=1; i<=ainfo->misslist[0]; i++) {
sprintf(term, "+_c%d*d%d", i, i);
err = add_to_spec(fnstr, term);
}
}
if (!err) {
if (coeff == NULL) {
nls_kickstart(amod, dset, b0, by1);
}
#if AINIT_DEBUG
fprintf(stderr, "initting using NLS spec:\n %s\n", fnstr);
for (i=0; i<nparam; i++) {
fprintf(stderr, "initial NLS b[%d] = %g (%s)\n",
i, parms[i], pnames[i]);
}
#endif
err = nlspec_set_regression_function(spec, fnstr, dset);
}
if (!err) {
set_auxiliary_scalars();
err = aux_nlspec_add_param_list(spec, nparam, parms, pnames);
if (!err) {
*amod = model_from_nlspec(spec, dset, nlsopt, prn);
err = amod->errcode;
#if AINIT_DEBUG
if (!err) {
printmodel(amod, dset, OPT_NONE, prn);
}
#endif
}
unset_auxiliary_scalars();
}
bailout:
nlspec_destroy(spec);
free(parms);
strings_array_free(pnames, nparam);
return err;
}
void write_arma_model_stats (MODEL *pmod, arma_info *ainfo,
const DATASET *dset)
{
double mean_error;
int do_criteria = 1;
int t;
pmod->ci = ARMA;
ainfo_data_to_model(ainfo, pmod);
free(pmod->list);
pmod->list = gretl_list_copy(ainfo->alist);
if (!arma_least_squares(ainfo)) {
arma_depvar_stats(pmod, ainfo, dset);
}
mean_error = pmod->ess = 0.0;
for (t=pmod->t1; t<=pmod->t2; t++) {
if (!na(ainfo->y[t]) && !na(pmod->uhat[t])) {
#if USE_ARIMA_INTEGRATE == 0
if (arma_is_arima(ainfo) && arima_ydiff(ainfo)) {
pmod->yhat[t] = Z[ainfo->yno][t] - pmod->uhat[t];
}
#else
pmod->yhat[t] = ainfo->y[t] - pmod->uhat[t];
#endif
pmod->ess += pmod->uhat[t] * pmod->uhat[t];
mean_error += pmod->uhat[t];
}
}
#if USE_ARIMA_INTEGRATE
if (arma_is_arima(ainfo) && arima_ydiff(ainfo)) {
arima_integrate(pmod->yhat, dset->Z[ainfo->yno],
pmod->t1, pmod->t2,
ainfo->d, ainfo->D, ainfo->pd);
}
#endif
mean_error /= pmod->nobs;
if (arma_least_squares(ainfo) && pmod->ifc &&
mean_error < 1.0e-15) {
mean_error = 0.0;
}
gretl_model_set_double(pmod, "mean_error", mean_error);
if (na(pmod->sigma)) {
/* in x12a or native exact cases this is already done */
pmod->sigma = sqrt(pmod->ess / pmod->nobs);
}
pmod->rsq = pmod->adjrsq = pmod->fstt = pmod->chisq = NADBL;
pmod->tss = NADBL;
if (arma_least_squares(ainfo)) {
/* not applicable */
do_criteria = 0;
} else if (arma_by_x12a(ainfo) && !na(pmod->criterion[C_AIC])) {
/* already given by x12a */
do_criteria = 0;
}
if (do_criteria) {
mle_criteria(pmod, 1);
}
if (!pmod->errcode && pmod->ncoeff == 0) {
handle_null_model(pmod, ainfo);
}
if (!pmod->errcode) {
gretl_model_add_arma_varnames(pmod, dset, ainfo->yno,
ainfo->p, ainfo->q,
ainfo->pmask, ainfo->qmask,
ainfo->P, ainfo->Q,
ainfo->nexo);
}
}
