static void maybe_resize_vecm_matrices (GRETL_VAR *v)
{
int nc0 = (v->order * v->neqns) + v->ifc + v->jinfo->seasonals;
if (v->xlist != NULL) {
nc0 += v->xlist[0];
}
if (v->detflags & DET_TREND) {
nc0++;
}
if (v->X->cols > nc0) {
/* for stage 1: skip the extra EC-term columns in X */
gretl_matrix_reuse(v->X, -1, nc0);
gretl_matrix_reuse(v->B, nc0, -1);
}
}
static void
duration_overall_LR_test (MODEL *pmod, duration_info *dinfo,
int use_bfgs)
{
double llu = dinfo->ll;
int err = 0;
dinfo->k = 1;
dinfo->npar = 1 + (dinfo->dist != DUR_EXPON);
gretl_matrix_reuse(dinfo->X, -1, dinfo->k);
gretl_matrix_reuse(dinfo->G, -1, dinfo->npar);
gretl_matrix_reuse(dinfo->beta, dinfo->k, 1);
dinfo->flags |= DUR_CONST_ONLY;
err = duration_estimates_init(dinfo);
/* now estimate constant-only model */
if (!err && use_bfgs) {
int maxit, fncount = 0, grcount = 0;
double toler;
BFGS_defaults(&maxit, &toler, DURATION);
err = BFGS_max(dinfo->theta, dinfo->npar, maxit, toler,
&fncount, &grcount, duration_loglik, C_LOGLIK,
duration_score, dinfo, NULL, OPT_NONE, NULL);
} else if (!err) {
double crittol = 1.0e-7;
double gradtol = 1.0e-7;
int iters = 0, maxit = 100;
err = newton_raphson_max(dinfo->theta, dinfo->npar, maxit,
crittol, gradtol, &iters,
C_LOGLIK, duration_loglik,
duration_score, duration_hessian,
dinfo, OPT_NONE, NULL);
}
if (!err && llu > dinfo->ll) {
pmod->chisq = 2 * (llu - dinfo->ll);
}
}
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 gretl_matrix *cluster_vcv_calc (MODEL *pmod,
int cvar,
gretl_matrix *cvals,
gretl_matrix *XX,
const DATASET *dset,
int *err)
{
gretl_matrix *V = NULL;
gretl_matrix *W = NULL;
gretl_matrix *XXW = NULL;
gretl_vector *ei = NULL;
gretl_matrix *Xi = NULL;
gretl_vector *eXi = NULL;
const double *cZ;
int n_c, M, N, k = pmod->ncoeff;
int total_obs = 0;
int i, j, v, t;
cZ = dset->Z[cvar];
N = cval_count_max(pmod, cvals, cZ);
#if CDEBUG
fprintf(stderr, "max cval count = %d\n", N);
#endif
V = gretl_matrix_alloc(k, k);
W = gretl_zero_matrix_new(k, k);
XXW = gretl_zero_matrix_new(k, k);
ei = gretl_column_vector_alloc(N);
Xi = gretl_matrix_alloc(N, k);
eXi = gretl_vector_alloc(k);
if (V == NULL || W == NULL || XXW == NULL ||
ei == NULL || Xi == NULL || eXi == NULL) {
*err = E_ALLOC;
goto bailout;
}
M = gretl_vector_get_length(cvals);
n_c = 0;
for (i=0; i<M; i++) {
double cvi = cvals->val[i];
int Ni = cval_count(pmod, cvi, cZ);
int s = 0;
if (Ni == 0) {
continue;
}
#if CDEBUG
fprintf(stderr, "i=%d, cvi=%g, Ni=%d\n", i, cvi, Ni);
#endif
ei = gretl_matrix_reuse(ei, Ni, -1);
Xi = gretl_matrix_reuse(Xi, Ni, -1);
for (t=pmod->t1; t<=pmod->t2; t++) {
if (!na(pmod->uhat[t]) && cZ[t] == cvi) {
gretl_vector_set(ei, s, pmod->uhat[t]);
for (j=0; j<k; j++) {
v = pmod->list[j+2];
gretl_matrix_set(Xi, s, j, dset->Z[v][t]);
}
s++;
}
if (s == Ni) {
/* we've filled this matrix */
break;
}
}
gretl_matrix_multiply_mod(ei, GRETL_MOD_TRANSPOSE,
Xi, GRETL_MOD_NONE,
eXi, GRETL_MOD_NONE);
gretl_matrix_multiply_mod(eXi, GRETL_MOD_TRANSPOSE,
eXi, GRETL_MOD_NONE,
W, GRETL_MOD_CUMULATE);
#if CDEBUG > 1
gretl_matrix_print(ei, "e(i)");
gretl_matrix_print(Xi, "X(i)");
gretl_matrix_print(W, "W");
#endif
n_c++;
total_obs += s;
}
if (n_c < 2) {
gretl_errmsg_set("Invalid clustering variable");
*err = E_DATA;
goto bailout;
} else if (total_obs < pmod->nobs) {
*err = E_MISSDATA;
goto bailout;
}
/* form V(W) = (X'X)^{-1} W (X'X)^{-1} */
gretl_matrix_multiply(XX, W, XXW);
gretl_matrix_multiply(XXW, XX, V);
gretl_matrix_xtr_symmetric(V);
#if CDEBUG
gretl_matrix_print(XX, "X'X^{-1}");
gretl_matrix_print(W, "W");
gretl_matrix_print(V, "V");
#endif
if (!(pmod->opt & OPT_N)) {
/* apply df adjustment a la Stata */
double dfadj;
N = pmod->nobs;
dfadj = (M/(M-1.0)) * (N-1.0)/(N-k);
gretl_matrix_multiply_by_scalar(V, dfadj);
#if CDEBUG > 1
gretl_matrix_print(V, "V(adjusted)");
#endif
}
bailout:
gretl_matrix_free(W);
gretl_matrix_free(XXW);
gretl_matrix_free(ei);
gretl_matrix_free(Xi);
gretl_matrix_free(eXi);
if (*err) {
gretl_matrix_free(V);
V = NULL;
}
return V;
}
int gretl_qr_regress (MODEL *pmod, DATASET *dset, gretlopt opt)
{
integer T, k;
gretl_matrix *Q = NULL, *y = NULL;
gretl_matrix *R = NULL, *g = NULL, *b = NULL;
gretl_matrix *V = NULL;
int rank, warn = 0, err = 0;
T = pmod->nobs; /* # of rows (observations) */
k = pmod->list[0] - 1; /* # of cols (variables) */
Q = gretl_matrix_alloc(T, k);
R = gretl_matrix_alloc(k, k);
V = gretl_matrix_alloc(k, k);
if (y == NULL) {
y = gretl_matrix_alloc(T, 1);
}
if (Q == NULL || R == NULL || V == NULL || y == NULL) {
err = E_ALLOC;
goto qr_cleanup;
}
get_model_data(pmod, dset, Q, y);
err = QR_decomp_plus(Q, R, &rank, &warn);
/* handling of near-perfect collinearity */
if (err == E_SINGULAR && !(opt & OPT_Z)) {
drop_redundant_vars(pmod, dset, R, rank, opt);
k = pmod->list[0] - 1;
gretl_matrix_reuse(Q, T, k);
gretl_matrix_reuse(R, k, k);
gretl_matrix_reuse(V, k, k);
get_model_data(pmod, dset, Q, y);
err = QR_decomp_plus(Q, R, NULL, &warn);
if (!err) {
maybe_shift_ldepvar(pmod, dset);
}
}
if (err) {
goto qr_cleanup;
}
/* allocate temporary arrays */
g = gretl_matrix_alloc(k, 1);
b = gretl_matrix_alloc(k, 1);
if (g == NULL || b == NULL) {
err = E_ALLOC;
goto qr_cleanup;
}
if (allocate_model_arrays(pmod, k, dset->n)) {
err = E_ALLOC;
goto qr_cleanup;
}
/* make "g" into gamma-hat */
gretl_matrix_multiply_mod(Q, GRETL_MOD_TRANSPOSE,
y, GRETL_MOD_NONE,
g, GRETL_MOD_NONE);
/* OLS coefficients */
gretl_matrix_multiply(R, g, b);
pmod->coeff = gretl_matrix_steal_data(b);
/* write vector of fitted values into y */
gretl_matrix_multiply(Q, g, y);
/* get vector of residuals and SSR */
get_resids_and_SSR(pmod, dset, y, dset->n);
/* standard error of regression */
if (T - k > 0) {
if (pmod->opt & OPT_N) {
/* no-df-corr */
pmod->sigma = sqrt(pmod->ess / T);
} else {
pmod->sigma = sqrt(pmod->ess / (T - k));
}
} else {
pmod->sigma = 0.0;
}
/* create (X'X)^{-1} */
gretl_matrix_multiply_mod(R, GRETL_MOD_NONE,
R, GRETL_MOD_TRANSPOSE,
V, GRETL_MOD_NONE);
/* VCV and standard errors */
if (opt & OPT_R) {
pmod->opt |= OPT_R;
if (opt & OPT_C) {
err = qr_make_cluster_vcv(pmod, OLS, dset, V, opt);
} else if ((opt & OPT_T) && !libset_get_bool(FORCE_HC)) {
err = qr_make_hac(pmod, dset, V);
} else {
err = qr_make_hccme(pmod, dset, Q, V);
}
} else {
err = qr_make_regular_vcv(pmod, V, opt);
}
if (!err) {
/* get R^2, F-stat */
qr_compute_stats(pmod, dset, T, opt);
/* D-W stat and p-value */
if ((opt & OPT_I) && pmod->missmask == NULL) {
qr_dw_stats(pmod, dset, Q, y);
}
/* near-singularity? */
if (warn) {
gretl_model_set_int(pmod, "near-singular", 1);
}
}
qr_cleanup:
gretl_matrix_free(Q);
gretl_matrix_free(R);
gretl_matrix_free(y);
gretl_matrix_free(g);
gretl_matrix_free(b);
gretl_matrix_free(V);
pmod->errcode = err;
return err;
}
static GRETL_VAR *back_up_VAR (const GRETL_VAR *v)
{
GRETL_VAR *vbak;
int err = 0;
vbak = malloc(sizeof *vbak);
if (vbak == NULL) {
return NULL;
}
gretl_VAR_clear(vbak);
clear_gretl_matrix_err();
vbak->Y = gretl_matrix_copy(v->Y);
vbak->B = gretl_matrix_copy(v->B);
if (v->xcols > v->X->cols) {
int save_k = v->X->cols;
gretl_matrix_reuse(v->X, -1, v->xcols);
vbak->X = gretl_matrix_copy(v->X);
gretl_matrix_reuse(vbak->X, -1, save_k);
gretl_matrix_reuse(v->X, -1, save_k);
} else {
vbak->X = gretl_matrix_copy(v->X);
}
vbak->XTX = gretl_matrix_copy(v->XTX);
vbak->A = gretl_matrix_copy(v->A);
vbak->E = gretl_matrix_copy(v->E);
vbak->C = gretl_matrix_copy(v->C);
vbak->S = gretl_matrix_copy(v->S);
err = get_gretl_matrix_err();
if (!err && v->jinfo != NULL) {
vbak->jinfo = malloc(sizeof *vbak->jinfo);
if (vbak->jinfo == NULL) {
err = E_ALLOC;
} else {
vbak->ylist = gretl_list_copy(v->ylist);
if (vbak->ylist == NULL) {
err = E_ALLOC;
}
}
}
if (!err && v->rlist != NULL) {
vbak->rlist = gretl_list_copy(v->rlist);
if (vbak->rlist == NULL) {
err = E_ALLOC;
}
}
if (!err && vbak->jinfo != NULL) {
vbak->jinfo->R0 = gretl_matrix_copy(v->jinfo->R0);
vbak->jinfo->R1 = gretl_matrix_copy(v->jinfo->R1);
vbak->jinfo->S00 = gretl_matrix_copy(v->jinfo->S00);
vbak->jinfo->S11 = gretl_matrix_copy(v->jinfo->S11);
vbak->jinfo->S01 = gretl_matrix_copy(v->jinfo->S01);
vbak->jinfo->Beta = gretl_matrix_copy(v->jinfo->Beta);
vbak->jinfo->Alpha = gretl_matrix_copy(v->jinfo->Alpha);
err = get_gretl_matrix_err();
}
if (err) {
gretl_VAR_free(vbak);
vbak = NULL;
} else {
vbak->T = v->T;
vbak->neqns = v->neqns;
vbak->order = v->order;
}
return vbak;
}
