コード例 #1
0
ファイル: qr_estimate.c プロジェクト: aylusltd/gretl
static int qr_make_cluster_vcv (MODEL *pmod, int ci,
				const DATASET *dset,
				gretl_matrix *XX,
				gretlopt opt)
{
    gretl_matrix *cvals = NULL;
    gretl_matrix *V = NULL;
    const char *cname;
    int cvar, n_c = 0;
    int err = 0;

    if (pmod->ci != OLS && pmod->ci != IVREG) {
	/* relax this? */
	return E_NOTIMP;
    }

    cname = get_optval_string(ci, OPT_C); 
    if (cname == NULL) {
	return E_PARSE;
    }

    cvar = current_series_index(dset, cname);
    if (cvar < 1 || cvar >= dset->v) {
	err = E_UNKVAR;
    }

    if (!err) {
	cvals = cluster_var_values(dset->Z[cvar], pmod, &err);
	if (!err) {
	    n_c = gretl_vector_get_length(cvals);
	    if (n_c < 2) {
		err = E_DATA;
	    }
	}
    }

#if CDEBUG
    fprintf(stderr, "qr_make_cluster_vcv: err = %d\n", err);
    fprintf(stderr, "cluster var = %s (%d)\n", cname, cvar);
    gretl_matrix_print(cvals, "cvals");
#endif

    if (!err) {
	V = cluster_vcv_calc(pmod, cvar, cvals, XX, dset, &err);
    }

    if (!err) {
	err = gretl_model_write_vcv(pmod, V);
    }

    if (!err) {
	gretl_model_set_vcv_info(pmod, VCV_CLUSTER, cvar);
	gretl_model_set_int(pmod, "n_clusters", n_c);
    }

    gretl_matrix_free(V);
    gretl_matrix_free(cvals);

    return err;
}
コード例 #2
0
ファイル: qr_estimate.c プロジェクト: aylusltd/gretl
static int cval_count_max (MODEL *pmod, const gretl_matrix *cvals, 
			   const double *cZ)
{
    int n = gretl_vector_get_length(cvals);
    int i, cc, cmax = 0;

    for (i=0; i<n; i++) {
	cc = cval_count(pmod, cvals->val[i], cZ);
	if (cc > cmax) {
	    cmax = cc;
	}
    }

    return cmax;
}
コード例 #3
0
ファイル: libglue.c プロジェクト: agaurav/QT-GRETL
MODEL quantreg_driver (const char *parm, const int *list, 
		       DATASET *dset, gretlopt opt, PRN *prn)
{
    gretl_vector *tau;
    MODEL mod;
    int err = 0;

    tau = generate_matrix(parm, dset, &err);

    if (!err && gretl_vector_get_length(tau) == 0) {
	err = E_DATA;
    }

    if (err) {
	gretl_model_init(&mod, dset);
	mod.errcode = err;
    } else {
	mod = quantreg(tau, list, dset, opt, prn);
    }

    gretl_matrix_free(tau);

    return mod;
}
コード例 #4
0
ファイル: qr_estimate.c プロジェクト: aylusltd/gretl
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;
}
コード例 #5
0
ファイル: gretl_midas.c プロジェクト: HelioGuilherme66/gretl
static int parse_midas_info (const char *s,
			     midas_info *minfo, int i,
			     const DATASET *dset)
{
    midas_info *m = &minfo[i];
    char lname[VNAMELEN];
    char mname[VNAMELEN];
    char fmt[48];
    int n, m1, m2, p;
    int umidas = 0;
    int err = 0;

    midas_info_init(m);

    if (!strncmp(s, "mds(", 4)) {
	/* calling for auto-generated lags */
	s += 4;
	sprintf(fmt, "%%%d[^, ] , %%d , %%d , %%d, %%%d[^) ])",
		VNAMELEN-1, VNAMELEN-1);
	n = sscanf(s, fmt, lname, &m1, &m2, &p, mname);
	if (n == 4 && p == MIDAS_U) {
	    umidas = 1;
	} else if (n != 5) {
	    err = E_PARSE;
	}
    } else if (!strncmp(s, "mdsl(", 5)) {
	/* list already hold lags */
	m->prelag = 1;
	s += 5;
	sprintf(fmt, "%%%d[^, ] , %%d, %%%d[^) ])",
		VNAMELEN-1, VNAMELEN-1);
	n = sscanf(s, fmt, lname, &p, mname);
	if (n == 2 && p == MIDAS_U) {
	    umidas = 1;
	} else if (n != 3) {
	    err = E_PARSE;
	}
	m1 = m2 = 0; /* got no min/max info */
    } else {
	err = E_INVARG;
    }

    if (!err) {
	gretl_matrix *theta = NULL;
	int *list = get_list_by_name(lname);
	int k = 0;

	if (!umidas) {
	    theta = get_matrix_by_name(mname);
	    if (theta == NULL) {
		theta = maybe_make_auto_theta(mname, i, p, m1, m2);
	    }
	}

	if (m->prelag && list == NULL) {
	    err = E_INVARG;
	} else if (!m->prelag && !gretl_is_midas_list(list, dset)) {
	    gretl_errmsg_set("mds(): the first term must be a MIDAS list");
	    err = E_INVARG;
	} else if (m1 > m2) {
	    err = E_INVARG;
	} else if (p < 0 || p >= MIDAS_MAX) {
	    err = E_INVARG;
	} else if (umidas) {
	    if (m->prelag) {
		k = list[0];
	    } else {
		k = m2 - m1 + 1;
	    }
	} else {
	    k = gretl_vector_get_length(theta);
	    if (k < 1 || (p == MIDAS_BETA0 && k != 2) ||
		(p == MIDAS_BETAN && k != 3)) {
		err = E_INVARG;
	    }
	}

	if (!err) {
	    strcpy(m->lnam0, lname);
	    strcpy(m->lname, lname);
	    if (!umidas) {
		strcpy(m->mname, mname);
	    }
	    if (m->prelag) {
		/* scrounge lag info from incoming list */
		lag_info_from_prelag_list(m, list, dset);
	    } else {
		m->minlag = m1;
		m->maxlag = m2;
	    }
	    m->type = p;
	    m->nparm = k;
	}
    }

    return err;
}