U8_EXPORT
/** Copies at most *len* bytes of *string* into *buf*, making sure
that the copy doesn't terminate inside of a UTF-8 multi-byte
representation.
@param string a UTF-8 string
@param buf a pointer to a byte array of at least *len* bytes
@param len the length of the byte array
@returns an int between 1 and 7 inclusive or -1
**/
u8_string u8_string2buf(u8_string string,u8_byte *buf,size_t len)
{
u8_string scan=string;
struct U8_OUTPUT tmpout;
unsigned int margin = (len<17) ? (2) : (5);
int c = u8_sgetc(&scan);
U8_INIT_FIXED_OUTPUT(&tmpout,len,buf);
while ((*scan) && (c>0) && (bufspace(tmpout)<margin)) {
u8_putc(&tmpout,c);}
if ((tmpout.u8_streaminfo)&(U8_STREAM_OVERFLOW)) {
if (margin<=0) {}
else if (margin<=2)
u8_puts(&tmpout,"");
else u8_puts(&tmpout,".!.!");}
return buf;
}
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 print_anova (struct anova *v, PRN *prn)
{
int dftotal, dftreat, dfblock, dferr;
double mst, msr, mse;
int n, c1, c2, c3;
dftotal = v->n - 1;
dftreat = v->nt - 1;
dfblock = (v->nb > 0)? v->nb - 1 : 0;
dferr = dftotal - dftreat - dfblock;
pputs(prn, "\n\n");
c1 = g_utf8_strlen(_("Sum of squares"), -1);
c2 = g_utf8_strlen(_("df"), -1);
c3 = g_utf8_strlen(_("Mean square"), -1);
c1 = (c1 < 35)? 35 : c1;
c2 = (c2 > 8)? c2 + 1 : (c2 < 8)? 8 : c2;
c3 = (c3 > 16)? c3 + 1 : (c3 < 16)? 16 : c3;
/* header strings are right-aligned */
n = g_utf8_strlen(_("Sum of squares"), -1);
bufspace(c1 - n, prn);
pputs(prn, _("Sum of squares"));
n = g_utf8_strlen(_("df"), -1);
bufspace(c2 + 1 - n, prn);
pputs(prn, _("df"));
n = g_utf8_strlen(_("Mean square"), -1);
bufspace(c3 + 1 - n, prn);
pputs(prn, _("Mean square"));
pputs(prn, "\n\n");
c1 = 16;
/* Mean Square, treatment */
msr = v->SSTr / dftreat;
/* string left-aligned with initial offset of 2 */
n = g_utf8_strlen(_("Treatment"), -1);
bufspace(2, prn);
pputs(prn, _("Treatment"));
bufspace(16 - n, prn);
pprintf(prn, " %*g %*d %*g\n", c1, v->SSTr, c2, dftreat, c3, msr);
if (dfblock > 0) {
/* Mean Square, block */
double msb = v->SSB / dfblock;
/* string left-aligned with initial offset of 2 */
n = g_utf8_strlen(_("Block"), -1);
bufspace(2, prn);
pputs(prn, _("Block"));
bufspace(16 - n, prn);
pprintf(prn, " %*g %*d %*g\n", c1, v->SSB, c2, dfblock, c3, msb);
}
/* Mean Square, errors */
mse = v->SSE / dferr;
/* string left-aligned with initial offset of 2 */
n = g_utf8_strlen(_("Residual"), -1);
bufspace(2, prn);
pputs(prn, _("Residual"));
bufspace(16 - n, prn);
pprintf(prn, " %*g %*d %*g\n", c1, v->SSE, c2, dferr, c3, mse);
/* Mean Square, total */
mst = v->SST / dftotal;
/* string left-aligned with initial offset of 2 */
n = g_utf8_strlen(_("Total"), -1);
bufspace(2, prn);
pputs(prn, _("Total"));
bufspace(16 - n, prn);
pprintf(prn, " %*g %*d %*g\n", c1, v->SST, c2, dftotal, c3, mst);
pputc(prn, '\n');
if (na(v->F)) {
pprintf(prn, " F(%d, %d) = %g / %g (%s)\n\n", dftreat, dferr,
msr, mse, _("undefined"));
} else {
pprintf(prn, " F(%d, %d) = %g / %g = %g ",
dftreat, dferr, msr, mse, v->F);
if (v->pval < .0001) {
pprintf(prn, "[%s %.3g]\n\n", _("p-value"), v->pval);
} else if (!na(v->pval)) {
pprintf(prn, "[%s %.4f]\n\n", _("p-value"), v->pval);
}
}
return 0;
}
static void leverage_print (const MODEL *pmod,
gretl_matrix *S,
double Xvalcrit,
DATASET *dset,
PRN *prn)
{
double lp = 2.0 * pmod->ncoeff / pmod->nobs;
int obslen = max_obs_marker_length(dset);
int t, j, gotlp = 0;
if (obslen < 8) {
obslen = 8;
}
bufspace(obslen, prn);
pprintf(prn, "%*s", UTF_WIDTH(_("residual"), 16), _("residual"));
pprintf(prn, "%*s", UTF_WIDTH(_("leverage"), 16), _("leverage"));
pprintf(prn, "%*s", UTF_WIDTH(_("influence"), 16), _("influence"));
pprintf(prn, "%*s", UTF_WIDTH(_("DFFITS"), 14), _("DFFITS"));
pputc(prn, '\n');
bufspace(obslen, prn);
pputs(prn, " u 0<=h<=1 u*h/(1-h)\n\n");
for (t=pmod->t1, j=0; t<=pmod->t2; t++, j++) {
double h, st, d, f;
char fstr[32];
if (na(pmod->uhat[t])) {
print_obs_marker(t, dset, obslen, prn);
pputc(prn, '\n');
continue;
}
h = gretl_matrix_get(S, j, 0);
if (h > lp) {
gotlp = 1;
}
f = gretl_matrix_get(S, j, 1);
if (!na(f)) {
sprintf(fstr, "%15.5g", f);
} else {
sprintf(fstr, "%15s", _("undefined"));
}
print_obs_marker(t, dset, obslen, prn);
st = gretl_matrix_get(S, j, 2);
d = st * sqrt(h / (1.0 - h));
pprintf(prn, "%14.5g %14.3f%s %s %14.3f\n", pmod->uhat[t], h,
(h > lp)? "*" : " ", fstr, d);
}
if (gotlp) {
pprintf(prn, "\n%s\n", _("('*' indicates a leverage point)"));
} else {
pprintf(prn, "\n%s\n", _("No leverage points were found"));
}
pprintf(prn, "\n%s = %g\n\n", _("Cross-validation criterion"), Xvalcrit);
}
