static int arma_make_masks (arma_info *ainfo)
{
int *plist = NULL, *qlist = NULL;
int err = 0;
if (ainfo->pqspec != NULL) {
if (gretl_list_has_separator(ainfo->pqspec)) {
gretl_list_split_on_separator(ainfo->pqspec, &plist, &qlist);
} else {
plist = gretl_list_copy(ainfo->pqspec);
}
}
if (ainfo->p > 0) {
ainfo->np = ainfo->p;
if (plist != NULL && plist[0] > 0) {
ainfo->pmask = mask_from_list(plist, ainfo, AR_MASK, &err);
}
}
if (ainfo->q > 0 && !err) {
ainfo->nq = ainfo->q;
if (qlist != NULL && qlist[0] > 0) {
ainfo->qmask = mask_from_list(qlist, ainfo, MA_MASK, &err);
}
}
free(plist);
free(qlist);
return err;
}
static int
gretl_array_copy_content (gretl_array *Acpy, const gretl_array *A,
int write_offset)
{
int i, j, err = 0;
for (i=0; i<A->n && !err; i++) {
if (A->data[i] != NULL) {
j = i + write_offset;
if (A->type == GRETL_TYPE_STRINGS) {
Acpy->data[j] = gretl_strdup(A->data[i]);
} else if (A->type == GRETL_TYPE_MATRICES) {
Acpy->data[j] = gretl_matrix_copy(A->data[i]);
} else if (A->type == GRETL_TYPE_BUNDLES) {
Acpy->data[j] = gretl_bundle_copy(A->data[i], &err);
} else {
Acpy->data[j] = gretl_list_copy(A->data[i]);
}
if (Acpy->data[j] == NULL) {
err = E_ALLOC;
}
}
}
return err;
}
static int *make_midas_laglist (midas_info *m,
DATASET *dset,
int *err)
{
int *list = get_list_by_name(m->lname);
if (m->prelag) {
/* don't copy; and don't free either! */
if (list == NULL) {
fprintf(stderr, "make_midas_laglist, prelag: '%s': no list!\n",
m->lname);
*err = E_DATA;
}
return list;
} else {
/* copy, because we're going to modify the list */
int *lcpy = gretl_list_copy(list);
if (lcpy == NULL) {
*err = E_ALLOC;
} else {
*err = list_laggenr(&lcpy, m->minlag, m->maxlag,
NULL, dset, lcpy[0], OPT_L);
}
return lcpy;
}
}
static series_view *series_view_new (int varnum, const int *list)
{
series_view *sview = NULL;
int *svlist = NULL;
if (varnum == 0 && list == NULL) {
return NULL;
}
sview = malloc(sizeof *sview);
if (sview == NULL) {
return NULL;
}
if (list != NULL) {
svlist = gretl_list_copy(list);
if (svlist == NULL) {
free(sview);
sview = NULL;
}
}
if (sview != NULL) {
series_view_init(sview);
sview->varnum = varnum;
sview->list = svlist;
}
return sview;
}
gretl_string_table *gretl_string_table_new (const int *list)
{
gretl_string_table *gst;
int ncols = 0;
int err = 0;
gst = gretl_string_table_alloc();
if (gst == NULL) {
return NULL;
}
if (list != NULL && list[0] > 0) {
gst->cols_list = gretl_list_copy(list);
if (gst->cols_list == NULL) {
err = E_ALLOC;
} else {
ncols = list[0];
}
}
if (ncols > 0) {
gst->cols = malloc(ncols * sizeof *gst->cols);
if (gst->cols == NULL) {
err = E_ALLOC;
} else {
int i, j;
for (i=0; i<ncols && !err; i++) {
gst->cols[i] = series_table_alloc();
if (gst->cols[i] == NULL) {
err = E_ALLOC;
for (j=0; j<i; j++) {
free(gst->cols[j]);
}
free(gst->cols);
}
}
}
}
if (err) {
free(gst->cols_list);
free(gst);
gst = NULL;
}
return gst;
}
static int set_list (gretl_array *A, int i,
int *L, int copy)
{
int err = 0;
if (copy) {
A->data[i] = gretl_list_copy(L);
if (A->data[i] == NULL) {
err = E_ALLOC;
}
} else {
A->data[i] = L;
}
return err;
}
int *series_view_get_list (windata_t *vwin)
{
series_view *sview = vwin->data;
int *list = NULL;
if (sview == NULL) {
return NULL;
}
if (vwin->role == VIEW_SERIES) {
list = gretl_list_new(1);
if (list != NULL) {
list[1] = sview->varnum;
}
} else {
list = gretl_list_copy(sview->list);
}
return list;
}
static int finalize_midas_model (MODEL *pmod,
const int *list,
const char *param,
const DATASET *dset,
midas_info *minfo,
int nmidas,
int *xlist,
int ldepvar,
int hfslopes)
{
int type0, mixed = 0;
int i, err = 0;
gretl_model_set_string_as_data(pmod, "midas_spec",
gretl_strdup(param));
if (pmod->ci == OLS) {
/* @pmod is the result of OLS estimation */
int vi;
gretl_model_allocate_param_names(pmod, pmod->ncoeff);
for (i=0; i<pmod->ncoeff; i++) {
vi = pmod->list[i+2];
gretl_model_set_param_name(pmod, i, dset->varname[vi]);
}
gretl_model_set_int(pmod, "umidas", 1);
} else {
/* @pmod is the result of NLS estimation */
free(pmod->depvar);
pmod->depvar = gretl_strdup(dset->varname[list[1]]);
free(pmod->list);
pmod->list = gretl_list_copy(list);
}
pmod->ci = MIDASREG;
/* record list of low-frequency regressors */
gretl_model_set_list_as_data(pmod, "lfxlist", xlist);
if (ldepvar) {
gretl_model_set_int(pmod, "dynamic", 1);
}
/* record the (common) type of MIDAS term? */
type0 = minfo[0].type;
if (nmidas > 1) {
for (i=1; i<nmidas; i++) {
if (minfo[i].type != type0) {
mixed = 1;
break;
}
}
}
if (!mixed && type0 > 0) {
gretl_model_set_int(pmod, "midas_type", type0);
}
if (nmidas == 1) {
/* Record the "gross" MIDAS coefficients, to enable
drawing of a plot? We'll do this only if we have
a single MIDAS term, which is probably the most
most common case. Otherwise it becomes too hard
to get the plot right.
*/
int nx = list[0] - 1;
const double *b = pmod->coeff + nx;
add_midas_plot_matrix(pmod, &minfo[0], b);
}
if (!err) {
err = model_add_minfo_array(pmod, minfo, nmidas);
}
return err;
}
static GRETL_VAR *back_up_VAR (const GRETL_VAR *v)
{
GRETL_VAR *vbak;
int err = 0;
vbak = malloc(sizeof *vbak);
if (vbak == NULL) {
return NULL;
}
gretl_VAR_clear(vbak);
clear_gretl_matrix_err();
vbak->Y = gretl_matrix_copy(v->Y);
vbak->B = gretl_matrix_copy(v->B);
if (v->xcols > v->X->cols) {
int save_k = v->X->cols;
gretl_matrix_reuse(v->X, -1, v->xcols);
vbak->X = gretl_matrix_copy(v->X);
gretl_matrix_reuse(vbak->X, -1, save_k);
gretl_matrix_reuse(v->X, -1, save_k);
} else {
vbak->X = gretl_matrix_copy(v->X);
}
vbak->XTX = gretl_matrix_copy(v->XTX);
vbak->A = gretl_matrix_copy(v->A);
vbak->E = gretl_matrix_copy(v->E);
vbak->C = gretl_matrix_copy(v->C);
vbak->S = gretl_matrix_copy(v->S);
err = get_gretl_matrix_err();
if (!err && v->jinfo != NULL) {
vbak->jinfo = malloc(sizeof *vbak->jinfo);
if (vbak->jinfo == NULL) {
err = E_ALLOC;
} else {
vbak->ylist = gretl_list_copy(v->ylist);
if (vbak->ylist == NULL) {
err = E_ALLOC;
}
}
}
if (!err && v->rlist != NULL) {
vbak->rlist = gretl_list_copy(v->rlist);
if (vbak->rlist == NULL) {
err = E_ALLOC;
}
}
if (!err && vbak->jinfo != NULL) {
vbak->jinfo->R0 = gretl_matrix_copy(v->jinfo->R0);
vbak->jinfo->R1 = gretl_matrix_copy(v->jinfo->R1);
vbak->jinfo->S00 = gretl_matrix_copy(v->jinfo->S00);
vbak->jinfo->S11 = gretl_matrix_copy(v->jinfo->S11);
vbak->jinfo->S01 = gretl_matrix_copy(v->jinfo->S01);
vbak->jinfo->Beta = gretl_matrix_copy(v->jinfo->Beta);
vbak->jinfo->Alpha = gretl_matrix_copy(v->jinfo->Alpha);
err = get_gretl_matrix_err();
}
if (err) {
gretl_VAR_free(vbak);
vbak = NULL;
} else {
vbak->T = v->T;
vbak->neqns = v->neqns;
vbak->order = v->order;
}
return vbak;
}
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);
}
}
MODEL arma_x12_model (const int *list, const int *pqspec,
const DATASET *dset, int pdmax,
gretlopt opt, PRN *prn)
{
int verbose = (opt & OPT_V);
const char *prog = gretl_x12_arima();
const char *workdir = gretl_x12_arima_dir();
char yname[VNAMELEN], path[MAXLEN];
MODEL armod;
arma_info ainfo_s, *ainfo;
int missv = 0, misst = 0;
#ifdef WIN32
char *cmd;
#endif
int err = 0;
if (dset->t2 < dset->n - 1) {
/* FIXME this is temporary (OPT_F -> generate forecast) */
opt |= OPT_F;
}
ainfo = &ainfo_s;
arma_info_init(ainfo, opt | OPT_X, pqspec, dset);
ainfo->prn = set_up_verbose_printer(opt, prn);
gretl_model_init(&armod, dset);
ainfo->alist = gretl_list_copy(list);
if (ainfo->alist == NULL) {
err = E_ALLOC;
}
if (!err) {
err = arma_check_list(ainfo, dset, opt);
}
if (err) {
armod.errcode = err;
goto bailout;
}
/* calculate maximum lag */
calc_max_lag(ainfo);
x12a_maybe_allow_missvals(ainfo);
/* adjust sample range if need be */
armod.errcode = arma_adjust_sample(ainfo, dset, &missv, &misst);
if (armod.errcode) {
goto bailout;
} else if (missv > 0) {
set_arma_missvals(ainfo);
}
ainfo->y = (double *) dset->Z[ainfo->yno]; /* it's really const */
strcpy(yname, dset->varname[ainfo->yno]);
/* write out an .spc file */
sprintf(path, "%s%c%s.spc", workdir, SLASH, yname);
write_arma_spc_file(path, dset, ainfo, pdmax, opt);
/* remove any files from an old run, in case of error */
delete_old_files(path);
/* run the program */
#ifdef WIN32
cmd = g_strdup_printf("\"%s\" %s -r -p -q", prog, yname);
err = win_run_sync(cmd, workdir);
g_free(cmd);
#else
err = tramo_x12a_spawn(workdir, prog, yname, "-r", "-p", "-q", "-n", NULL);
#endif
if (!err) {
sprintf(path, "%s%c%s", workdir, SLASH, yname);
populate_x12a_arma_model(&armod, path, dset, ainfo);
if (verbose && !armod.errcode) {
print_iterations(path, ainfo->prn);
}
if (!armod.errcode) {
if (gretl_in_gui_mode()) {
add_unique_output_file(&armod, path);
}
gretl_model_set_int(&armod, "arma_flags", (int) ainfo->flags);
}
} else {
armod.errcode = E_UNSPEC;
gretl_errmsg_set(_("Failed to execute x12arima"));
}
if (armod.errcode && ainfo->prn != NULL) {
sprintf(path, "%s%c%s.err", workdir, SLASH, yname);
print_x12a_error_file(path, ainfo->prn);
}
if (ainfo->prn != NULL && ainfo->prn != prn) {
iter_print_callback(0, ainfo->prn);
close_down_verbose_printer(ainfo->prn);
}
bailout:
arma_info_cleanup(ainfo);
return armod;
}
