Object-oriented Scientific Computing Library: Version 0.910
lanczos_base.h
00001 /*
00002   -------------------------------------------------------------------
00003   
00004   Copyright (C) 2006-2012, Andrew W. Steiner
00005   
00006   This file is part of O2scl.
00007   
00008   O2scl is free software; you can redistribute it and/or modify
00009   it under the terms of the GNU General Public License as published by
00010   the Free Software Foundation; either version 3 of the License, or
00011   (at your option) any later version.
00012   
00013   O2scl is distributed in the hope that it will be useful,
00014   but WITHOUT ANY WARRANTY; without even the implied warranty of
00015   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
00016   GNU General Public License for more details.
00017   
00018   You should have received a copy of the GNU General Public License
00019   along with O2scl. If not, see <http://www.gnu.org/licenses/>.
00020 
00021   -------------------------------------------------------------------
00022 */
00023 
00024 /** \brief Lanczos diagonalization
00025       
00026     This class approximates the largest eigenvalues of a symmetric
00027     matrix.
00028 
00029     The vector and matrix types can be any type which provides access
00030     via \c operator[] or \c operator(), given a suitable vector
00031     allocation type. See \ref vec_for_tlate_subsect in the User's 
00032     guide for more details.
00033       
00034     The tridiagonalization routine was rewritten from the EISPACK
00035     routines \c imtql1.f (but uses \c gsl_hypot() instead of \c
00036     pythag.f). 
00037 
00038     \future The function eigen_tdiag() automatically sorts the
00039     eigenvalues, which may not be necessary.
00040 
00041     \future Do something better than the naive matrix-vector product.
00042     For example, use dgemm() and allow user to specify column or
00043     row-major.
00044 
00045     \future Rework memory allocation to perform as needed.
00046 
00047     \comment 
00048     We need the o2scl:: prefix in the default template parameters
00049     below because this class isn't in the o2scl namespace.
00050     \endcomment
00051 */
00052 template<class vec_t=o2scl::ovector_base, class mat_t=o2scl::omatrix_base, 
00053   class alloc_vec_t=o2scl::ovector, class alloc_t=o2scl::ovector_alloc>
00054   class lanczos {
00055   
00056  public:
00057   
00058   lanczos() {
00059     td_iter=30;
00060     td_lasteval=0;
00061   }
00062   
00063   /** \brief Number of iterations for finding the eigenvalues of the
00064       tridiagonal matrix (default 30)
00065   */
00066   size_t td_iter;
00067 
00068   /** \brief The index for the last eigenvalue not determined if
00069       tridiagonalization fails
00070   */
00071   size_t td_lasteval;
00072 
00073   /** \brief Approximate the largest eigenvalues of a symmetric
00074       matrix \c mat using the Lanczos method
00075 
00076       Given a square matrix \c mat with size \c size, this function
00077       applies \c n_iter iterations of the Lanczos algorithm to
00078       produce \c n_iter approximate eigenvalues stored in \c
00079       eigen. As a by-product, this function also partially
00080       tridiagonalizes the matrix placing the result in \c diag and
00081       \c off_diag. Before calling this function, space must have
00082       already been allocated for \c eigen, \c diag, and \c
00083       off_diag. All three of these arrays must have at least enough
00084       space for \c n_iter elements.
00085         
00086       Choosing /c n_iter = \c size will produce all of the exact
00087       eigenvalues and the corresponding tridiagonal matrix, but this
00088       may be slower than diagonalizing the matrix directly.
00089   */
00090   int eigenvalues(size_t size, mat_t &mat, size_t n_iter, 
00091                   vec_t &eigen, vec_t &diag, vec_t &off_diag) {
00092     double t;
00093     bool cont=true;
00094     size_t i, j, k;
00095 
00096     alloc_vec_t v;
00097     alloc_vec_t w;
00098     alloc_vec_t b3;
00099     alloc_vec_t prod;
00100     alloc_t ao;
00101     ao.allocate(v,size);
00102     ao.allocate(w,size);
00103     ao.allocate(b3,size);
00104     ao.allocate(prod,size);
00105 
00106     // Pick a unit vector
00107     O2SCL_IX(w,0)=1.0;
00108     for(i=1;i<size;i++) O2SCL_IX(w,i)=0.0;
00109 
00110     for(i=0;i<size;i++) O2SCL_IX(v,i)=0;
00111     j=0;
00112     while (cont) {
00113       if (j!=0) {
00114         for(i=0;i<size;i++) {
00115           t=O2SCL_IX(w,i);
00116           O2SCL_IX(w,i)=O2SCL_IX(v,i)/O2SCL_IX(off_diag,j-1);
00117           O2SCL_IX(v,i)=-O2SCL_IX(off_diag,j-1)*t;
00118         }
00119       }
00120       product(size,mat,w,prod);
00121       for(k=0;k<size;k++) O2SCL_IX(v,k)+=O2SCL_IX(prod,k);
00122       O2SCL_IX(diag,j)=0.0;
00123       O2SCL_IX(off_diag,j)=0.0;
00124 
00125       for(k=0;k<size;k++) O2SCL_IX(diag,j)+=O2SCL_IX(w,k)*O2SCL_IX(v,k);
00126       for(k=0;k<size;k++) O2SCL_IX(v,k)-=O2SCL_IX(diag,j)*O2SCL_IX(w,k);
00127       for(k=0;k<size;k++) O2SCL_IX(off_diag,j)+=O2SCL_IX(v,k)*O2SCL_IX(v,k);
00128       O2SCL_IX(off_diag,j)=sqrt(O2SCL_IX(off_diag,j));
00129       j++;
00130     
00131       if (j>=n_iter || O2SCL_IX(off_diag,j-1)==0.0) cont=false;
00132     
00133       if (j>0) {
00134         for(k=0;k<size-1;k++) {
00135           O2SCL_IX(b3,k+1)=O2SCL_IX(off_diag,k);
00136           O2SCL_IX(eigen,k)=O2SCL_IX(diag,k);
00137         }
00138         O2SCL_IX(eigen,size-1)=O2SCL_IX(diag,size-1);
00139         if (eigen_tdiag(j,eigen,b3)!=0) {
00140 
00141           ao.free(v);
00142           ao.free(w);
00143           ao.free(b3);
00144           ao.free(prod);
00145 
00146           O2SCL_ERR2_RET("Call to eigen_tdiag() in lanczos::",
00147                          "eigenvalues() failed.",o2scl::gsl_efailed);
00148         }
00149       }
00150     }
00151 
00152     ao.free(v);
00153     ao.free(w);
00154     ao.free(b3);
00155     ao.free(prod);
00156   
00157     return 0;
00158   }
00159     
00160   /** \brief In-place diagonalization of a tridiagonal matrix
00161 
00162       On input, the vectors \c diag and \c off_diag should both be
00163       vectors of size \c n. The diagonal entries stored in \c diag,
00164       and the \f$ n-1 \f$ off-diagonal entries should be stored in
00165       \c off_diag, starting with \c off_diag[1].  The value in \c
00166       off_diag[0] is unused. The vector \c off_diag is destroyed by
00167       the computation.
00168 
00169       This uses an implict QL method from the EISPACK routine \c
00170       imtql1. The value of \c ierr from the original Fortran routine
00171       is stored in \ref td_lasteval.
00172 
00173   */
00174   int eigen_tdiag(size_t n, vec_t &diag, vec_t &off_diag) {
00175 
00176     // The variable 'i' is set to zero here because Cygwin complained
00177     // about uninitialized variables. This is probably ok, but it
00178     // would be nice to double check that there isn't a problem with
00179     // setting i=0 here.
00180 
00181     int i=0,j,l,m,mml;
00182     double b,c,f,g,p,r,s,tst1,tst2;
00183 
00184     if (n==1) return 0;
00185       
00186     for(size_t ij=1;ij<n;ij++) {
00187       O2SCL_IX(off_diag,ij-1)=O2SCL_IX(off_diag,ij);
00188     }
00189     O2SCL_IX(off_diag,n-1)=0.0;
00190   
00191     bool done=false;
00192   
00193     l=1;
00194     j=0;
00195   
00196     while (done==false && l<=((int)n)) {
00197     
00198       // Look for small sub-diagonal element
00199       bool idone=false;
00200       for(m=l;m<((int)n) && idone==false;m++) {
00201         tst1=fabs(O2SCL_IX(diag,m-1))+fabs(O2SCL_IX(diag,m));
00202         tst2=tst1+fabs(O2SCL_IX(off_diag,m-1));
00203         if (tst2==tst1) {
00204           m--;
00205           idone=true;
00206         }
00207       }
00208     
00209       p=O2SCL_IX(diag,l-1);
00210 
00211       if (m!=l && j==((int)td_iter)) {
00212           
00213         // Set error. No convergence after td_iter iterations
00214         td_lasteval=l;
00215         O2SCL_ERR_RET("No convergence in lanczos::eigen_tdiag()",
00216                       o2scl::gsl_efailed);
00217       }
00218 
00219       if (m!=l) {
00220 
00221         j++;
00222 
00223         // Form shift
00224         g=(O2SCL_IX(diag,l)-p)/(2.0*O2SCL_IX(off_diag,l-1));
00225         r=gsl_hypot(g,1.0);
00226       
00227         g=O2SCL_IX(diag,m-1)-p+O2SCL_IX(off_diag,l-1)/
00228           (g+(g>=0.0 ? fabs(r) : -fabs(r)));
00229         s=1.0;
00230         c=1.0;
00231         p=0.0;
00232         mml=m-l;
00233       
00234         for(int ii=1;ii<=mml;ii++) {
00235 
00236           i=m-ii;
00237           f=s*O2SCL_IX(off_diag,i-1);
00238           b=c*O2SCL_IX(off_diag,i-1);
00239           r=gsl_hypot(f,g);
00240           O2SCL_IX(off_diag,i)=r;
00241         
00242           if (r==0.0) {
00243 
00244             // Recover from underflow
00245             O2SCL_IX(diag,i)-=p;
00246             O2SCL_IX(off_diag,m-1)=0.0;
00247             ii=mml+1;
00248 
00249           } else {
00250 
00251             s=f/r;
00252             c=g/r;
00253             g=O2SCL_IX(diag,i)-p;
00254             r=(O2SCL_IX(diag,i-1)-g)*s+2.0*c*b;
00255             p=s*r;
00256             O2SCL_IX(diag,i)=g+p;
00257             g=c*r-b;
00258 
00259           }
00260 
00261         }
00262       
00263         O2SCL_IX(diag,l-1)-=p;
00264         O2SCL_IX(off_diag,l-1)=g;
00265         O2SCL_IX(off_diag,m-1)=0.0;
00266       
00267 
00268       } else {
00269 
00270         // Order eigenvalues
00271 
00272         if (l==1) {
00273 
00274           i=1;
00275           O2SCL_IX(diag,i-1)=p;
00276         
00277         } else {
00278 
00279           bool skip=false;
00280           for(int ii=2;ii<=l;ii++) {
00281             i=l+2-ii;
00282             if (p>=O2SCL_IX(diag,i-2)) {
00283               ii=l+1;
00284               skip=true;
00285             } else {
00286               O2SCL_IX(diag,i-1)=O2SCL_IX(diag,i-2);
00287             }
00288           }
00289         
00290           if (skip==false) i=1;
00291           O2SCL_IX(diag,i-1)=p;
00292         }
00293 
00294         j=0;
00295         l++;
00296       }
00297     
00298     }
00299   
00300     return 0;
00301   }
00302 
00303 #ifndef DOXYGEN_INTERNAL
00304 
00305  protected:
00306       
00307   /** \brief Naive matrix-vector product
00308         
00309       It is assumed that memory is already allocated for \c prod.
00310   */
00311   void product(size_t n, mat_t &a, vec_t &w, vec_t &prod) {
00312     size_t i, j;
00313     for(i=0;i<n;i++) {
00314       O2SCL_IX(prod,i)=0.0;
00315       for(j=0;j<n;j++) {
00316         O2SCL_IX(prod,i)+=O2SCL_IX2(a,i,j)*O2SCL_IX(w,j);
00317       }
00318     }
00319     return;
00320   }
00321     
00322 #endif
00323   
00324 };
00325 
 All Data Structures Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Defines

Documentation generated with Doxygen. Provided under the GNU Free Documentation License (see License Information).

Get Object-oriented Scientific Computing
Lib at SourceForge.net. Fast, secure and Free Open Source software
downloads.