/* Finds eigenvector s of T and returns residual norm. */
double
Tevec (
double *alpha, /* vector of Lanczos scalars */
double *beta, /* vector of Lanczos scalars */
int j, /* number of Lanczos iterations taken */
double ritz, /* approximate eigenvalue of T */
double *s /* approximate eigenvector of T */
)
{
extern double SRESTOL; /* limit on relative residual tol for evec of T */
extern double DOUBLE_MAX; /* maximum double precision value */
int i; /* index */
double residual=0.0; /* how well recurrence gives eigenvector */
double temp; /* used to compute residual */
double *work; /* temporary work vector allocated within if used */
double w[MAXDIMS + 1]; /* holds eigenvalue for tinvit */
long index[MAXDIMS +1];/* index vector for tinvit */
long ierr; /* error flag for tinvit */
long nevals; /* number of evals sought */
long long_j; /* long copy of j for tinvit interface */
double hurdle; /* hurdle for local maximum in recurrence */
double prev_resid; /* stores residual from previous computation */
int tinvit_(); /* eispack's tinvit for evecs of symmetric T */
double *mkvec(); /* allocates double vectors */
void frvec(); /* frees double vectors */
double bidir(); /* bidirectional recurrence for evec of T */
void cpvec(); /* vector copy routine */
s[1] = 1.0;
if (j == 1) {
residual = fabs(alpha[1] - ritz);
}
if (j >= 2) {
/*Bidirectional recurrence - corrected and modified from Parlett and Reid,
"Tracking the Progress of the Lanczos Algorithm ..., IMA JNA 1, 1981 */
hurdle = 1.0;
residual = bidir(alpha,beta,j,ritz,s,hurdle);
}
if (residual > SRESTOL) {
/* Try again with Eispack's Tinvit iteration */
SRES_SWITCHES++;
index[1] = 1;
work = mkvec(1, 7*j); /* lump things to save mallocs */
w[1] = ritz;
work[1] = 0;
for (i = 2; i <= j; i++) {
work[i] = beta[i] * beta[i];
}
nevals = 1;
long_j = j;
/* save the previously computed evec in case it's better */
cpvec(&(work[6*j]),1,j,s);
prev_resid = residual;
tinvit_(&long_j, &long_j, &(alpha[1]), &(beta[1]), &(work[1]), &nevals,
&(w[1]), &(index[1]), &(s[1]), &ierr, &(work[j+1]), &(work[(2*j)+1]),
&(work[(3*j)+1]), &(work[(4*j)+1]), &(work[(5*j)+1]));
/* fix up sign if needed */
if (s[j] < 0) {
for(i=1; i<=j; i++) {
s[i] = - s[i];
}
}
if (ierr != 0) {
residual = DOUBLE_MAX;
/* ... don't want to use evec since it is set to zero */
}
else {
temp = (alpha[1] - ritz) * s[1] + beta[2] * s[2];
residual = temp * temp;
for (i = 2; i < j; i++) {
temp = beta[i] * s[i - 1] + (alpha[i] - ritz) * s[i]
+ beta[i + 1] * s[i + 1];
residual += temp * temp;
}
temp = beta[j] * s[j - 1] + (alpha[j] - ritz) * s[j];
residual += temp * temp;
residual = sqrt(residual);
/* tinvit normalizes, so we don't need to. */
}
/* restore previous evec if it had a better residual */
if (prev_resid < residual) {
residual = prev_resid;
cpvec(s,1,j,&(work[6*j]));
SRES_SWITCHES++; /* count since switching back as well */
}
frvec(work, 1);
}
return (residual);
}
int mri_svd_shrink( MRI_IMAGE *fim , float tau , float *sv )
{
int nn , n1 , mm , ii,jj,kk , kbot,mev ;
MRI_IMAGE *aim ;
double *asym,*sval,*eval, *fv1,*fv2,*fv3,*fv4,*fv5,*fv6,*fv7,*fv8,*vv ;
register double sum ; register float *xk ; float *xx ;
integer imm , imev , *iv1 , ierr ;
double tcut ;
if( fim == NULL || fim->kind != MRI_float || tau <= 0.0f ) return -1 ;
nn = fim->nx ; mm = fim->ny ; if( nn < mm || mm < 2 ) return -1 ;
xx = MRI_FLOAT_PTR(fim) ; if( xx == NULL ) return -1 ;
n1 = nn-1 ; tcut = (double)tau ;
aim = mri_make_xxt( fim ) ; if( aim == NULL ) return -1 ;
asym = MRI_DOUBLE_PTR(aim) ; /* symmetric matrix */
eval = (double *)calloc(sizeof(double),mm) ; /* its eigenvalues */
sval = (double *)malloc(sizeof(double)*mm) ; /* scaling values */
/** reduction to tridiagonal form (stored in fv1..3) **/
fv1 = (double *)malloc(sizeof(double)*(mm+9)) ; /* workspaces */
fv2 = (double *)malloc(sizeof(double)*(mm+9)) ;
fv3 = (double *)malloc(sizeof(double)*(mm+9)) ;
fv4 = (double *)malloc(sizeof(double)*(mm+9)) ;
fv5 = (double *)malloc(sizeof(double)*(mm+9)) ;
fv6 = (double *)malloc(sizeof(double)*(mm+9)) ;
fv7 = (double *)malloc(sizeof(double)*(mm+9)) ;
fv8 = (double *)malloc(sizeof(double)*(mm+9)) ;
iv1 = (integer *)malloc(sizeof(integer)*(mm+9)) ;
imm = (integer)mm ;
tred1_( &imm , &imm , asym , fv1,fv2,fv3 ) ;
/** find all the eigenvalues of the tridiagonal matrix **/
(void)imtqlv_( &imm , fv1,fv2,fv3 , eval , iv1 , &ierr , fv4 ) ;
/** convert to singular values [ascending order],
and then to scaling values for eigenvectors **/
kbot = -1 ; /* index of first nonzero scaling value */
for( ii=0 ; ii < mm ; ii++ ){
sval[ii] = (eval[ii] <= 0.0) ? 0.0 : sqrt(eval[ii]) ;
if( sv != NULL ) sv[ii] = (float)sval[ii] ; /* save singular values */
if( sval[ii] <= tcut ){ /* too small ==> scaling value is zero */
sval[ii] = 0.0 ;
} else { /* scale factor for ii-th eigenvector (< 1) */
sval[ii] = (sval[ii]-tcut) / sval[ii] ;
if( kbot < 0 ) kbot = ii ;
}
}
if( kbot < 0 ){ /*** all singular values are smaller than tau? ***/
free(iv1) ;
free(fv8) ; free(fv7) ; free(fv6) ; free(fv5) ;
free(fv4) ; free(fv3) ; free(fv2) ; free(fv1) ;
free(sval) ; mri_free(aim) ; return -1 ;
}
/** find eigenvectors, starting at the kbot-th one **/
mev = mm - kbot ; /* number of eigenvectors to compute */
vv = (double *)calloc(sizeof(double),mm*mev) ;
if( kbot > 0 ){ /* shift scaling values down to start at index=0 */
for( kk=0 ; kk < mev ; kk++ ) sval[kk] = sval[kk+kbot] ;
}
imev = (integer)mev ;
(void)tinvit_( &imm , &imm , fv1,fv2,fv3 , &imev , eval+kbot , iv1 ,
vv , &ierr , fv4,fv5,fv6,fv7,fv8 ) ;
/** back transform eigenvectors to original space **/
(void)trbak1_( &imm , &imm , asym , fv2 , &imev , vv ) ;
free(iv1) ;
free(fv8) ; free(fv7) ; free(fv6) ; free(fv5) ;
free(fv4) ; free(fv3) ; free(fv2) ; free(fv1) ; free(eval) ;
/** form m x m transformation matrix [V] diag[sval] [V]' into asym **/
for( ii=0 ; ii < mm ; ii++ ){
for( jj=0 ; jj <= ii ; jj++ ){
sum = 0.0 ;
for( kk=0 ; kk < mev ; kk++ )
sum += vv[ii+kk*mm]*vv[jj+kk*mm]*sval[kk] ;
A(ii,jj) = sum ; if( jj < ii ) A(jj,ii) = sum ;
}
}
free(vv) ; free(sval) ;
/** transform input matrix (in place) **/
xk = (float *)malloc(sizeof(float)*mm) ;
for( ii=0 ; ii < nn ; ii++ ){
for( jj=0 ; jj < mm ; jj++ ){
sum = 0.0 ;
for( kk=0 ; kk < mm ; kk++ ) sum += xx[ii+kk*nn]*A(kk,jj) ;
xk[jj] = (float)sum ;
}
for( kk=0 ; kk < mm ; kk++ ) xx[ii+kk*nn] = xk[kk] ;
}
/** vamoose the ranch **/
free(xk) ; mri_free(aim) ;
return mev ;
}
