Пример #1
0
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;
}
Пример #2
0
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;
}
Пример #3
0
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;
}
Пример #4
0
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;
}