static int push_midas_coeff_array (const MODEL *pmod,
const int *xlist,
midas_info *m,
int nmidas)
{
gretl_matrix *hfb;
int i, err;
if (gretl_model_get_int(pmod, "umidas")) {
/* original estimation was U-MIDAS OLS */
int nx = xlist[0];
int nt = pmod->ncoeff - nx;
hfb = gretl_column_vector_alloc(nt);
if (hfb == NULL) {
return E_ALLOC;
}
for (i=0; i<nt; i++) {
hfb->val[i] = pmod->coeff[nx + i];
}
} else {
gretl_matrix *mc =
gretl_model_get_data(pmod, "midas_coeffs");
int j, k, nt = 0;
if (mc == NULL) {
return E_DATA;
}
for (i=0; i<nmidas; i++) {
nt += m[i].nterms;
}
hfb = gretl_column_vector_alloc(nt);
if (hfb == NULL) {
return E_ALLOC;
}
k = 0;
for (i=0; i<nmidas; i++) {
for (j=0; j<m[i].nterms; j++) {
hfb->val[k++] = gretl_matrix_get(mc, j, i);
}
}
}
#if FC_DEBUG
gretl_matrix_print(hfb, "hfb in fcast");
#endif
err = private_matrix_add(hfb, "hfb___");
return err;
}
static void get_resids_and_SSR (MODEL *pmod, const DATASET *dset,
gretl_matrix *yhat, int fulln)
{
int dwt = gretl_model_get_int(pmod, "wt_dummy");
int qdiff = (pmod->rho != 0.0);
int pwe = (pmod->opt & OPT_P);
int yvar = pmod->list[1];
double *u = pmod->uhat;
double y;
int t, i = 0;
if (dwt) {
dwt = pmod->nwt;
}
pmod->ess = 0.0;
if (qdiff) {
for (t=0; t<fulln; t++) {
if (t < pmod->t1 || t > pmod->t2) {
pmod->yhat[t] = u[t] = NADBL;
} else {
y = dset->Z[yvar][t];
if (t == pmod->t1 && pwe) {
y *= sqrt(1.0 - pmod->rho * pmod->rho);
} else {
y -= pmod->rho * dset->Z[yvar][t-1];
}
pmod->yhat[t] = yhat->val[i];
u[t] = y - yhat->val[i];
pmod->ess += u[t] * u[t];
i++;
}
}
} else if (pmod->nwt) {
for (t=0; t<fulln; t++) {
if (t < pmod->t1 || t > pmod->t2 || model_missing(pmod, t)) {
pmod->yhat[t] = u[t] = NADBL;
} else {
y = dset->Z[yvar][t];
if (dwt && dset->Z[dwt][t] == 0.0) {
pmod->yhat[t] = NADBL;
} else {
if (!dwt) {
y *= sqrt(dset->Z[pmod->nwt][t]);
}
pmod->yhat[t] = yhat->val[i];
u[t] = y - yhat->val[i];
pmod->ess += u[t] * u[t];
i++;
}
}
}
} else {
for (t=0; t<fulln; t++) {
if (t < pmod->t1 || t > pmod->t2 || model_missing(pmod, t)) {
pmod->yhat[t] = u[t] = NADBL;
} else {
pmod->yhat[t] = yhat->val[i];
u[t] = dset->Z[yvar][t] - yhat->val[i];
pmod->ess += u[t] * u[t];
i++;
}
}
}
/* if SSR is small enough, treat it as zero */
if (fabs(pmod->ess) < ESSZERO) {
pmod->ess = 0.0;
}
}
static void get_model_data (MODEL *pmod, const DATASET *dset,
gretl_matrix *Q, gretl_matrix *y)
{
int dwt = gretl_model_get_int(pmod, "wt_dummy");
int qdiff = (pmod->rho != 0.0);
int pwe = (pmod->opt & OPT_P);
double x, pw1 = 0.0;
int i, s, t;
if (pmod->missmask == NULL && !pwe && !qdiff && !dwt && !pmod->nwt) {
/* simple case: no missing values and no data transformation
called for, so use faster procedure
*/
int T = pmod->t2 - pmod->t1 + 1;
size_t sz = T * sizeof(double);
s = 0;
for (i=2; i<=pmod->list[0]; i++) {
memcpy(Q->val + s, dset->Z[pmod->list[i]] + pmod->t1, sz);
s += T;
}
if (y != NULL) {
memcpy(y->val, dset->Z[pmod->list[1]] + pmod->t1, sz);
}
return;
}
if (pwe) {
pw1 = sqrt(1.0 - pmod->rho * pmod->rho);
}
if (dwt) {
dwt = pmod->nwt;
}
/* copy independent vars into matrix Q */
s = 0;
for (i=2; i<=pmod->list[0]; i++) {
int vi = pmod->list[i];
for (t=pmod->t1; t<=pmod->t2; t++) {
if (model_missing(pmod, t)) {
continue;
}
x = dset->Z[vi][t];
if (dwt) {
if (dset->Z[dwt][t] == 0.0) continue;
} else if (pmod->nwt) {
x *= sqrt(dset->Z[pmod->nwt][t]);
} else if (qdiff) {
if (pwe && t == pmod->t1) {
x *= pw1;
} else {
x -= pmod->rho * dset->Z[vi][t-1];
}
}
Q->val[s++] = x;
}
}
if (y != NULL) {
/* copy dependent variable into y vector */
int vy = pmod->list[1];
s = 0;
for (t=pmod->t1; t<=pmod->t2; t++) {
if (model_missing(pmod, t)) {
continue;
}
x = dset->Z[vy][t];
if (dwt) {
if (dset->Z[dwt][t] == 0.0) continue;
} else if (pmod->nwt) {
x *= sqrt(dset->Z[pmod->nwt][t]);
} else if (qdiff) {
if (pwe && t == pmod->t1) {
x *= pw1;
} else {
x -= pmod->rho * dset->Z[vy][t-1];
}
}
y->val[s++] = x;
}
}
}
static int real_run_check (int round, PRN *prn)
{
int coeff_acc = 0, sderr_acc = 0, err = 0;
char line[512];
MODEL *pmod = NULL;
pmod = gretl_model_new();
if (pmod == NULL) {
fputs("Out of memory\n", stderr);
return 1;
}
set_tolerance();
catch_arctan();
if (!err) {
err = generate_params(line, round, prn);
}
if (!err) {
catch_log_depvar();
err = nl_parse_line(NLS, tester.model_spec, (const double **) Z,
datainfo, prn);
if (verbose) {
printf("%s\n", tester.model_spec);
}
if (err) {
fprintf(stderr, "%s: ERROR: in nl_parse_line\n '%s'\n",
tester.datname, tester.model_spec);
errmsg(err, prn);
return err;
}
}
if (!err) {
if (use_derivs) {
err = print_derivs(line, prn);
} else {
err = print_params(line, prn);
}
}
if (!err) {
*pmod = nl_model(&Z, datainfo, OPT_NONE, prn);
if (pmod->errcode) {
err = pmod->errcode;
fprintf(stderr, "%s: ERROR: model error %d\n", tester.datname, err);
errmsg(err, prn);
} else {
if (verbose) {
pmod->ID = 0;
printmodel(pmod, datainfo, OPT_NONE, prn);
}
print_tol = gretl_model_get_double(pmod, "tol");
total_iters += gretl_model_get_int(pmod, "iters");
get_accuracy(pmod, &coeff_acc, &sderr_acc);
if (coeff_acc < worst_coeff_acc) {
worst_coeff_acc = coeff_acc;
strcpy(worst_coeff_name, tester.datname);
}
/* Lanczos1 is weird */
if (strcmp(tester.datname, "Lanczos1") &&
sderr_acc < worst_sderr_acc) {
worst_sderr_acc = sderr_acc;
strcpy(worst_sderr_name, tester.datname);
}
}
gretl_model_free(pmod);
pmod = NULL;
}
if (err && !verbose) {
printf(" Estimation failed\n");
}
if (err) {
n_fail++;
} else {
avg_coeff_min += coeff_acc;
avg_sd_min += sderr_acc;
n_ok++;
}
if (!err) {
if (verbose) printf("\n ***\n");
if (coeff_acc >= 6) {
printf(" coefficient accuracy >= %d digits\n", coeff_acc);
} else if (coeff_acc >= MIN_DIGITS) {
printf(" coefficient accuracy >= %d digits\n", coeff_acc);
} else {
printf(" min. coefficient accuracy < %d digits\n", MIN_DIGITS);
}
if (sderr_acc >= 6) {
printf(" stderr accuracy >= %d digits\n", sderr_acc);
} else if (sderr_acc >= MIN_DIGITS) {
printf(" stderr accuracy >= %d digits\n", sderr_acc);
} else {
printf(" min. stderr accuracy < %d digits\n", MIN_DIGITS);
}
}
if (verbose)
printf("Round %d, error code = %d\n", round, err);
return err;
}
