static void maybe_resize_vecm_matrices (GRETL_VAR *v) { int nc0 = (v->order * v->neqns) + v->ifc + v->jinfo->seasonals; if (v->xlist != NULL) { nc0 += v->xlist[0]; } if (v->detflags & DET_TREND) { nc0++; } if (v->X->cols > nc0) { /* for stage 1: skip the extra EC-term columns in X */ gretl_matrix_reuse(v->X, -1, nc0); gretl_matrix_reuse(v->B, nc0, -1); } }
static void duration_overall_LR_test (MODEL *pmod, duration_info *dinfo, int use_bfgs) { double llu = dinfo->ll; int err = 0; dinfo->k = 1; dinfo->npar = 1 + (dinfo->dist != DUR_EXPON); gretl_matrix_reuse(dinfo->X, -1, dinfo->k); gretl_matrix_reuse(dinfo->G, -1, dinfo->npar); gretl_matrix_reuse(dinfo->beta, dinfo->k, 1); dinfo->flags |= DUR_CONST_ONLY; err = duration_estimates_init(dinfo); /* now estimate constant-only model */ if (!err && use_bfgs) { int maxit, fncount = 0, grcount = 0; double toler; BFGS_defaults(&maxit, &toler, DURATION); err = BFGS_max(dinfo->theta, dinfo->npar, maxit, toler, &fncount, &grcount, duration_loglik, C_LOGLIK, duration_score, dinfo, NULL, OPT_NONE, NULL); } else if (!err) { double crittol = 1.0e-7; double gradtol = 1.0e-7; int iters = 0, maxit = 100; err = newton_raphson_max(dinfo->theta, dinfo->npar, maxit, crittol, gradtol, &iters, C_LOGLIK, duration_loglik, duration_score, duration_hessian, dinfo, OPT_NONE, NULL); } if (!err && llu > dinfo->ll) { pmod->chisq = 2 * (llu - dinfo->ll); } }
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 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; }
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; }
static GRETL_VAR *back_up_VAR (const GRETL_VAR *v) { GRETL_VAR *vbak; int err = 0; vbak = malloc(sizeof *vbak); if (vbak == NULL) { return NULL; } gretl_VAR_clear(vbak); clear_gretl_matrix_err(); vbak->Y = gretl_matrix_copy(v->Y); vbak->B = gretl_matrix_copy(v->B); if (v->xcols > v->X->cols) { int save_k = v->X->cols; gretl_matrix_reuse(v->X, -1, v->xcols); vbak->X = gretl_matrix_copy(v->X); gretl_matrix_reuse(vbak->X, -1, save_k); gretl_matrix_reuse(v->X, -1, save_k); } else { vbak->X = gretl_matrix_copy(v->X); } vbak->XTX = gretl_matrix_copy(v->XTX); vbak->A = gretl_matrix_copy(v->A); vbak->E = gretl_matrix_copy(v->E); vbak->C = gretl_matrix_copy(v->C); vbak->S = gretl_matrix_copy(v->S); err = get_gretl_matrix_err(); if (!err && v->jinfo != NULL) { vbak->jinfo = malloc(sizeof *vbak->jinfo); if (vbak->jinfo == NULL) { err = E_ALLOC; } else { vbak->ylist = gretl_list_copy(v->ylist); if (vbak->ylist == NULL) { err = E_ALLOC; } } } if (!err && v->rlist != NULL) { vbak->rlist = gretl_list_copy(v->rlist); if (vbak->rlist == NULL) { err = E_ALLOC; } } if (!err && vbak->jinfo != NULL) { vbak->jinfo->R0 = gretl_matrix_copy(v->jinfo->R0); vbak->jinfo->R1 = gretl_matrix_copy(v->jinfo->R1); vbak->jinfo->S00 = gretl_matrix_copy(v->jinfo->S00); vbak->jinfo->S11 = gretl_matrix_copy(v->jinfo->S11); vbak->jinfo->S01 = gretl_matrix_copy(v->jinfo->S01); vbak->jinfo->Beta = gretl_matrix_copy(v->jinfo->Beta); vbak->jinfo->Alpha = gretl_matrix_copy(v->jinfo->Alpha); err = get_gretl_matrix_err(); } if (err) { gretl_VAR_free(vbak); vbak = NULL; } else { vbak->T = v->T; vbak->neqns = v->neqns; vbak->order = v->order; } return vbak; }