示例#1
0
static gretl_matrix *maybe_make_auto_theta (char *name, int i,
					    int ptype,
					    int m1, int m2)
{
    gretl_matrix *theta = NULL;
    int k = 0;
    
    if (!strcmp(name, "null")) {
	/* OK if we know how many parameters are needed? */
	if (ptype == MIDAS_BETA0) {
	    k = 2;
	} else if (ptype == MIDAS_BETAN) {
	    k = 3;
	} else if (ptype == MIDAS_U) {
	    k = m2 - m1 + 1;
	}
    } else if (integer_string(name)) {
	int chk = atoi(name);

	if (chk >= 1 && chk < 100) {
	    k = chk;
	}
    }

    if (k > 0) {
	theta = gretl_zero_matrix_new(k, 1);
	if (theta != NULL) {
	    if (ptype == MIDAS_BETA0) {
		theta->val[0] = 1;
		theta->val[1] = 5;
	    } else if (ptype == MIDAS_BETAN) {
		theta->val[0] = 1;
		theta->val[1] = 1;
		theta->val[2] = 0;
	    }
	    sprintf(name, "theta___%d", i+1);
	    private_matrix_add(theta, name);
	}
    }

#if MIDAS_DEBUG
    gretl_matrix_print(theta, "auto-generated theta");
#endif

    return theta;
}
示例#2
0
gretl_matrix *HAC_XOX (const gretl_matrix *uhat,
		       const gretl_matrix *X,
		       VCVInfo *vi, int use_prior,
		       int *err)
{
    gretl_matrix *XOX = NULL;
    gretl_matrix *Wtj = NULL;
    gretl_matrix *Gj = NULL;
    gretl_matrix *H = NULL;
    gretl_matrix *A = NULL;
    gretl_matrix *w = NULL;
    int prewhiten;
    int data_based;
    int kern;
    int T = X->rows;
    int k = X->cols;
    int p, j, t;
    double bt = 0;

    if (use_prior) {
	kern = vi->vmin;
	prewhiten = vi->flags & HAC_PREWHITEN;
	if (kern == KERNEL_QS) {
	    bt = vi->bw;
	    p = T - 1;
	} else {
	    p = vi->order;
	}
	data_based = 0;
    } else {
	kern = libset_get_int(HAC_KERNEL);
	data_based = data_based_hac_bandwidth();
	prewhiten = libset_get_bool(PREWHITEN);
    }

#if NW_DEBUG
    fprintf(stderr, "*** HAC: kern = %d, prewhiten = %d ***\n", 
	    kern, prewhiten);
#endif

    if (use_prior) {
	H = newey_west_H(X, uhat, NULL);
    } else if (prewhiten || data_based) {
	H = newey_west_H(X, uhat, &w);
    } else {
	H = newey_west_H(X, uhat, NULL);
    }

    if (H == NULL) {
	*err = E_ALLOC;
	return NULL;
    } else if (prewhiten) {
	*err = nw_prewhiten(H, &A);
    }

    if (!*err) {
	XOX = gretl_zero_matrix_new(k, k);
	Wtj = gretl_matrix_alloc(k, k);
	Gj = gretl_matrix_alloc(k, k);
	if (XOX == NULL || Wtj == NULL || Gj == NULL) {
	    *err = E_ALLOC;
	}
    }

    if (*err) {
	goto bailout;
    }

    /* determine the bandwidth setting */

    if (!use_prior) {
	if (data_based) {
	    *err = newey_west_bandwidth(H, w, kern, prewhiten, &p, &bt);
	    if (*err) {
		goto bailout;
	    }
	} else if (kern == KERNEL_QS) {
	    bt = libset_get_double(QS_BANDWIDTH);
	    p = T - 1;
	} else {
	    p = get_hac_lag(T);
	}
    }

    if (!*err) {
	double wj;

	for (j=0; j<=p; j++) {
	    /* cumulate running sum of Gamma-hat terms */
	    gretl_matrix_zero(Gj);

	    for (t=j; t<T; t++) {
		/* W(t)-transpose * W(t-j) */
		wtw(Wtj, H, k, t, j);
		gretl_matrix_add_to(Gj, Wtj);
	    }

	    if (j > 0) {
		/* Gamma(j) = Gamma(j) + Gamma(j)-transpose */
		gretl_matrix_add_self_transpose(Gj);
		if (kern == KERNEL_QS) {
		    wj = qs_hac_weight(bt, j);
		} else {
		    wj = hac_weight(kern, p, j);
		}
		gretl_matrix_multiply_by_scalar(Gj, wj);
	    }

	    gretl_matrix_add_to(XOX, Gj);
	}
    }

    if (A != NULL) {
	hac_recolor(XOX, A);
    }

    if (!use_prior) {
	vi->vmaj = VCV_HAC;
	vi->vmin = kern;
	vi->flags = prewhiten ? HAC_PREWHITEN : 0;

	if (kern == KERNEL_QS) {
	    vi->order = 0;
	    vi->bw = bt;
	} else {
	    vi->order = p;
	    vi->bw = NADBL;
	}
    }

 bailout:

    gretl_matrix_free(H);
    gretl_matrix_free(Wtj);
    gretl_matrix_free(Gj);
    gretl_matrix_free(A);
    gretl_matrix_free(w);

    if (*err && XOX != NULL) {
	gretl_matrix_free(XOX);
	XOX = NULL;
    }

    return XOX;
}
示例#3
0
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;
}
示例#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;
}
示例#5
0
gretl_matrix *irf_bootstrap (GRETL_VAR *var, 
			     int targ, int shock, 
			     int periods, double alpha,
			     const DATASET *dset,
			     int *err)
{
    gretl_matrix *R = NULL; /* the return value */
    GRETL_VAR *vbak = NULL;
    irfboot *boot = NULL;
    int scount = 0;
    int iter;

    if (var->X == NULL || var->Y == NULL) {
	gretl_errmsg_set("X and/or Y matrix missing, can't do this");
	*err = E_DATA;
	return NULL;
    }

#if BDEBUG
    fprintf(stderr, "\n*** irf_bootstrap() called\n");
#endif

    R = gretl_zero_matrix_new(periods, 3);
    if (R == NULL) {
	*err = E_ALLOC;
	return NULL;
    }    

    vbak = back_up_VAR(var);
    if (vbak == NULL) {
	*err = E_ALLOC;
	gretl_matrix_free(R);
	return NULL;
    }

    boot = irf_boot_new(var, periods);
    if (boot == NULL) {
	*err = E_ALLOC;
	goto bailout;
    }

    if (var->ci == VECM) {
	boot->C0 = VAR_coeff_matrix_from_VECM(var);
	if (boot->C0 == NULL) {
	    *err = E_ALLOC;
	} else {
	    *err = init_VECM_dataset(boot, var, dset);
	}
    }

    for (iter=0; iter<BOOT_ITERS && !*err; iter++) {
#if BDEBUG
	fprintf(stderr, "starting iteration %d\n", iter);
#endif
	irf_resample_resids(boot, vbak);
	if (var->ci == VECM) {
	    compute_VECM_dataset(boot, var, iter);
	    *err = re_estimate_VECM(boot, var, targ, shock, iter, scount);
	} else {
	    compute_VAR_dataset(boot, var, vbak);
	    *err = re_estimate_VAR(boot, var, targ, shock, iter);
	}
	if (*err && !VAR_FATAL(*err, iter, scount)) {
	    /* excessive collinearity: try again, unless this is becoming a habit */
	    scount++;
	    iter--;
	    *err = 0;
	}
    }

    if (*err && scount == MAXSING) {
	gretl_errmsg_set("Excessive collinearity in resampled datasets");
    }

    if (!*err) {
	*err = irf_boot_quantiles(boot, R, alpha);
    }

    irf_boot_free(boot);

 bailout:

    restore_VAR_data(var, vbak);

    if (*err) {
	gretl_matrix_free(R);
	R = NULL;
    }

    return R;
}