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;
}
