Object-oriented Scientific Computing Library: Version 0.910
svdstep_base.h
Go to the documentation of this file.
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 /* linalg/svdstep.c
00024  * 
00025  * Copyright (C) 2007 Brian Gough
00026  * 
00027  * This program is free software; you can redistribute it and/or modify
00028  * it under the terms of the GNU General Public License as published by
00029  * the Free Software Foundation; either version 3 of the License, or (at
00030  * your option) any later version.
00031  * 
00032  * This program is distributed in the hope that it will be useful, but
00033  * WITHOUT ANY WARRANTY; without even the implied warranty of
00034  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
00035  * General Public License for more details.
00036  * 
00037  * You should have received a copy of the GNU General Public License
00038  * along with this program; if not, write to the Free Software
00039  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
00040  * 02110-1301, USA.
00041  */
00042 /** \file svdstep_base.h
00043     \brief File for SVD decomposition
00044 */
00045 
00046 #ifdef DOXYGENP
00047 namespace o2scl_linalg {
00048 #endif
00049 
00050   /** \brief Desc
00051       
00052       The parameter \c N is the size of \c d.
00053    */
00054   template<class vec_t, class vec2_t>
00055     int chop_small_elements(size_t N, vec_t &d, vec2_t &f) {
00056     
00057     double d_i=O2SCL_IX(d,0);
00058     
00059     size_t i;
00060     
00061     for (i = 0; i < N - 1; i++) {
00062 
00063       double f_i = O2SCL_IX(f,i);
00064       double d_ip1 = O2SCL_IX(d,i+1);
00065       
00066       if (fabs (f_i) < GSL_DBL_EPSILON * (fabs (d_i) + fabs (d_ip1))) {
00067         O2SCL_IX(f,i)=0.0;
00068       }
00069       d_i = d_ip1;
00070     }
00071     
00072     return o2scl::gsl_success;
00073   }
00074   
00075   /** \brief Desc
00076       
00077       The parameter \c n is the size of the vector \c d.
00078 
00079       Should be finished.
00080    */
00081   template<class vec_t, class vec2_t>
00082     double trailing_eigenvalue(size_t n, const vec_t &d, const vec_t &f) {
00083     
00084     double da = O2SCL_IX(d, n - 2);
00085     double db = O2SCL_IX(d, n - 1);
00086     double fa = (n > 2) ? O2SCL_IX(f, n - 3) : 0.0;
00087     double fb = O2SCL_IX(f, n - 2);
00088     
00089     double ta = da * da + fa * fa;
00090     double tb = db * db + fb * fb;
00091     double tab = da * fb;
00092     
00093     double dt = (ta - tb) / 2.0;
00094     
00095     double S = ta + tb;
00096     double da2 = da * da, db2 = db * db;
00097     double fa2 = fa * fa, fb2 = fb * fb;
00098     double P = (da2 * db2) + (fa2 * db2) + (fa2 * fb2);
00099     double D = hypot(dt, tab);
00100     double r1 = S/2 + D;
00101     
00102     double mu;
00103     if (dt >= 0) {
00104       /* tb < ta, choose smaller root */
00105       mu = (r1 > 0) ?  P / r1 : 0.0;
00106     } else {
00107       /* tb > ta, choose larger root */
00108       mu = r1;
00109     }
00110     return mu;
00111   }
00112   
00113   /** \brief Desc
00114 
00115       Should be finished.
00116    */
00117   int create_schur(double d0, double f0, double d1, double &c, 
00118                    double &s) {
00119     double apq = 2.0 * d0 * f0;
00120     
00121     if (d0 == 0 || f0 == 0) {
00122       c = 1.0;
00123       s = 0.0;
00124       return o2scl::gsl_success;
00125     }
00126     
00127     /* Check if we need to rescale to avoid underflow/overflow */
00128     if (fabs(d0) < GSL_SQRT_DBL_MIN || fabs(d0) > GSL_SQRT_DBL_MAX
00129         || fabs(f0) < GSL_SQRT_DBL_MIN || fabs(f0) > GSL_SQRT_DBL_MAX
00130         || fabs(d1) < GSL_SQRT_DBL_MIN || fabs(d1) > GSL_SQRT_DBL_MAX) {
00131       
00132       double scale;
00133       int d0_exp, f0_exp;
00134       frexp(d0, &d0_exp);
00135       frexp(f0, &f0_exp);
00136       /* Bring |d0*f0| into the range GSL_DBL_MIN to GSL_DBL_MAX */
00137       scale = ldexp(1.0, -(d0_exp + f0_exp)/4);
00138       d0 *= scale;
00139       f0 *= scale;
00140       d1 *= scale;
00141       apq = 2.0 * d0 * f0;
00142     }
00143     
00144     if (apq != 0.0) {
00145       double t;
00146       double tau = (f0*f0 + (d1 + d0)*(d1 - d0)) / apq;
00147       
00148       if (tau >= 0.0) {
00149         t = 1.0/(tau + hypot(1.0, tau));
00150       } else {
00151         t = -1.0/(-tau + hypot(1.0, tau));
00152       }
00153       
00154       c = 1.0 / hypot(1.0, t);
00155       s = t * (c);
00156     } else {
00157       c = 1.0;
00158       s = 0.0;
00159     }
00160     return o2scl::gsl_success;
00161   }
00162   
00163   /** \brief Desc
00164       
00165       The parameter \c M is the number of rows in \c U and \c N 
00166       is the number of rows in \c V.
00167   */
00168   template<class vec_t, class vec2_t, class mat_t, class mat2_t>
00169     int svd2(size_t M, size_t N, vec_t &d, vec2_t &f, mat_t &U, mat2_t &V) {
00170 
00171     size_t i;
00172     double c, s, a11, a12, a21, a22;
00173     
00174     double d0 = O2SCL_IX(d,0);
00175     double f0 = O2SCL_IX(f, 0);
00176     
00177     double d1 = O2SCL_IX(d, 1);
00178     
00179     if (d0 == 0.0) {
00180       
00181       /* Eliminate off-diagonal element in [0,f0;0,d1] to make [d,0;0,0] */
00182       o2scl_linalg::create_givens(f0,d1,c,s);
00183       
00184       /* compute B <= G^T B X,  where X = [0,1;1,0] */
00185 
00186       O2SCL_IX(d,0)=c * f0 - s * d1;
00187       O2SCL_IX(f,0)=s * f0 + c * d1;
00188       O2SCL_IX(d,1)=0.0;
00189       
00190       /* Compute U <= U G */
00191       
00192       for (i = 0; i < M; i++) {
00193         
00194         double Uip = O2SCL_IX2 (U, i, 0);
00195         double Uiq = O2SCL_IX2 (U, i, 1);
00196         O2SCL_IX2(U,i,0)=c * Uip - s * Uiq;
00197         O2SCL_IX2(U,i,1)=s * Uip + c * Uiq;
00198       }
00199       
00200       /* Compute V <= V X */
00201 
00202       double temp;
00203       for(size_t ik=0;ik<N;ik++) {
00204         temp=O2SCL_IX2(V,ik,0);
00205         O2SCL_IX2(V,ik,0)=O2SCL_IX2(V,ik,1);
00206         O2SCL_IX2(V,ik,1)=temp;
00207       }
00208 
00209       return o2scl::gsl_success;
00210 
00211     } else if (d1 == 0.0) {
00212 
00213       /* Eliminate off-diagonal element in [d0,f0;0,0] */
00214 
00215       o2scl_linalg::create_givens(d0,f0,c,s);
00216 
00217       /* compute B <= B G */
00218 
00219       O2SCL_IX (d, 0)= d0 * c - f0 * s;
00220       O2SCL_IX (f, 0)= 0.0;
00221 
00222       /* Compute V <= V G */
00223 
00224       for (i = 0; i < N; i++) {
00225         double Vip = O2SCL_IX2 (V, i, 0);
00226         double Viq = O2SCL_IX2 (V, i, 1);
00227         O2SCL_IX2 (V, i, 0)= c * Vip - s * Viq;
00228         O2SCL_IX2 (V, i, 1)= s * Vip + c * Viq;
00229       }
00230       
00231       return o2scl::gsl_success;
00232 
00233     } else {
00234 
00235       /* Make columns orthogonal, A = [d0, f0; 0, d1] * G */
00236 
00237       create_schur (d0, f0, d1, c, s);
00238 
00239       /* compute B <= B G */
00240       
00241       a11 = c * d0 - s * f0;
00242       a21 = - s * d1;
00243       
00244       a12 = s * d0 + c * f0;
00245       a22 = c * d1;
00246       
00247       /* Compute V <= V G */
00248       
00249       for (i = 0; i < N; i++) {
00250         
00251         double Vip = O2SCL_IX2 (V, i, 0);
00252         double Viq = O2SCL_IX2 (V, i, 1);
00253         O2SCL_IX2 (V, i, 0)= c * Vip - s * Viq;
00254         O2SCL_IX2 (V, i, 1)= s * Vip + c * Viq;
00255       }
00256       
00257       /* Eliminate off-diagonal elements, bring column with largest
00258          norm to first column */
00259       
00260       if (hypot(a11, a21) < hypot(a12,a22)) {
00261         
00262         double t1, t2;
00263         
00264         /* B <= B X */
00265         
00266         t1 = a11; a11 = a12; a12 = t1;
00267         t2 = a21; a21 = a22; a22 = t2;
00268         
00269         /* V <= V X */
00270         
00271         double temp;
00272         for(size_t ik=0;ik<N;ik++) {
00273           temp=O2SCL_IX2(V,ik,0);
00274           O2SCL_IX2(V,ik,0)=O2SCL_IX2(V,ik,1);
00275           O2SCL_IX2(V,ik,1)=temp;
00276         }
00277       } 
00278       
00279       o2scl_linalg::create_givens(a11,a21,c,s);
00280       
00281       /* compute B <= G^T B */
00282       
00283       O2SCL_IX (d, 0)= c * a11 - s * a21;
00284       O2SCL_IX (f, 0)= c * a12 - s * a22;
00285       O2SCL_IX (d, 1)= s * a12 + c * a22;
00286       
00287       /* Compute U <= U G */
00288       
00289       for (i = 0; i < M; i++) {
00290         double Uip = O2SCL_IX2 (U, i, 0);
00291         double Uiq = O2SCL_IX2 (U, i, 1);
00292         O2SCL_IX2 (U, i, 0)= c * Uip - s * Uiq;
00293         O2SCL_IX2 (U, i, 1)= s * Uip + c * Uiq;
00294       }
00295       
00296       return o2scl::gsl_success;
00297     }
00298   }
00299   
00300   /** \brief Desc
00301       
00302       Should be finished.
00303    */
00304   template<class vec_t, class vec2_t, class mat_t>
00305     int chase_out_intermediate_zero(size_t M, size_t n, vec_t &d,
00306                                     vec2_t &f, mat_t &U, size_t k0) {
00307     
00308     double c, s;
00309     double x, y;
00310     size_t k;
00311     
00312     x = O2SCL_IX(f, k0);
00313     y = O2SCL_IX(d, k0+1);
00314     
00315     for (k = k0; k < n - 1; k++) {
00316       
00317       o2scl_linalg::create_givens(y,-x,c,s);
00318       
00319       /* Compute U <= U G */
00320       for (size_t i = 0; i < M; i++) {
00321         double Uip = O2SCL_IX2 (U, i, k0);
00322         double Uiq = O2SCL_IX2 (U, i, k + 1);
00323         O2SCL_IX2 (U, i, k0)= c * Uip - s * Uiq;
00324         O2SCL_IX2 (U, i, k + 1)= s * Uip + c * Uiq;
00325       }
00326       
00327       /* compute B <= G^T B */
00328       
00329       O2SCL_IX (d, k + 1)= s * x + c * y;
00330       
00331       if (k == k0) {
00332         O2SCL_IX (f, k)= c * x - s * y ;
00333       }
00334       
00335       if (k < n - 2) {
00336         double z = O2SCL_IX(f, k + 1);
00337         O2SCL_IX (f, k + 1)= c * z; 
00338         
00339         x = -s * z ;
00340         y = O2SCL_IX(d, k + 2); 
00341       }
00342     }
00343 
00344     return o2scl::gsl_success;
00345   }
00346 
00347   /** \brief Desc
00348       
00349       Should be finished.
00350    */
00351   template<class vec_t, class vec2_t, class mat_t>
00352     int chase_out_trailing_zero(size_t N, size_t n, vec_t &d, 
00353                                 vec2_t &f, mat_t &V) {
00354 
00355     double c, s;
00356     double x, y;
00357     size_t k;
00358     
00359     x = O2SCL_IX(d, n - 2);
00360     y = O2SCL_IX(f, n - 2);
00361     
00362     for (k = n - 1; k-- > 0;) {
00363       
00364       o2scl_linalg::create_givens(x,y,c,s);
00365       
00366       /* Compute V <= V G where G = [c, s ; -s, c] */
00367       
00368       for (size_t i = 0; i < N; i++) {
00369         double Vip = O2SCL_IX2 (V, i, k);
00370         double Viq = O2SCL_IX2 (V, i, n - 1);
00371         O2SCL_IX2 (V, i, k)= c * Vip - s * Viq;
00372         O2SCL_IX2 (V, i, n - 1)= s * Vip + c * Viq;
00373       }
00374       
00375       /* compute B <= B G */
00376       
00377       O2SCL_IX (d, k)= c * x - s * y;
00378       
00379       if (k == n - 2)
00380         O2SCL_IX (f, k)= s * x + c * y ;
00381       
00382       if (k > 0) {
00383         double z = O2SCL_IX(f, k - 1);
00384         O2SCL_IX (f, k - 1)= c * z; 
00385         
00386         x = O2SCL_IX(d, k - 1); 
00387         y = s * z ;
00388       }
00389     }
00390     return o2scl::gsl_success;
00391   }
00392   
00393   /** \brief Desc
00394       
00395       Should be finished.
00396 
00397       The parameter \c M is the number of rows in \c U, \c N is the
00398       number of rows in \c V, and \c n is the length of the vector \c
00399       d.
00400    */
00401   template<class vec_t, class vec2_t, class mat_t, class mat2_t>
00402     int qrstep(size_t M, size_t N, size_t n, 
00403                vec_t &d, vec2_t &f, mat_t &U, mat2_t &V) {
00404     
00405     double y, z;
00406     double ak, bk, zk, ap, bp, aq, bq;
00407     size_t i, k;
00408     
00409     if (n == 1) {
00410       /* shouldn't happen */
00411       return o2scl::gsl_success;
00412     }
00413     
00414     /* Compute 2x2 svd directly */
00415     
00416     if (n == 2) {
00417       svd2 (d, f, U, V);
00418       return o2scl::gsl_success;
00419     }
00420     
00421     /* Chase out any zeroes on the diagonal */
00422     
00423     for (i = 0; i < n - 1; i++) {
00424       double d_i = O2SCL_IX(d, i);
00425       if (d_i == 0.0) {
00426         chase_out_intermediate_zero (d, f, U, i);
00427         return o2scl::gsl_success;
00428       }
00429     }
00430     
00431     /* Chase out any zero at the end of the diagonal */
00432     {
00433       double d_nm1 = O2SCL_IX(d, n - 1);
00434       
00435       if (d_nm1 == 0.0) {
00436         chase_out_trailing_zero (d, f, V);
00437         return o2scl::gsl_success;
00438       }
00439     }
00440     
00441 
00442     /* Apply QR reduction steps to the diagonal and offdiagonal */
00443     
00444     {
00445       double d0 = O2SCL_IX(d, 0);
00446       double f0 = O2SCL_IX(f, 0);
00447       
00448       double d1 = O2SCL_IX(d, 1);
00449       double f1 = O2SCL_IX(f, 1);
00450       
00451       {
00452         double mu = trailing_eigenvalue (d, f);
00453         
00454         y = d0 * d0 - mu;
00455         z = d0 * f0;
00456       }
00457       
00458       /* Set up the recurrence for Givens rotations on a bidiagonal matrix */
00459       
00460       ak = 0;
00461       bk = 0;
00462       
00463       ap = d0;
00464       bp = f0;
00465       
00466       aq = d1;
00467       bq = f1;
00468     }
00469     
00470     for (k = 0; k < n - 1; k++) {
00471 
00472       double c, s;
00473       o2scl_linalg::create_givens(y,z,c,s);
00474 
00475       /* Compute V <= V G */
00476       
00477       for (i = 0; i < N; i++) {
00478         double Vip = O2SCL_IX2 (V, i, k);
00479         double Viq = O2SCL_IX2 (V, i, k + 1);
00480         O2SCL_IX2 (V, i, k)= c * Vip - s * Viq;
00481         O2SCL_IX2 (V, i, k + 1)= s * Vip + c * Viq;
00482       }
00483       
00484       /* compute B <= B G */
00485       
00486       {
00487         double bk1 = c * bk - s * z;
00488 
00489         double ap1 = c * ap - s * bp;
00490         double bp1 = s * ap + c * bp;
00491         double zp1 = -s * aq;
00492 
00493         double aq1 = c * aq;
00494 
00495         if (k > 0) {
00496           O2SCL_IX (f, k - 1)= bk1;
00497         }
00498         
00499         ak = ap1;
00500         bk = bp1;
00501         zk = zp1;
00502         
00503         ap = aq1;
00504         
00505         if (k < n - 2) {
00506           bp = O2SCL_IX(f, k + 1);
00507         } else {
00508           bp = 0.0;
00509         }
00510         
00511         y = ak;
00512         z = zk;
00513       }
00514       
00515       o2scl_linalg::create_givens(y,z,c,s);
00516       
00517       /* Compute U <= U G */
00518       
00519       for (i = 0; i < M; i++) {
00520         double Uip = O2SCL_IX2 (U, i, k);
00521         double Uiq = O2SCL_IX2 (U, i, k + 1);
00522         O2SCL_IX2 (U, i, k)= c * Uip - s * Uiq;
00523         O2SCL_IX2 (U, i, k + 1)= s * Uip + c * Uiq;
00524       }
00525       
00526       /* compute B <= G^T B */
00527       
00528       {
00529         double ak1 = c * ak - s * zk;
00530         double bk1 = c * bk - s * ap;
00531         double zk1 = -s * bp;
00532 
00533         double ap1 = s * bk + c * ap;
00534         double bp1 = c * bp;
00535 
00536         O2SCL_IX (d, k)= ak1;
00537 
00538         ak = ak1;
00539         bk = bk1;
00540         zk = zk1;
00541 
00542         ap = ap1;
00543         bp = bp1;
00544 
00545         if (k < n - 2) {
00546           aq = O2SCL_IX(d, k + 2);
00547         } else {
00548           aq = 0.0;
00549         }
00550 
00551         y = bk;
00552         z = zk;
00553       }
00554     }
00555 
00556     O2SCL_IX (f, n - 2)= bk;
00557     O2SCL_IX (d, n - 1)= ap;
00558 
00559     return o2scl::gsl_success;
00560   }
00561   
00562 #ifdef DOXYGENP
00563 }
00564 #endif
 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.