int qr_tsls_vcv (MODEL *pmod, const DATASET *dset, gretlopt opt)
{
gretl_matrix *Q = NULL;
gretl_matrix *R = NULL;
gretl_matrix *V = NULL;
int k, err = 0;
k = pmod->list[0] - 1;
Q = make_data_X(pmod, dset);
R = gretl_matrix_alloc(k, k);
V = gretl_matrix_alloc(k, k);
if (Q == NULL || R == NULL || V == NULL) {
err = E_ALLOC;
goto qr_cleanup;
}
err = QR_decomp_plus(Q, R, NULL, NULL);
if (err) {
goto qr_cleanup;
}
/* 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) {
if (opt & OPT_C) {
pmod->opt |= OPT_R;
err = qr_make_cluster_vcv(pmod, IVREG, dset, V, opt);
} else if (dataset_is_panel(dset)) {
err = qr_make_regular_vcv(pmod, V, OPT_X);
if (!err) {
err = panel_tsls_robust_vcv(pmod, dset);
}
} else if (dataset_is_time_series(dset) &&
!libset_get_bool(FORCE_HC)) {
pmod->opt |= OPT_R;
err = qr_make_hac(pmod, dset, V);
} else {
pmod->opt |= OPT_R;
err = qr_make_hccme(pmod, dset, Q, V);
}
} else {
qr_make_regular_vcv(pmod, V, OPT_NONE);
}
qr_cleanup:
gretl_matrix_free(Q);
gretl_matrix_free(R);
gretl_matrix_free(V);
pmod->errcode = err;
return err;
}
static int shell_grab (const char *arg, char **sout)
{
int err = 0;
if (arg == NULL || *arg == '\0') {
return E_PARSE;
}
if (!libset_get_bool(SHELL_OK)) {
gretl_errmsg_set(_("The shell command is not activated."));
return 1;
}
gretl_shell_grab(arg, sout);
if (sout != NULL && *sout != NULL) {
char *content = *sout;
if (!g_utf8_validate(content, -1, NULL)) {
content = recode_content(content, NULL, &err);
*sout = content;
}
if (content != NULL) {
/* trim trailing newline */
int n = strlen(content);
if (content[n-1] == '\n') {
content[n-1] = '\0';
}
}
}
return err;
}
static void mle_gmm_iters_dialog (GtkWidget *w, dialog_t *d)
{
int maxit, lmem = 0, optim = BFGS_MAX;
double tol;
int resp;
BFGS_defaults(&maxit, &tol, d->ci);
lmem = libset_get_int(LBFGS_MEM);
if (maxit <= 0) {
maxit = 1000;
}
if ((d->opt & OPT_L) || libset_get_bool(USE_LBFGS)) {
optim = LBFGS_MAX;
}
resp = iter_control_dialog(&optim, &maxit, &tol, &lmem,
d->dialog);
if (!canceled(resp)) {
int err;
err = libset_set_int(BFGS_MAXITER, maxit);
err += libset_set_double(BFGS_TOLER, tol);
if (optim == LBFGS_MAX) {
d->opt |= OPT_L;
libset_set_int(LBFGS_MEM, lmem);
} else {
d->opt &= ~OPT_L;
}
if (err) {
errbox("Error setting values");
}
}
}
int gretl_shell (const char *arg, PRN *prn)
{
UINT winret;
int async = 0;
int err = 0;
if (arg == NULL || *arg == '\0') {
return 0;
}
if (!libset_get_bool(SHELL_OK)) {
gretl_errmsg_set(_("The shell command is not activated."));
return 1;
}
if (!strncmp(arg, "launch ", 7)) {
async = 1;
arg += 7;
} else if (*arg == '!') {
arg++;
}
arg += strspn(arg, " \t");
if (async) {
winret = WinExec(arg, SW_SHOWNORMAL);
if (winret <= 31) {
err = 1;
}
} else if (getenv("GRETL_SHELL_NEW")) {
err = run_cmd_with_pipes(arg, NULL, prn, SHELL_RUN);
} else {
err = run_cmd_wait(arg, prn);
}
return err;
}
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;
}
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;
}
