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