static int ortogonalisoi() { double eps,tol; int i,j; int jj; /* sur_print("\nOrthogonalizing data..."); */ eps=1e-16; tol=1e-300/eps; mat_tred2(v1,v2,T,m,tol); mat_tql2(v1,v2,T,m,eps,30); for (j=0; j<m; ++j) { eps=1/sqrt(v1[j]); for (i=0; i<m; ++i) T[i+m*j]*=eps; } hav=muste_fopen(tempfile,"r+b"); for (jj=0L; jj<n; ++jj) { hav_read3(jj,xx); mat_mlt(v2,xx,T,1,m,m); hav_write3(jj,v2); } muste_fclose(hav); return(1); }
MATSTACK mat_eig_sym(MATRIX symmat, MATSTACK result) { int m, n; MATRIX im, tmp_result0 = NULL, tmp_result1 = NULL; INT_VECTOR indcs = NULL; MATSTACK tmp = NULL; m = MatCol(symmat); n = MatRow(symmat); if(m!=n) mat_error(MAT_SIZEMISMATCH); if(result==NULL) { if ((result = matstack_creat(2)) == NULL) return matstack_error(MATSTACK_MALLOC); result[0] = NULL; result[1] = NULL; } im = mat_creat(m, 1, UNDEFINED); tmp_result0 = mat_creat(m, 1, UNDEFINED); tmp_result1 = mat_copy(symmat, tmp_result1); mat_tred2(tmp_result1, tmp_result0, im); mat_tqli(tmp_result0, im, tmp_result1); tmp = mat_qsort(tmp_result0, ROWS, tmp); result[0] = mat_copy(tmp[0], result[0]); indcs = mat_2int_vec(tmp[1]); result[1] = mat_get_sub_matrix_from_cols(tmp_result1, indcs, result[1]); int_vec_free(indcs); mat_free(im); mat_free(tmp_result0); mat_free(tmp_result1); return result; }
static int fctgr() { int itry; int i,j; double da; itry=0; while (1) { if (ind>1) { for (i=0; i<p; ++i) psi[i]=sqrt(exp(v[i])); for (i=0; i<p; ++i) for (j=0; j<p; ++j) E[i+p*j]=om[i+p*j]=psi[i]*psi[j]*S[i+p*j]; mat_tred2(facta_gamma,psi,om,p,1e-300/1e-16); mat_tql2(facta_gamma,psi,om,p,1e-16,30); if (ind==2) { f=0.0; for (i=0; i<p-k; ++i) f+=(facta_gamma[i]-1)*(facta_gamma[i]-1); f/=2; for (i=0; i<p; ++i) d[i]=facta_gamma[i]*(facta_gamma[i]-1.0); } else /* ind=3 */ { f=0.0; for (i=0; i<p-k; ++i) f+=log(facta_gamma[i])+1/facta_gamma[i]-1; for (i=0; i<p; ++i) d[i]=1-1/facta_gamma[i]; } /* 16 */ for (i=0; i<p; ++i) { gg[i]=0.0; for (j=0; j<p-k; ++j) gg[i]+=d[j]*om[i+p*j]*om[i+p*j]; } } else { for (i=0; i<p; ++i) psi[i]=v[i]; for (i=0; i<p; ++i) for (j=0; j<p; ++j) { da=S[i+p*j]; if (i==j) da-=psi[i]*psi[i]; E[i+p*j]=om[i+p*j]=da; } mat_tred2(facta_gamma,d,om,p,1e-300/1e-16); mat_tql2(facta_gamma,d,om,p,1e-16,30); f=0.0; for (i=k; i<p; ++i) f+=facta_gamma[i]*facta_gamma[i]; f/=2; for (i=0; i<p; ++i) { gg[i]=0.0; for (j=k; j<p; ++j) gg[i]+=facta_gamma[j]*om[i+p*j]*om[i+p*j]; gg[i]*=-2*psi[i]; } } /* kohta 4 */ if (f0<f) { ++itry; sprintf(sbuf," %d",itry); sur_print(sbuf); if (itry<maxtry) { /* Rprintf("\nu&v: ");for (i=0; i<p; ++i) Rprintf("%g & %g ",u[i],v[i]); getch(); */ for (i=0; i<p; ++i) v[i]=0.5*(u[i]+v[i]); continue; } } f0=f; for (i=0; i<p; ++i) u[i]=v[i]; break; } /* while */ /* Rprintf("\ngg:"); for (i=0; i<p; ++i) Rprintf(" %g",gg[i]); getch(); */ return(1); }
MATSTACK mat_pca(MATRIX data, int pca_type) { int i, j, k, k2, m, n; MATRIX evals, im; MATSTACK tmmps0 = NULL; MATRIX symmat, symmat2; m = MatCol(data); n = MatRow(data); switch(pca_type) { case MAT_PCA_CORRELATION: tmmps0 = mat_corcol(data); symmat = tmmps0[1]; break; case MAT_PCA_COVARIANCE: tmmps0 = mat_covcol(data); symmat = tmmps0[1]; break; case MAT_PCA_SUMOFSQUARES: symmat = mat_scpcol(data); break; default: tmmps0 = mat_covcol(data); symmat = tmmps0[1]; break; } evals = mat_creat(m, 1, UNDEFINED); im = mat_creat(m, 1, UNDEFINED); symmat2 = mat_copy(symmat, NULL); mat_tred2(symmat, evals, im); mat_tqli(evals, im, symmat); for(i=0; i<n; ++i) { for(j=0; j<m; ++j) { im[j][0] = tmmps0[2][i][j]; } for(k=0; k<3; ++k) { tmmps0[2][i][k] = 0.0; for(k2=0; k2<m; ++k2) { tmmps0[2][i][k] += im[k2][0] * symmat[k2][m-k-1]; } } } for(j=0; j<m; ++j) { for(k=0; k<m; ++k) { im[k][0] = symmat2[j][k]; } for(i=0; i<3; ++i) { symmat2[j][i] = 0.0; for (k2=0; k2<m; ++k2) { symmat2[j][i] += im[k2][0] * symmat[k2][m-i-1]; } if(evals[m-i-1][0]>0.0005) symmat2[j][i] /= (mtype)sqrt(evals[m-i-1][0]); else symmat2[j][i] = 0.0; } } mat_free(evals); mat_free(im); return tmmps0; }