int gretl_delete_var_by_name (const char *s, PRN *prn)
{
int err = 0;
if (s == NULL || *s == '\0') {
return E_PARSE;
}
if (object_is_function_arg(s)) {
gretl_errmsg_sprintf(_("The variable %s is read-only"), s);
return E_DATA;
}
if (!strcmp(s, "kalman")) {
err = delete_kalman(prn);
} else if (gretl_is_user_var(s)) {
err = user_var_delete_by_name(s, prn);
} else {
err = maybe_delete_bundle_value(s, prn);
}
return err;
}
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;
}
