static void odell_feiveson_compute (gretl_matrix *W,
double *Z,
int v)
{
double Xi, Zri, Zrj;
double wii, wij;
int p = W->rows;
int i, j, r;
for (i=0; i<p; i++) {
gretl_rand_chisq(&Xi, 0, 0, v - i);
wii = Xi;
for (r=0; r<i; r++) {
Zri = Z[ijton(r, i, p)];
wii += Zri * Zri;
}
gretl_matrix_set(W, i, i, wii);
for (j=i+1; j<p; j++) {
wij = Z[ijton(i, j, p)] * sqrt(Xi);
for (r=0; r<i; r++) {
Zri = Z[ijton(r, i, p)];
Zrj = Z[ijton(r, j, p)];
wij += Zri * Zrj;
}
gretl_matrix_set(W, i, j, wij);
gretl_matrix_set(W, j, i, wij);
}
}
}
static int qr_make_vcv (MODEL *pmod, gretl_matrix *v, int flag)
{
int k = pmod->ncoeff;
int m = k * (k + 1) / 2;
double x;
int i, j, idx;
pmod->vcv = malloc(m * sizeof *pmod->vcv);
if (pmod->vcv == NULL) {
return E_ALLOC;
}
if (flag == VCV_XPX) {
gretl_model_set_int(pmod, "vcv_xpx", 1);
}
for (i=0; i<k; i++) {
for (j=0; j<=i; j++) {
idx = ijton(i, j, k);
x = gretl_matrix_get(v, i, j);
if (flag == VCV_SIMPLE) {
x *= pmod->sigma * pmod->sigma;
}
pmod->vcv[idx] = x;
if (i == j) {
pmod->sderr[i] = sqrt(x);
if (flag == VCV_XPX) {
pmod->sderr[i] *= pmod->sigma;
}
}
}
}
return 0;
}
static int get_x12a_vcv (const char *fname, MODEL *pmod, int nc)
{
FILE *fp;
char line[1024], valstr[24];
double x;
int i, j, k, nt = (nc * nc + nc) / 2;
int err = 0;
fp = gretl_fopen(fname, "r");
if (fp == NULL) return 1;
pmod->vcv = malloc(nt * sizeof *pmod->vcv);
if (pmod->vcv == NULL) {
fclose(fp);
return 1;
}
for (i=0; i<nt; i++) {
pmod->vcv[i] = NADBL;
}
gretl_push_c_numeric_locale();
j = 1;
while (fgets(line, sizeof line, fp)) {
if (!strncmp(line, "Nonseas", 7)) {
char *p = line + strcspn(line, "+-");
for (i=1; i<nc; i++) {
sscanf(p, "%22s", valstr);
p += 22;
if (i >= j) {
x = atof(valstr);
k = ijton(i, j, nc);
pmod->vcv[k] = x;
}
}
j++;
}
}
gretl_pop_c_numeric_locale();
fclose(fp);
return err;
}
static void
audioprint_matrix (const VMatrix *vmat, const DATASET *dset,
PRN *prn)
{
int i, j, k;
int n = vmat->t2 - vmat->t1 + 1;
int lo = vmat->dim;
if (vmat->ci == CORR) {
char date1[OBSLEN], date2[OBSLEN];
ntodate(date1, vmat->t1, dset);
ntodate(date2, vmat->t2, dset);
pprintf(prn, "Correlation coefficients, using the observations "
"%s to %s.\n", date1, date2);
pprintf(prn, " The 5%% critical value (two-tailed) is %.3f.\n",
rhocrit95(n));
} else {
pputs(prn, "Coefficient covariance matrix.\n");
}
for (i=1; i<=lo; i++) {
for (j=i; j<=lo; j++) {
k = ijton(i-1, j-1, lo);
if (i == j) {
if (vmat->ci == CORR) {
continue;
}
pprintf(prn, "%s, ", vmat->names[i-1]);
} else {
pprintf(prn, "%s and %s, ", vmat->names[i-1],
vmat->names[j-1]);
}
if (vmat->ci == CORR) {
pprintf(prn, "%.3f.\n", vmat->vec[k]);
} else {
pprintf(prn, "%.4g.\n", vmat->vec[k]);
}
}
}
}
int pca_from_cmatrix (VMatrix *cmat, DATASET *dset,
gretlopt opt, PRN *prn)
{
gretl_matrix *C;
gretl_matrix *evals = NULL;
gretlopt saveopt = opt;
int k = cmat->dim;
int nsave = 0;
int i, j, idx;
double x;
int err = 0;
if (opt & OPT_D) {
saveopt = pca_flag_dialog();
if (saveopt == OPT_NONE) {
/* canceled */
return 0;
}
} else if (opt & OPT_O) {
nsave = get_optval_int(PCA, OPT_O, &err);
if (err) {
return err;
}
}
C = gretl_matrix_alloc(k, k);
if (C == NULL) {
return E_ALLOC;
}
for (i=0; i<k; i++) {
for (j=0; j<k; j++) {
idx = ijton(i, j, k);
x = cmat->vec[idx];
gretl_matrix_set(C, i, j, x);
}
}
#if PCA_DEBUG
gretl_matrix_print(C, "original C, in pca");
#endif
evals = gretl_symm_matrix_eigenvals_descending(C, 1, &err);
#if PCA_DEBUG
gretl_matrix_print(C, "revised C (eigenvecs)");
#endif
if (!err && !(opt & OPT_Q) && prn != NULL) {
pca_print(cmat, evals, C, prn);
}
if (!err && saveopt) {
err = pca_save_components(cmat, evals, C, dset, nsave,
saveopt);
}
gretl_matrix_free(evals);
gretl_matrix_free(C);
return err;
}
