static int LLC_detrend (gretl_matrix *dy)
{
gretl_matrix *X, *b;
int t, T = dy->rows;
int err;
X = gretl_matrix_alloc(T, 2);
b = gretl_matrix_alloc(2, 1);
if (X == NULL || b == NULL) {
err = E_ALLOC;
} else {
for (t=0; t<T; t++) {
gretl_matrix_set(X, t, 0, 1.0);
gretl_matrix_set(X, t, 1, t+1);
}
err = gretl_matrix_ols(dy, X, b, NULL, NULL, NULL);
}
if (!err) {
for (t=0; t<T; t++) {
/* replace with detrended values */
dy->val[t] -= (b->val[0] + b->val[1] * (t+1));
}
}
gretl_matrix_free(X);
gretl_matrix_free(b);
return err;
}
static int duration_estimates_init (duration_info *dinfo)
{
int err = 0;
if (dinfo->flags & DUR_CONST_ONLY) {
dinfo->theta[0] = gretl_vector_mean(dinfo->logt);
} else {
gretl_matrix *b = gretl_matrix_alloc(dinfo->k, 1);
int j;
if (b == NULL) {
return E_ALLOC;
}
err = gretl_matrix_ols(dinfo->logt, dinfo->X, b,
NULL, NULL, NULL);
if (!err) {
for (j=0; j<dinfo->k; j++) {
dinfo->theta[j] = b->val[j];
}
}
gretl_matrix_free(b);
}
if (dinfo->dist != DUR_EXPON) {
dinfo->theta[dinfo->k] = 1.0;
}
return err;
}
int real_levin_lin (int vnum, const int *plist, DATASET *dset,
gretlopt opt, PRN *prn)
{
int u0 = dset->t1 / dset->pd;
int uN = dset->t2 / dset->pd;
int N = uN - u0 + 1; /* units in sample range */
gretl_matrix_block *B;
gretl_matrix *y, *yavg, *b;
gretl_matrix *dy, *X, *ui;
gretl_matrix *e, *ei, *v, *vi;
gretl_matrix *eps;
double pbar, SN = 0;
int t, t1, t2, T, NT;
int s, pt1, pt2, dyT;
int i, j, k, K, m;
int p, pmax, pmin;
int bigrow, p_varies = 0;
int err;
err = LLC_check_plist(plist, N, &pmax, &pmin, &pbar);
if (err) {
return err;
}
/* the 'case' (1 = no const, 2 = const, 3 = const + trend */
m = 2; /* the default */
if (opt & OPT_N) {
/* --nc */
m = 1;
} else if (opt & OPT_T) {
/* --ct */
m = 3;
}
/* does p vary by individual? */
if (pmax > pmin) {
p_varies = 1;
}
p = pmax;
/* the max number of regressors */
k = m + pmax;
t1 = t2 = 0;
/* check that we have a useable common sample */
for (i=0; i<N && !err; i++) {
int pt1 = (i + u0) * dset->pd;
int t1i, t2i;
dset->t1 = pt1;
dset->t2 = dset->t1 + dset->pd - 1;
err = series_adjust_sample(dset->Z[vnum], &dset->t1, &dset->t2);
t1i = dset->t1 - pt1;
t2i = dset->t2 - pt1;
if (i == 0) {
t1 = t1i;
t2 = t2i;
} else if (t1i != t1 || t2i != t2) {
err = E_MISSDATA;
break;
}
}
if (!err) {
err = LLC_sample_check(N, t1, t2, m, plist, &NT);
}
if (!err) {
int Tbar = NT / N;
/* the biggest T we'll need for regressions */
T = t2 - t1 + 1 - (1 + pmin);
/* Bartlett lag truncation (Andrews, 1991) */
K = (int) floor(3.21 * pow(Tbar, 1.0/3));
if (K > Tbar - 3) {
K = Tbar - 3;
}
/* full length of dy vector */
dyT = t2 - t1;
B = gretl_matrix_block_new(&y, T, 1,
&yavg, T+1+p, 1,
&dy, dyT, 1,
&X, T, k,
&b, k, 1,
&ui, T, 1,
&ei, T, 1,
&vi, T, 1,
&e, NT, 1,
&v, NT, 1,
&eps, NT, 1,
NULL);
if (B == NULL) {
err = E_ALLOC;
}
}
if (err) {
return err;
}
if (m > 1) {
/* constant in first column, if wanted */
for (t=0; t<T; t++) {
gretl_matrix_set(X, t, 0, 1.0);
}
}
if (m == 3) {
/* trend in second column, if wanted */
for (t=0; t<T; t++) {
gretl_matrix_set(X, t, 1, t+1);
}
}
gretl_matrix_zero(yavg);
/* compute period sums of y for time-demeaning */
for (i=0; i<N; i++) {
pt1 = t1 + (i + u0) * dset->pd;
pt2 = t2 + (i + u0) * dset->pd;
s = 0;
for (t=pt1; t<=pt2; t++) {
yavg->val[s++] += dset->Z[vnum][t];
}
}
gretl_matrix_divide_by_scalar(yavg, N);
bigrow = 0;
for (i=0; i<N && !err; i++) {
double yti, yti_1;
int p_i, T_i, k_i;
int pt0, ss;
if (p_varies) {
p_i = plist[i+1];
T_i = t2 - t1 + 1 - (1 + p_i);
k_i = m + p_i;
gretl_matrix_reuse(y, T_i, 1);
gretl_matrix_reuse(X, T_i, k_i);
gretl_matrix_reuse(b, k_i, 1);
gretl_matrix_reuse(ei, T_i, 1);
gretl_matrix_reuse(vi, T_i, 1);
} else {
p_i = p;
T_i = T;
k_i = k;
}
/* indices into Z array */
pt1 = t1 + (i + u0) * dset->pd;
pt2 = t2 + (i + u0) * dset->pd;
pt0 = pt1 + 1 + p_i;
/* build (full length) \delta y_t in dy */
s = 0;
for (t=pt1+1; t<=pt2; t++) {
ss = t - pt1;
yti = dset->Z[vnum][t] - gretl_vector_get(yavg, ss);
yti_1 = dset->Z[vnum][t-1] - gretl_vector_get(yavg, ss-1);
gretl_vector_set(dy, s++, yti - yti_1);
}
/* build y_{t-1} in y */
s = 0;
for (t=pt0; t<=pt2; t++) {
yti_1 = dset->Z[vnum][t-1] - gretl_vector_get(yavg, t - pt1 - 1);
gretl_vector_set(y, s++, yti_1);
}
/* augmented case: write lags of dy into X */
for (j=1; j<=p_i; j++) {
int col = m + j - 2;
double dylag;
s = 0;
for (t=pt0; t<=pt2; t++) {
dylag = gretl_vector_get(dy, t - pt1 - 1 - j);
gretl_matrix_set(X, s++, col, dylag);
}
}
/* set lagged y as last regressor */
for (t=0; t<T_i; t++) {
gretl_matrix_set(X, t, k_i - 1, y->val[t]);
}
#if LLC_DEBUG > 1
gretl_matrix_print(dy, "dy");
gretl_matrix_print(y, "y1");
gretl_matrix_print(X, "X");
#endif
if (p_i > 0) {
/* "virtual trimming" of dy for regressions */
dy->val += p_i;
dy->rows -= p_i;
}
/* run (A)DF regression */
err = gretl_matrix_ols(dy, X, b, NULL, ui, NULL);
if (err) {
break;
}
if (k_i > 1) {
/* reduced regressor matrix for auxiliary regressions:
omit the last column containing the lagged level of y
*/
gretl_matrix_reuse(X, T_i, k_i - 1);
gretl_matrix_reuse(b, k_i - 1, 1);
err = gretl_matrix_ols(dy, X, b, NULL, ei, NULL);
if (!err) {
err = gretl_matrix_ols(y, X, b, NULL, vi, NULL);
}
gretl_matrix_reuse(X, T, k);
gretl_matrix_reuse(b, k, 1);
} else {
/* no auxiliary regressions required */
gretl_matrix_copy_values(ei, dy);
gretl_matrix_copy_values(vi, y);
}
if (p_i > 0) {
/* restore dy to full length */
dy->val -= p_i;
dy->rows += p_i;
}
if (!err) {
double sui, s2yi, s2ui = 0.0;
for (t=0; t<T_i; t++) {
s2ui += ui->val[t] * ui->val[t];
}
s2ui /= (T_i - 1);
sui = sqrt(s2ui);
/* write normalized per-unit ei and vi into big matrices */
gretl_matrix_divide_by_scalar(ei, sui);
gretl_matrix_divide_by_scalar(vi, sui);
gretl_matrix_inscribe_matrix(e, ei, bigrow, 0, GRETL_MOD_NONE);
gretl_matrix_inscribe_matrix(v, vi, bigrow, 0, GRETL_MOD_NONE);
bigrow += T_i;
s2yi = LLC_lrvar(dy, K, m, &err);
if (!err) {
/* cumulate ratio of LR std dev to innovation std dev */
SN += sqrt(s2yi) / sui;
}
#if LLC_DEBUG
pprintf(prn, "s2ui = %.8f, s2yi = %.8f\n", s2ui, s2yi);
#endif
}
if (p_varies) {
gretl_matrix_reuse(y, T, 1);
gretl_matrix_reuse(X, T, k);
gretl_matrix_reuse(b, k, 1);
gretl_matrix_reuse(ei, T, 1);
gretl_matrix_reuse(vi, T, 1);
}
}
if (!err) {
/* the final step: full-length regression of e on v */
double ee = 0, vv = 0;
double delta, s2e, STD, td;
double mstar, sstar;
gretl_matrix_reuse(b, 1, 1);
err = gretl_matrix_ols(e, v, b, NULL, eps, NULL);
if (!err) {
for (t=0; t<NT; t++) {
ee += eps->val[t] * eps->val[t];
vv += v->val[t] * v->val[t];
}
SN /= N;
delta = b->val[0];
s2e = ee / NT;
STD = sqrt(s2e) / sqrt(vv);
td = delta / STD;
/* fetch the Levin-Lin-Chu corrections factors */
err = get_LLC_corrections(T, m, &mstar, &sstar);
}
if (!err) {
double z = (td - NT * (SN / s2e) * STD * mstar) / sstar;
double pval = normal_cdf(z);
#if LLC_DEBUG
pprintf(prn, "mustar = %g, sigstar = %g\n", mstar, sstar);
pprintf(prn, "SN = %g, se = %g, STD = %g\n", SN, sqrt(s2e), STD);
#endif
if (!(opt & OPT_Q)) {
const char *heads[] = {
N_("coefficient"),
N_("t-ratio"),
N_("z-score")
};
const char *s = dset->varname[vnum];
char NTstr[32];
int sp[3] = {0, 3, 5};
int w[3] = {4, 6, 0};
pputc(prn, '\n');
pprintf(prn, _("Levin-Lin-Chu pooled ADF test for %s\n"), s);
pprintf(prn, "%s ", _(DF_test_spec(m)));
if (p_varies) {
pprintf(prn, _("including %.2f lags of (1-L)%s (average)"), pbar, s);
} else if (p == 1) {
pprintf(prn, _("including one lag of (1-L)%s"), s);
} else {
pprintf(prn, _("including %d lags of (1-L)%s"), p, s);
}
pputc(prn, '\n');
pprintf(prn, _("Bartlett truncation at %d lags\n"), K);
sprintf(NTstr, "N,T = (%d,%d)", N, dyT + 1);
pprintf(prn, _("%s, using %d observations"), NTstr, NT);
pputs(prn, "\n\n");
for (i=0; i<3; i++) {
pputs(prn, _(heads[i]));
bufspace(w[i], prn);
w[i] = sp[i] + g_utf8_strlen(_(heads[i]), -1);
}
pputc(prn, '\n');
pprintf(prn, "%*.5g %*.3f %*.6g [%.4f]\n\n",
w[0], delta, w[1], td, w[2], z, pval);
}
record_test_result(z, pval, "Levin-Lin-Chu");
}
}
gretl_matrix_block_destroy(B);
return err;
}
static int add_midas_matrices (int yno,
const int *xlist,
const DATASET *dset,
midas_info *minfo,
int nmidas,
int *pslopes)
{
gretl_matrix *X = NULL;
gretl_matrix *y = NULL;
gretl_matrix *b = NULL;
gretl_matrix *c = NULL;
int hfslopes = 0;
int init_err = 0;
int i, T, nx = 0;
int err = 0;
T = sample_size(dset);
if (xlist != NULL) {
nx = xlist[0];
X = gretl_matrix_data_subset(xlist, dset,
dset->t1, dset->t2,
M_MISSING_ERROR,
&err);
if (!err) {
err = private_matrix_add(X, "MX___");
}
if (!err) {
b = gretl_zero_matrix_new(nx, 1);
if (b!= NULL) {
err = private_matrix_add(b, "bx___");
} else {
err = E_ALLOC;
}
}
}
if (!err) {
/* for initialization only */
y = gretl_column_vector_alloc(T);
if (y != NULL) {
memcpy(y->val, dset->Z[yno] + dset->t1,
T * sizeof(double));
} else {
init_err = 1;
}
}
if (!err) {
/* count the HF slope coeffs */
for (i=0; i<nmidas && !err; i++) {
if (takes_coeff(minfo[i].type)) {
hfslopes++;
}
}
/* "full-length" coeff vector */
c = gretl_zero_matrix_new(nx + hfslopes, 1);
if (c == NULL) {
init_err = 1;
}
}
if (!err && !init_err) {
gretl_matrix *XZ = NULL;
if (hfslopes > 0) {
XZ = build_XZ(X, dset, minfo, T, nmidas, hfslopes);
if (XZ == NULL) {
/* fallback, ignoring "Z" */
c->rows = nx;
}
}
if (XZ != NULL) {
init_err = gretl_matrix_ols(y, XZ, c, NULL,
NULL, NULL);
} else {
init_err = gretl_matrix_ols(y, X, c, NULL,
NULL, NULL);
}
gretl_matrix_free(XZ);
}
#if MIDAS_DEBUG
if (!err && !init_err) {
gretl_matrix_print(c, "MIDAS OLS initialization");
}
#endif
if (!err) {
if (!init_err) {
/* initialize X coeffs from OLS */
for (i=0; i<nx; i++) {
b->val[i] = c->val[i];
}
}
if (hfslopes > 0) {
/* initialize hf slopes, with fallback to zero */
int use_c = !init_err && c->rows > nx;
char tmp[16];
double bzi;
for (i=0; i<nmidas && !err; i++) {
if (takes_coeff(minfo[i].type)) {
sprintf(tmp, "bmlc___%d", i+1);
bzi = use_c ? c->val[nx+i] : 0.0;
err = private_scalar_add(bzi, tmp);
}
}
}
}
gretl_matrix_free(y);
gretl_matrix_free(c);
/* we're finished with the per-term laglists now */
for (i=0; i<nmidas; i++) {
if (!minfo[i].prelag) {
free(minfo[i].laglist);
}
minfo[i].laglist = NULL;
}
#if MIDAS_DEBUG
fprintf(stderr, "add_midas_matrices: returning %d\n", err);
#endif
*pslopes = hfslopes;
return err;
}
