MODEL tobit_driver (const int *list, DATASET *dset,
gretlopt opt, PRN *prn)
{
MODEL model;
double llim = -1.0e300;
double rlim = NADBL;
int err = 0;
if (opt & OPT_L) {
/* we should have an explicit lower limit */
llim = get_optval_double(TOBIT, OPT_L);
if (na(llim)) {
err = E_BADOPT;
}
}
if (!err && (opt & OPT_M)) {
/* we should have an explicit upper limit */
rlim = get_optval_double(TOBIT, OPT_M);
if (na(rlim) || rlim <= llim) {
err = E_BADOPT;
}
}
if (err) {
gretl_model_init(&model, dset);
model.errcode = err;
return model;
}
if (!(opt & (OPT_L | OPT_M))) {
/* the default: left-censoring at zero */
llim = 0;
}
return tobit_model(list, llim, rlim, dset, opt, prn);
}
MODEL quantreg_driver (const char *parm, const int *list,
DATASET *dset, gretlopt opt, PRN *prn)
{
gretl_vector *tau;
MODEL mod;
int err = 0;
tau = generate_matrix(parm, dset, &err);
if (!err && gretl_vector_get_length(tau) == 0) {
err = E_DATA;
}
if (err) {
gretl_model_init(&mod, dset);
mod.errcode = err;
} else {
mod = quantreg(tau, list, dset, opt, prn);
}
gretl_matrix_free(tau);
return mod;
}
MODEL midas_model (const int *list,
const char *param,
DATASET *dset,
gretlopt opt,
PRN *prn)
{
midas_info *minfo = NULL;
char tmp[64];
int *xlist = NULL;
int i, nmidas = 0;
int ldepvar = 0;
int hfslopes = 0;
int origv = dset->v;
int save_t1 = dset->t1;
int save_t2 = dset->t2;
int use_ols = 0;
MODEL mod;
int err = 0;
gretl_model_init(&mod, dset);
if (param == NULL || *param == '\0') {
err = E_DATA;
} else {
err = parse_midas_specs(param, dset, &minfo,
&nmidas, &use_ols);
}
if (!err) {
/* build list of regular regressors */
xlist = make_midas_xlist(list, dset, &ldepvar, &err);
if (xlist != NULL) {
err = remember_list(xlist, "XL___", NULL);
user_var_privatize_by_name("XL___");
}
}
if (!err) {
/* build (or just read) MIDAS lag-lists */
err = make_midas_laglists(minfo, nmidas, dset);
}
if (!err && use_ols) {
err = umidas_ols(&mod, list, dset, minfo, nmidas, opt);
#if MIDAS_DEBUG
fputs("*** U-MIDAS via OLS ***\n", stderr);
#endif
goto umidas_finish;
}
if (!err) {
/* determine usable sample range */
err = midas_set_sample(list, dset, minfo, nmidas);
}
if (!err) {
/* add the required matrices */
err = add_midas_matrices(list[1], xlist, dset, minfo,
nmidas, &hfslopes);
}
#if MIDAS_DEBUG
fputs("*** MIDAS via NLS ***\n\n", stderr);
#endif
if (!err) {
char line[MAXLEN];
int j = 0;
/* initial "nls" line */
sprintf(line, "nls %s = ", dset->varname[list[1]]);
if (xlist != NULL) {
strcat(line, "lincomb(XL___, bx___)");
}
for (i=0; i<nmidas; i++) {
if (takes_coeff(minfo[i].type)) {
sprintf(tmp, " + bmlc___%d*mlc___%d", ++j, i+1);
} else {
sprintf(tmp, " + mlc___%d", i+1);
}
strcat(line, tmp);
}
err = put_midas_nls_line(line, dset, prn);
/* MIDAS series and gradient matrices */
for (i=0; i<nmidas && !err; i++) {
if (minfo[i].type == MIDAS_U) {
sprintf(line, "series mlc___%d = lincomb(%s, %s)",
i+1, minfo[i].lname, minfo[i].mname);
} else {
sprintf(line, "series mlc___%d = mlincomb(%s, %s, %d)",
i+1, minfo[i].lname, minfo[i].mname,
minfo[i].type);
}
err = put_midas_nls_line(line, dset, prn);
if (!err && minfo[i].type != MIDAS_U) {
sprintf(line, "matrix mgr___%d = mgradient(%d, %s, %d)",
i+1, minfo[i].nterms, minfo[i].mname, minfo[i].type);
err = put_midas_nls_line(line, dset, prn);
}
}
/* derivatives */
if (!err && xlist != NULL) {
strcpy(line, "deriv bx___ = MX___");
err = put_midas_nls_line(line, dset, prn);
}
for (i=0; i<nmidas && !err; i++) {
if (takes_coeff(minfo[i].type)) {
sprintf(line, "deriv bmlc___%d = {mlc___%d}", i+1, i+1);
err = put_midas_nls_line(line, dset, prn);
}
if (!err) {
if (takes_coeff(minfo[i].type)) {
sprintf(line, "deriv %s = bmlc___%d * {%s} * mgr___%d",
minfo[i].mname, i+1, minfo[i].lname, i+1);
} else if (minfo[i].type == MIDAS_ALMONP) {
sprintf(line, "deriv %s = {%s} * mgr___%d",
minfo[i].mname, minfo[i].lname, i+1);
} else {
sprintf(line, "deriv %s = {%s}", minfo[i].mname,
minfo[i].lname);
}
err = put_midas_nls_line(line, dset, prn);
}
}
/* parameter names */
if (!err) {
strcpy(line, "param_names \"");
if (xlist != NULL) {
for (i=1; i<=xlist[0]; i++) {
strcpy(tmp, dset->varname[xlist[i]]);
append_pname(line, tmp);
}
}
for (i=0; i<nmidas && !err; i++) {
if (takes_coeff(minfo[i].type)) {
if (hfslopes > 1) {
sprintf(tmp, "HF_slope%d", i+1);
} else {
strcpy(tmp, "HF_slope");
}
append_pname(line, tmp);
}
for (j=0; j<minfo[i].nparm; j++) {
make_pname(tmp, &minfo[i], j, dset);
append_pname(line, tmp);
}
}
strcat(line, "\"");
err = put_midas_nls_line(line, dset, prn);
}
}
#if MIDAS_DEBUG
fputc('\n', stderr);
#endif
if (!err) {
mod = nl_model(dset, (opt | OPT_G | OPT_M), prn);
}
umidas_finish:
dset->t1 = save_t1;
dset->t2 = save_t2;
for (i=0; i<nmidas; i++) {
if (!minfo[i].prelag) {
user_var_delete_by_name(minfo[i].lname, NULL);
}
if (minfo[i].type != MIDAS_U) {
sprintf(tmp, "mgr___%d", i+1);
user_var_delete_by_name(tmp, NULL);
}
}
if (err && !mod.errcode) {
mod.errcode = err;
}
if (!mod.errcode) {
finalize_midas_model(&mod, list, param, dset,
minfo, nmidas, xlist,
ldepvar, hfslopes);
} else {
free(xlist);
}
destroy_private_uvars();
free(minfo);
if (dset->v > origv) {
/* or maybe not? */
dataset_drop_last_variables(dset, dset->v - origv);
}
return mod;
}
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 ar_arma_init (double *coeff, const DATASET *dset,
arma_info *ainfo, MODEL *pmod)
{
PRN *prn = ainfo->prn;
int *list = ainfo->alist;
int nmixed = ainfo->np * ainfo->P;
int ptotal = ainfo->np + ainfo->P + nmixed;
int av = ptotal + ainfo->nexo + 2;
DATASET *aset = NULL;
int *arlist = NULL;
MODEL armod;
int narmax, nonlin = 0;
int i, err = 0;
#if AINIT_DEBUG
fprintf(stderr, "ar_arma_init: dset->t1=%d, dset->t2=%d (dset->n=%d);\n"
" ainfo->t1=%d, ainfo->t2=%d, ",
dset->t1, dset->t2, dset->n, ainfo->t1, ainfo->t2);
fprintf(stderr, "nmixed = %d, ptotal = %d, ifc = %d, nexo = %d\n",
nmixed, ptotal, ainfo->ifc, ainfo->nexo);
#endif
if (ptotal == 0 && ainfo->nexo == 0 && !ainfo->ifc) {
/* special case of pure MA model */
for (i=0; i<ainfo->nq + ainfo->Q; i++) {
coeff[i] = 0.0001;
}
pprintf(ainfo->prn, "\n%s: %s\n\n", _("ARMA initialization"),
_("small MA values"));
return 0;
}
gretl_model_init(&armod, dset);
narmax = arma_exact_ml(ainfo) ? ainfo->nexo : 0;
if (narmax > 0 && ptotal > 0) {
/* ARMAX-induced lags of exog vars */
av += ainfo->nexo * ptotal;
}
if (arma_exact_ml(ainfo) && ainfo->ifc) {
maybe_set_yscale(ainfo);
}
aset = create_auxiliary_dataset(av, ainfo->fullT, 0);
if (aset == NULL) {
return E_ALLOC;
}
if (ptotal > 0 && (narmax > 0 || nmixed > 0)) {
/* we'll have to use NLS */
nonlin = 1;
} else {
/* OLS: need regression list */
arlist = make_ar_ols_list(ainfo, av);
}
/* build temporary dataset, dset -> aset */
arma_init_build_dataset(ainfo, ptotal, narmax, list,
dset, aset, nonlin);
if (nonlin) {
PRN *dprn = NULL;
#if AINIT_DEBUG
fprintf(stderr, "arma:_init_by_ls: doing NLS\n");
dprn = prn;
#endif
err = arma_get_nls_model(&armod, ainfo, narmax, NULL, aset,
dprn);
} else {
#if AINIT_DEBUG
printlist(arlist, "'arlist' in ar_arma_init (OLS)");
#endif
armod = lsq(arlist, aset, OLS, OPT_A | OPT_Z);
err = armod.errcode;
}
#if AINIT_DEBUG
if (!err) {
pputs(prn, "\n*** armod, in ar_arma_init\n");
printmodel(&armod, aset, OPT_NONE, prn);
} else {
fprintf(stderr, "LS init: armod.errcode = %d\n", err);
}
#endif
if (!err) {
arma_init_transcribe_coeffs(ainfo, &armod, coeff);
}
/* handle the case where we need to translate from an
estimate of the regression constant to the
unconditional mean of y_t
*/
if (!err && arma_exact_ml(ainfo) && ainfo->ifc &&
(!nonlin || ainfo->nexo == 0)) {
transform_arma_const(coeff, ainfo);
}
if (!err && prn != NULL) {
if (nonlin) {
pprintf(prn, "\n%s: %s\n\n", _("ARMA initialization"),
_("using nonlinear AR model"));
} else {
pprintf(prn, "\n%s: %s\n\n", _("ARMA initialization"),
_("using linear AR model"));
}
}
/* clean up */
clear_model(&armod);
free(arlist);
destroy_dataset(aset);
return err;
}
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;
}