![]() |
Object-oriented Scientific Computing Library: Version 0.910
|
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
Documentation generated with Doxygen. Provided under the GNU Free Documentation License (see License Information).