static int *make_midas_biglist (const int *list,
midas_info *m,
int nmidas)
{
int i, j, nt = 0;
int *biglist = NULL;
if (list != NULL) {
nt = list[0];
}
for (j=0; j<nmidas; j++) {
nt += m[j].nterms;
}
biglist = gretl_list_new(nt);
if (biglist != NULL) {
int k = 1;
if (list != NULL) {
for (i=1; i<=list[0]; i++) {
biglist[k++] = list[i];
}
}
for (j=0; j<nmidas; j++) {
for (i=1; i<=m[j].nterms; i++) {
biglist[k++] = m[j].laglist[i];
}
}
}
return biglist;
}
static int *make_midas_xlist (const int *list,
const DATASET *dset,
int *ldv,
int *err)
{
int i, nx = list[0] - 1;
int xi, yno = list[1];
int *xlist = NULL;
if (nx > 0) {
xlist = gretl_list_new(nx);
if (xlist == NULL) {
*err = E_ALLOC;
} else {
for (i=1; i<=nx; i++) {
xi = list[i+1];
xlist[i] = xi;
if (standard_lag_of(xi, yno, dset) > 0) {
*ldv = 1;
}
}
}
}
return xlist;
}
static int arma_add_xlist (arma_info *ainfo, int ypos)
{
int i, err = 0;
ainfo->xlist = gretl_list_new(ainfo->nexo);
if (ainfo->xlist == NULL) {
err = E_ALLOC;
} else {
for (i=1; i<=ainfo->nexo; i++) {
ainfo->xlist[i] = ainfo->alist[ypos + i];
}
}
return err;
}
static int *arma_info_get_x_list (arma_info *ainfo)
{
int *xlist = NULL;
int start = arma_list_y_position(ainfo);
int i;
xlist = gretl_list_new(ainfo->nexo);
if (xlist != NULL) {
for (i=1; i<=xlist[0]; i++) {
xlist[i] = ainfo->alist[i + start];
}
}
return xlist;
}
static int expand_srclist (int srcv, int lpos, Laginfo *linfo,
const int *cmdlist)
{
int i, n = lpos + 1;
int err = 0;
#if LLDEBUG
printlist(linfo->srclist, "srclist, before expansion");
#endif
if (linfo->srclist == NULL) {
linfo->srclist = gretl_list_new(lpos);
if (linfo->srclist == NULL) {
err = E_ALLOC;
} else {
for (i=1; i<lpos; i++) {
linfo->srclist[i] = cmdlist[i];
}
}
} else {
int m = linfo->srclist[0];
int *tmp = realloc(linfo->srclist, n * sizeof *tmp);
if (tmp == NULL) {
err = E_ALLOC;
} else {
linfo->srclist = tmp;
linfo->srclist[0] = lpos;
for (i=m+1; i<lpos; i++) {
linfo->srclist[i] = cmdlist[i];
}
}
}
if (!err) {
linfo->srclist[lpos] = srcv;
}
#if LLDEBUG
printlist(linfo->srclist, "srclist, after");
#endif
return err;
}
int *series_table_map (series_table *st_from, series_table *st_to)
{
int *map = NULL;
int n = st_from->n_strs;
map = gretl_list_new(n);
if (map != NULL) {
const char *s1;
int i, i2;
for (i=0; i<n; i++) {
s1 = st_from->strs[i];
i2 = series_table_get_index(st_to, s1);
map[i+1] = i2 == 0 ? -1 : i2;
}
}
return map;
}
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;
}
void *gretl_array_get_element (gretl_array *A, int i,
GretlType *type,
int *err)
{
void *ret = NULL;
/* Note that the data returned here are not "deep copied",
we just pass the pointer. It's up to geneval.c to
decide if a copy has to be made, given that the
pointer from here should not be modified.
*/
if (A == NULL || i < 0 || i >= A->n) {
*err = E_DATA;
} else {
*type = gretl_type_get_singular(A->type);
if (A->type == GRETL_TYPE_STRINGS) {
if (A->data[i] == NULL) {
A->data[i] = gretl_strdup("");
}
} else if (A->type == GRETL_TYPE_MATRICES) {
if (A->data[i] == NULL) {
A->data[i] = gretl_null_matrix_new();
}
} else if (A->type == GRETL_TYPE_BUNDLES) {
if (A->data[i] == NULL) {
A->data[i] = gretl_bundle_new();
}
} else {
if (A->data[i] == NULL) {
A->data[i] = gretl_list_new(0);
}
}
ret = A->data[i];
if (ret == NULL) {
*err = E_ALLOC;
}
}
return ret;
}
static int *make_ar_ols_list (arma_info *ainfo, int av)
{
int *list = gretl_list_new(av);
int i, k, vi;
if (list == NULL) {
return NULL;
}
list[1] = 1;
if (ainfo->ifc) {
list[2] = 0;
k = 3;
} else {
list[0] -= 1;
k = 2;
}
/* allow for const and y */
vi = 2;
for (i=0; i<ainfo->p; i++) {
if (AR_included(ainfo, i)) {
list[k++] = vi++;
}
}
for (i=0; i<ainfo->P; i++) {
list[k++] = vi++;
}
for (i=0; i<ainfo->nexo; i++) {
list[k++] = vi++;
}
return list;
}
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 main (void)
{
DATASET *dataset; /* pointer to dataset struct */
int *list; /* list of regressors etc. */
MODEL *model; /* pointer to model struct */
PRN *prn; /* pointer to struct for printing */
int model_count = 0; /* keep a tally of models estimated */
int i; /* index variable */
/* the first data series to load */
double z1[] = {
199.9, 228, 235, 285, 239, 293, 285,
365, 295, 290, 385, 505, 425, 415
};
/* and the second series */
double z2[] = {
1065, 1254, 1300, 1577, 1600, 1750, 1800,
1870, 1935, 1948, 2254, 2600, 2800, 3000
};
/* basic initialization of library */
libgretl_init();
prn = gretl_print_new(GRETL_PRINT_STDOUT, NULL); /* simple printing */
/* allocate the dataset struct: the parameters are the number of
variables (here 3, allowing for the constant in position 0),
the number of observations on each variable (here 14), and
a 0/1 flag indicating whether we want to supply "case marker"
strings for the observations (here we don't).
*/
dataset = create_new_dataset(3, 14, 0);
if (dataset == NULL) noalloc();
/* copy in the names of the variables (starting at [1]
because [0] refers to the constant) */
strcpy(dataset->varname[1], "price");
strcpy(dataset->varname[2], "sqft");
/* Fill in the data array, starting at variable 1. Note that
this array may be a superset of the data actually used in
the regression equation. Note that dataset->n records the
number of observations.
*/
for (i=0; i<dataset->n; i++) {
dset_set_data(dataset, 1, i, z1[i]);
dset_set_data(dataset, 2, i, z2[i]);
}
/* Set up the "list", which is fed to the regression function.
The first element of list represents the length of the list
vector itself, counting from zero. The second entry is the ID
number of the dependent variable (i.e. its place in the data
set Z) counting from one (zero being reserved for the
constant). The third entry (and there can be more) is the ID
number of the first independent variable.
*/
list = gretl_list_new(3); /* number of terms will be 3 */
list[1] = 1; /* the dependent variable is the one with ID# 1 */
list[2] = 0; /* we include a constant (ID# 0) */
list[3] = 2; /* the independent variable has ID# 2 */
/* Now we call the lsq function from libgretl to get least squares
estimates and associated statistics. */
model = gretl_model_new();
if (model == NULL) noalloc();
*model = lsq(list, /* regressand and regressors */
dataset, /* the dataset */
OLS, /* use Ordinary Least Squares */
OPT_NONE /* no special options */
);
/* Handle case where lsq bombed */
if (model->errcode) {
printf("model->errcode: %d\n", model->errcode);
printf("error message: %s\n", gretl_errmsg_get());
return 1;
}
/* Otherwise give this model an ID number for reference */
model->ID = ++model_count;
/* and print the regression results */
printmodel(model, dataset, OPT_NONE, prn);
/* memory management check -- try explicitly freeing all allocated
memory */
gretl_model_free(model);
free(list);
destroy_dataset(dataset);
gretl_print_destroy(prn);
libgretl_cleanup();
return 0;
}
